diff --git a/CICS/DTSCS13.cob b/CICS/DTSCS13.cob index 72544cc..01a1199 100644 --- a/CICS/DTSCS13.cob +++ b/CICS/DTSCS13.cob @@ -1,6 +1,6 @@ -00001 IDENTIFICATION DIVISION. 09/18/06 +00001 IDENTIFICATION DIVISION. 10/13/17 00002 PROGRAM-ID. DTSCS13. DTSCS13 -00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV062 +00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV003 00004 DATE-WRITTEN. JUNE 1994. DTSCS13 00005 DATE-COMPILED. DTSCS13 00006 SKIP3 DTSCS13 @@ -42,2802 +42,2806 @@ 00042 * MAY NOW BE MADE LIABLE WITHOUT SUPERVISOR DTSCS13 00043 * APPROVAL. DTSCS13 00044 * WORK ORDER: BOBBY TUCKER PROGRAMMER: GD DTSCS13 -00045 * DTSCS13 -00046 * XX/XX/XXXX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS13 -00047 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS13 -00048 * WORK ORDER: PROGRAMMER: XXX DTSCS13 -00049 * DTSCS13 -00050 * DTSCS13 -00051 * DESCRIPTION: DTSCS13 +00045 * CL**2 +00046 * 10/11/2017 ADDED 'QC' AS A VAILD STATE CODE FOR CANADA CL**2 +00047 * WORK ORDER: TICKET 3148 PROGRAMMER: ZL1 CL**2 +00048 * DTSCS13 +00049 * XX/XX/XXXX XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS13 +00050 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS13 +00051 * WORK ORDER: PROGRAMMER: XXX DTSCS13 00052 * DTSCS13 00053 * DTSCS13 -00054 * CLEAR: DTSCS13 +00054 * DESCRIPTION: DTSCS13 00055 * DTSCS13 -00056 * FIELD(S) DISPLAYED: MAP-EMP-NO (FROM LCCM-EMP-NO). DTSCS13 -00057 * DTSCS13 +00056 * DTSCS13 +00057 * CLEAR: DTSCS13 00058 * DTSCS13 -00059 * JUMP: DTSCS13 +00059 * FIELD(S) DISPLAYED: MAP-EMP-NO (FROM LCCM-EMP-NO). DTSCS13 00060 * DTSCS13 -00061 * F17 REGISTRATION INQUIRY (11). DTSCS13 -00062 * F18 REGISTRATION SEARCHES (12). DTSCS13 -00063 * F21 OWNER/PARTNER/OFFICER INQUIRY/UPDATE (15). DTSCS13 -00064 * DTSCS13 -00065 * DTSCS13 -00066 * INQUIRY: DTSCS13 +00061 * DTSCS13 +00062 * JUMP: DTSCS13 +00063 * DTSCS13 +00064 * F17 REGISTRATION INQUIRY (11). DTSCS13 +00065 * F18 REGISTRATION SEARCHES (12). DTSCS13 +00066 * F21 OWNER/PARTNER/OFFICER INQUIRY/UPDATE (15). DTSCS13 00067 * DTSCS13 -00068 * CONTROL FIELD(S): MAP-EMP-NO. DTSCS13 -00069 * DTSCS13 -00070 * JUMP IN: DISPLAY DATA ASSOCIATED WITH LCCM-EMP-NO. DTSCS13 -00071 * DTSCS13 -00072 * ENTER: DISPLAY DATA ASSOCIATED WITH MAP-EMP-NO. DTSCS13 -00073 * DTSCS13 -00074 * STANDARD LCCM-EMP-NO MAINTENANCE. DTSCS13 -00075 * DTSCS13 +00068 * DTSCS13 +00069 * INQUIRY: DTSCS13 +00070 * DTSCS13 +00071 * CONTROL FIELD(S): MAP-EMP-NO. DTSCS13 +00072 * DTSCS13 +00073 * JUMP IN: DISPLAY DATA ASSOCIATED WITH LCCM-EMP-NO. DTSCS13 +00074 * DTSCS13 +00075 * ENTER: DISPLAY DATA ASSOCIATED WITH MAP-EMP-NO. DTSCS13 00076 * DTSCS13 -00077 * UPDATE: DTSCS13 +00077 * STANDARD LCCM-EMP-NO MAINTENANCE. DTSCS13 00078 * DTSCS13 -00079 * MOD: DTSCS13 -00080 * DTSCS13 -00081 * MAY YIELD AN ADD, REWRITE, OR DELETE OF MTAD RECORDS. DTSCS13 -00082 * DTSCS13 +00079 * DTSCS13 +00080 * UPDATE: DTSCS13 +00081 * DTSCS13 +00082 * MOD: DTSCS13 00083 * DTSCS13 -00084 * RECORDS READ: DTSCS13 +00084 * MAY YIELD AN ADD, REWRITE, OR DELETE OF MTAD RECORDS. DTSCS13 00085 * DTSCS13 -00086 * MASTER: DTSCS13 -00087 * DTSCS13 -00088 * MPRF. DTSCS13 -00089 * MTAD. DTSCS13 -00090 * MFAE. DTSCS13 -00091 * FFIS. DTSCS13 -00092 * DTSCS13 -00093 * DTSCS13 -00094 * ALTERNATE INDEX: DTSCS13 +00086 * DTSCS13 +00087 * RECORDS READ: DTSCS13 +00088 * DTSCS13 +00089 * MASTER: DTSCS13 +00090 * DTSCS13 +00091 * MPRF. DTSCS13 +00092 * MTAD. DTSCS13 +00093 * MFAE. DTSCS13 +00094 * FFIS. DTSCS13 00095 * DTSCS13 -00096 * NONE. DTSCS13 -00097 * DTSCS13 +00096 * DTSCS13 +00097 * ALTERNATE INDEX: DTSCS13 00098 * DTSCS13 -00099 * REFERENCE: DTSCS13 +00099 * NONE. DTSCS13 00100 * DTSCS13 -00101 * NONE. DTSCS13 -00102 * DTSCS13 +00101 * DTSCS13 +00102 * REFERENCE: DTSCS13 00103 * DTSCS13 -00104 * ACCOUNTING TRANSACTION COLLECTION: DTSCS13 +00104 * NONE. DTSCS13 00105 * DTSCS13 -00106 * NONE. DTSCS13 -00107 * DTSCS13 +00106 * DTSCS13 +00107 * ACCOUNTING TRANSACTION COLLECTION: DTSCS13 00108 * DTSCS13 -00109 * RECORDS UPDATED: DTSCS13 +00109 * NONE. DTSCS13 00110 * DTSCS13 -00111 * MASTER: DTSCS13 -00112 * DTSCS13 -00113 * MPRF (REWRITE). DTSCS13 -00114 * MTAD (ADD, REWRITE, DELETE). DTSCS13 -00115 * MFAE (ADD, DELETE) DTSCS13 -00116 * DTSCS13 -00117 * REFERENCE: DTSCS13 -00118 * DTSCS13 -00119 * NONE. DTSCS13 -00120 * DTSCS13 +00111 * DTSCS13 +00112 * RECORDS UPDATED: DTSCS13 +00113 * DTSCS13 +00114 * MASTER: DTSCS13 +00115 * DTSCS13 +00116 * MPRF (REWRITE). DTSCS13 +00117 * MTAD (ADD, REWRITE, DELETE). DTSCS13 +00118 * MFAE (ADD, DELETE) DTSCS13 +00119 * DTSCS13 +00120 * REFERENCE: DTSCS13 00121 * DTSCS13 -00122 * ACCOUNTING TRANSACTION COLLECTION: DTSCS13 +00122 * NONE. DTSCS13 00123 * DTSCS13 -00124 * NONE. DTSCS13 -00125 * DTSCS13 +00124 * DTSCS13 +00125 * ACCOUNTING TRANSACTION COLLECTION: DTSCS13 00126 * DTSCS13 -00127 * ON-LINE ACTIVITY FILE RECORDS WRITTEN: DTSCS13 +00127 * NONE. DTSCS13 00128 * DTSCS13 -00129 * NONE. DTSCS13 -00130 * DTSCS13 +00129 * DTSCS13 +00130 * ON-LINE ACTIVITY FILE RECORDS WRITTEN: DTSCS13 00131 * DTSCS13 -00132 * TEMPORARY STORAGE USAGE: DTSCS13 +00132 * NONE. DTSCS13 00133 * DTSCS13 -00134 * NONE. DTSCS13 -00135 * DTSCS13 +00134 * DTSCS13 +00135 * TEMPORARY STORAGE USAGE: DTSCS13 00136 * DTSCS13 -00137 * MODULES LINKED TO: DTSCS13 +00137 * NONE. DTSCS13 00138 * DTSCS13 -00139 * DTSCU018 EMP NO FROM SCREEN FORMAT/EDIT. DTSCS13 -00140 * DTSCU021 TELEPHONE NUMBER FROM SCREEN FORMAT/EDIT. DTSCS13 -00141 * DTSCU072 ADDRESS EDIT. DTSCS13 -00142 * DTSCU073 TELEPHONE NUMBER EDIT. DTSCS13 -00143 * DTSCU203 DETERMINE FIELD ZIP CODE AND JS ZIP CODE. DTSCS13 -00144 * DTSCU221 MPRF-UPDATE DATA ELEMENT MAINTENANCE. DTSCS13 -00145 * DTSCU331 WRITE MAINTENANCE LIST REPORT RECORDS. DTSCS13 -00146 * DTSCU810 MASTER FILE I/O DRIVER. DTSCS13 -00147 * DTSCU831 REFERENCE FILE I/O DRIVER. DTSCS13 -00148 * DTSCS13 -00149 * MAINTENANCE NOTES: DTSCS13 -00150 * DTSCS13 -00151 * A NON-KEY FIELD ADDED TO OR REMOVED FROM THE SCREEN DTSCS13 -00152 * REQUIRES ATTENTION IN THE FOLLOWING AREAS: DTSCS13 -00153 * ALTER PARAGRAPHS P6910/P6920, P8910/P8912/P8920, S5900, DTSCS13 -00154 * ALTER AS APPROPRIATE PARAGRAPHS LISTED IN S1002, DTSCS13 -00155 * ALTER THE SEND/RECEIVE AREA DEFINITION (DTSIS13), DTSCS13 -00156 * ALTER THE MAP (DTSM13) AND ASSEMBLE THE MAPSET (DTSMSET).DTSCS13 -00157 * DTSCS13 -00158 * DTSCS13 -00159 SKIP3 DTSCS13 -00160 ENVIRONMENT DIVISION. DTSCS13 -00161 SKIP3 DTSCS13 -00162 DATA DIVISION. DTSCS13 -00163 SKIP3 DTSCS13 -00164 WORKING-STORAGE SECTION. DTSCS13 -001645 77 PAN-VALET PICTURE X(24) VALUE '062DTSCS13 09/18/06'. DTSCS13 -00165 SKIP3 DTSCS13 -00166 01 WRK-AREA. DTSCS13 -00167 05 WRK-ABEND-CD PIC X(04) VALUE 'S13 '. DTSCS13 -00168 DTSCS13 -00169 05 WRK-SCR-ID. DTSCS13 -00170 10 WRK-SCR-ID-9 PIC 9(02) VALUE 13. DTSCS13 -00171 05 WRK-F03-SCR-ID PIC X(02) VALUE '10'. DTSCS13 +00139 * DTSCS13 +00140 * MODULES LINKED TO: DTSCS13 +00141 * DTSCS13 +00142 * DTSCU018 EMP NO FROM SCREEN FORMAT/EDIT. DTSCS13 +00143 * DTSCU021 TELEPHONE NUMBER FROM SCREEN FORMAT/EDIT. DTSCS13 +00144 * DTSCU072 ADDRESS EDIT. DTSCS13 +00145 * DTSCU073 TELEPHONE NUMBER EDIT. DTSCS13 +00146 * DTSCU203 DETERMINE FIELD ZIP CODE AND JS ZIP CODE. DTSCS13 +00147 * DTSCU221 MPRF-UPDATE DATA ELEMENT MAINTENANCE. DTSCS13 +00148 * DTSCU331 WRITE MAINTENANCE LIST REPORT RECORDS. DTSCS13 +00149 * DTSCU810 MASTER FILE I/O DRIVER. DTSCS13 +00150 * DTSCU831 REFERENCE FILE I/O DRIVER. DTSCS13 +00151 * DTSCS13 +00152 * MAINTENANCE NOTES: DTSCS13 +00153 * DTSCS13 +00154 * A NON-KEY FIELD ADDED TO OR REMOVED FROM THE SCREEN DTSCS13 +00155 * REQUIRES ATTENTION IN THE FOLLOWING AREAS: DTSCS13 +00156 * ALTER PARAGRAPHS P6910/P6920, P8910/P8912/P8920, S5900, DTSCS13 +00157 * ALTER AS APPROPRIATE PARAGRAPHS LISTED IN S1002, DTSCS13 +00158 * ALTER THE SEND/RECEIVE AREA DEFINITION (DTSIS13), DTSCS13 +00159 * ALTER THE MAP (DTSM13) AND ASSEMBLE THE MAPSET (DTSMSET).DTSCS13 +00160 * DTSCS13 +00161 * DTSCS13 +00162 SKIP3 DTSCS13 +00163 ENVIRONMENT DIVISION. DTSCS13 +00164 SKIP3 DTSCS13 +00165 DATA DIVISION. DTSCS13 +00166 SKIP3 DTSCS13 +00167 WORKING-STORAGE SECTION. DTSCS13 +001675 77 PAN-VALET PICTURE X(24) VALUE '003DTSCS13 10/13/17'. DTSCS13 +00168 77 PAN-VALET PICTURE X(24) VALUE '062DTSCS13 09/18/06'. DTSCS13 +00169 SKIP3 DTSCS13 +00170 01 WRK-AREA. DTSCS13 +00171 05 WRK-ABEND-CD PIC X(04) VALUE 'S13 '. DTSCS13 00172 DTSCS13 -00173 05 WRK-TEXT-CNT-HOLD PIC S9(04) COMP. DTSCS13 -00174 DTSCS13 -00175 05 WRK-EMP-NO PIC S9(07) COMP-3. DTSCS13 +00173 05 WRK-SCR-ID. DTSCS13 +00174 10 WRK-SCR-ID-9 PIC 9(02) VALUE 13. DTSCS13 +00175 05 WRK-F03-SCR-ID PIC X(02) VALUE '10'. DTSCS13 00176 DTSCS13 -00177 05 WRK-FISC-AGNT-CD PIC X(03). DTSCS13 +00177 05 WRK-TEXT-CNT-HOLD PIC S9(04) COMP. DTSCS13 00178 DTSCS13 -00179 05 WRK-MSG-AREA PIC X(62). DTSCS13 +00179 05 WRK-EMP-NO PIC S9(07) COMP-3. DTSCS13 00180 DTSCS13 -00181 05 WRK-SUBSCRIPTS. DTSCS13 -00182 10 WRK-TAD PIC S9(04) COMP. DTSCS13 -00183 88 WRK-TAD-MAIL-88 VALUE +1. DTSCS13 -00184 88 WRK-TAD-PHYS-88 VALUE +2. DTSCS13 -00185 10 WRK-PHONE PIC S9(04) COMP. DTSCS13 -00186 DTSCS13 -00187 05 WRK-MTAD-IND PIC X(01). DTSCS13 -00188 88 WRK-MTAD-YES-88 VALUE 'Y'. DTSCS13 -00189 88 WRK-MTAD-NO-88 VALUE 'N'. DTSCS13 +00181 05 WRK-FISC-AGNT-CD PIC X(03). DTSCS13 +00182 DTSCS13 +00183 05 WRK-MSG-AREA PIC X(62). DTSCS13 +00184 DTSCS13 +00185 05 WRK-SUBSCRIPTS. DTSCS13 +00186 10 WRK-TAD PIC S9(04) COMP. DTSCS13 +00187 88 WRK-TAD-MAIL-88 VALUE +1. DTSCS13 +00188 88 WRK-TAD-PHYS-88 VALUE +2. DTSCS13 +00189 10 WRK-PHONE PIC S9(04) COMP. DTSCS13 00190 DTSCS13 -00191 05 WRK-MFAE-IND PIC X(01). DTSCS13 -00192 88 WRK-MFAE-YES-88 VALUE 'Y'. DTSCS13 -00193 88 WRK-MFAE-NO-88 VALUE 'N'. DTSCS13 +00191 05 WRK-MTAD-IND PIC X(01). DTSCS13 +00192 88 WRK-MTAD-YES-88 VALUE 'Y'. DTSCS13 +00193 88 WRK-MTAD-NO-88 VALUE 'N'. DTSCS13 00194 DTSCS13 -00195 05 WRK-FFIS-IND PIC X(01). DTSCS13 -00196 88 WRK-FFIS-YES-88 VALUE 'Y'. DTSCS13 -00197 88 WRK-FFIS-NO-88 VALUE 'N'. DTSCS13 +00195 05 WRK-MFAE-IND PIC X(01). DTSCS13 +00196 88 WRK-MFAE-YES-88 VALUE 'Y'. DTSCS13 +00197 88 WRK-MFAE-NO-88 VALUE 'N'. DTSCS13 00198 DTSCS13 -00199 05 WRK-DC-ADDR-IND OCCURS 2 TIMES PIC X(01). DTSCS13 -00200 88 WRK-DC-ADDR-YES-88 VALUE 'Y'. DTSCS13 -00201 88 WRK-DC-ADDR-NO-88 VALUE 'N'. DTSCS13 +00199 05 WRK-FFIS-IND PIC X(01). DTSCS13 +00200 88 WRK-FFIS-YES-88 VALUE 'Y'. DTSCS13 +00201 88 WRK-FFIS-NO-88 VALUE 'N'. DTSCS13 00202 DTSCS13 -00203 05 WRK-STATE-CHANGE-IND PIC X(01). DTSCS13 -00204 88 WRK-STATE-CHANGE-NULL-88 VALUE '0'. DTSCS13 -00205 88 WRK-CHANGE-FROM-DC-88 VALUE '1'. DTSCS13 -00206 88 WRK-NON-DC-ADDED-88 VALUE '2'. DTSCS13 -00207 DTSCS13 -00208 05 WRK-PO-BOX-CHANGE-IND PIC X(01). DTSCS13 -00209 88 WRK-PO-BOX-CHANGE-NULL-88 VALUE '0'. DTSCS13 -00210 88 WRK-CHANGE-TO-PO-BOX-88 VALUE '1'. DTSCS13 -00211 88 WRK-PO-BOX-ADDED-88 VALUE '2'. DTSCS13 -00212 DTSCS13 -00213 05 WRK-PO-BOX-IND OCCURS 2 TIMES PIC X(01). DTSCS13 -00214 88 WRK-PO-BOX-YES-88 VALUE 'Y'. DTSCS13 -00215 88 WRK-PO-BOX-NO-88 VALUE 'N'. DTSCS13 +00203 05 WRK-DC-ADDR-IND OCCURS 2 TIMES PIC X(01). DTSCS13 +00204 88 WRK-DC-ADDR-YES-88 VALUE 'Y'. DTSCS13 +00205 88 WRK-DC-ADDR-NO-88 VALUE 'N'. DTSCS13 +00206 DTSCS13 +00207 05 WRK-STATE-CHANGE-IND PIC X(01). DTSCS13 +00208 88 WRK-STATE-CHANGE-NULL-88 VALUE '0'. DTSCS13 +00209 88 WRK-CHANGE-FROM-DC-88 VALUE '1'. DTSCS13 +00210 88 WRK-NON-DC-ADDED-88 VALUE '2'. DTSCS13 +00211 DTSCS13 +00212 05 WRK-PO-BOX-CHANGE-IND PIC X(01). DTSCS13 +00213 88 WRK-PO-BOX-CHANGE-NULL-88 VALUE '0'. DTSCS13 +00214 88 WRK-CHANGE-TO-PO-BOX-88 VALUE '1'. DTSCS13 +00215 88 WRK-PO-BOX-ADDED-88 VALUE '2'. DTSCS13 00216 DTSCS13 -00217 05 WRK-DELIV-LINE-1 PIC X(40). DTSCS13 -00218 05 WRK-DELIV-LINE-2 PIC X(40). DTSCS13 -00219 DTSCS13 -00220 05 WRK-TAX-ADDRESS-INFO OCCURS 2. DTSCS13 -00221 10 WRK-MAP-ADDR-IND PIC X(01). DTSCS13 -00222 88 WRK-MAP-ADDR-BLANK VALUE '0'. DTSCS13 -00223 88 WRK-MAP-ADDR-HAS-DATA VALUE '1'. DTSCS13 -00224 10 HOLD-ATTRB-AREA. DTSCS13 -00225 15 HOLD-ATTN-A PIC X(01). DTSCS13 -00226 15 HOLD-DLV1-A PIC X(01). DTSCS13 -00227 15 HOLD-DLV2-A PIC X(01). DTSCS13 -00228 15 HOLD-CITY-A PIC X(01). DTSCS13 -00229 15 HOLD-STAT-A PIC X(01). DTSCS13 -00230 15 HOLD-ZIPC-A PIC X(01). DTSCS13 -00231 DTSCS13 -00232 05 WRK-MTAD-PHONE-NUMBERS. DTSCS13 -00233 10 WRK-MTAD-PHONE OCCURS 3. DTSCS13 -00234 15 WRK-MTAD-PHONE-A-CD PIC X(03). DTSCS13 -00235 15 WRK-MTAD-PHONE-PREF PIC X(03). DTSCS13 -00236 15 WRK-MTAD-PHONE-SUFF PIC X(04). DTSCS13 -00237 15 WRK-MTAD-PHONE-EXT PIC X(05). DTSCS13 -00238 DTSCS13 -00239 05 WRK-RET-MAIL-IND PIC X(01). DTSCS13 -00240 88 WRK-RET-MAIL-YES-88 VALUE 'Y'. DTSCS13 -00241 88 WRK-RET-MAIL-NO-88 VALUE 'N'. DTSCS13 +00217 05 WRK-PO-BOX-IND OCCURS 2 TIMES PIC X(01). DTSCS13 +00218 88 WRK-PO-BOX-YES-88 VALUE 'Y'. DTSCS13 +00219 88 WRK-PO-BOX-NO-88 VALUE 'N'. DTSCS13 +00220 DTSCS13 +00221 05 WRK-DELIV-LINE-1 PIC X(40). DTSCS13 +00222 05 WRK-DELIV-LINE-2 PIC X(40). DTSCS13 +00223 DTSCS13 +00224 05 WRK-TAX-ADDRESS-INFO OCCURS 2. DTSCS13 +00225 10 WRK-MAP-ADDR-IND PIC X(01). DTSCS13 +00226 88 WRK-MAP-ADDR-BLANK VALUE '0'. DTSCS13 +00227 88 WRK-MAP-ADDR-HAS-DATA VALUE '1'. DTSCS13 +00228 10 HOLD-ATTRB-AREA. DTSCS13 +00229 15 HOLD-ATTN-A PIC X(01). DTSCS13 +00230 15 HOLD-DLV1-A PIC X(01). DTSCS13 +00231 15 HOLD-DLV2-A PIC X(01). DTSCS13 +00232 15 HOLD-CITY-A PIC X(01). DTSCS13 +00233 15 HOLD-STAT-A PIC X(01). DTSCS13 +00234 15 HOLD-ZIPC-A PIC X(01). DTSCS13 +00235 DTSCS13 +00236 05 WRK-MTAD-PHONE-NUMBERS. DTSCS13 +00237 10 WRK-MTAD-PHONE OCCURS 3. DTSCS13 +00238 15 WRK-MTAD-PHONE-A-CD PIC X(03). DTSCS13 +00239 15 WRK-MTAD-PHONE-PREF PIC X(03). DTSCS13 +00240 15 WRK-MTAD-PHONE-SUFF PIC X(04). DTSCS13 +00241 15 WRK-MTAD-PHONE-EXT PIC X(05). DTSCS13 00242 DTSCS13 -00243 05 WRK-331-CONSTANTS. DTSCS13 -00244 10 FILLER PIC X(11) VALUE 'MTAD-VOICE1'. DTSCS13 -00245 10 FILLER PIC X(11) VALUE 'MTAD-VOICE2'. DTSCS13 -00246 10 FILLER PIC X(11) VALUE 'MTAD-FAX '. DTSCS13 -00247 05 FILLER REDEFINES WRK-331-CONSTANTS. DTSCS13 -00248 10 WRK-331-FIELD-NAME OCCURS 3 PIC X(11). DTSCS13 -00249 DTSCS13 -00250 05 COMM-AREA-LENGTH PIC S9(04) COMP. DTSCS13 -00251 EJECT DTSCS13 -00252 01 SCREEN-CONTROL. DTSCS13 -00253 05 SCR-ACCESS-IND PIC X(01). DTSCS13 -00254 88 SCR-ACCESS-INQ VALUE '1'. DTSCS13 -00255 88 SCR-ACCESS-UPDATE VALUE '2'. DTSCS13 -00256 DTSCS13 -00257 05 CURSOR-SET-IND PIC X(01). DTSCS13 -00258 88 CURSOR-SET-YES VALUE 'Y'. DTSCS13 -00259 88 CURSOR-SET-NO VALUE 'N'. DTSCS13 -00260 88 CURSOR-SET-GOTO VALUE 'G'. DTSCS13 -00261 DTSCS13 -00262 05 WRK-RETURN-MAIL-IND PIC X(01). DTSCS13 -00263 88 WRK-MAIL-ADDR-CHNG-YES VALUE 'Y'. DTSCS13 -00264 88 WRK-MAIL-ADDR-CHNG-NO VALUE 'N'. DTSCS13 +00243 05 WRK-RET-MAIL-IND PIC X(01). DTSCS13 +00244 88 WRK-RET-MAIL-YES-88 VALUE 'Y'. DTSCS13 +00245 88 WRK-RET-MAIL-NO-88 VALUE 'N'. DTSCS13 +00246 DTSCS13 +00247 05 WRK-331-CONSTANTS. DTSCS13 +00248 10 FILLER PIC X(11) VALUE 'MTAD-VOICE1'. DTSCS13 +00249 10 FILLER PIC X(11) VALUE 'MTAD-VOICE2'. DTSCS13 +00250 10 FILLER PIC X(11) VALUE 'MTAD-FAX '. DTSCS13 +00251 05 FILLER REDEFINES WRK-331-CONSTANTS. DTSCS13 +00252 10 WRK-331-FIELD-NAME OCCURS 3 PIC X(11). DTSCS13 +00253 DTSCS13 +00254 05 COMM-AREA-LENGTH PIC S9(04) COMP. DTSCS13 +00255 EJECT DTSCS13 +00256 01 SCREEN-CONTROL. DTSCS13 +00257 05 SCR-ACCESS-IND PIC X(01). DTSCS13 +00258 88 SCR-ACCESS-INQ VALUE '1'. DTSCS13 +00259 88 SCR-ACCESS-UPDATE VALUE '2'. DTSCS13 +00260 DTSCS13 +00261 05 CURSOR-SET-IND PIC X(01). DTSCS13 +00262 88 CURSOR-SET-YES VALUE 'Y'. DTSCS13 +00263 88 CURSOR-SET-NO VALUE 'N'. DTSCS13 +00264 88 CURSOR-SET-GOTO VALUE 'G'. DTSCS13 00265 DTSCS13 -00266 05 REQ-IND PIC X(01). DTSCS13 -00267 88 REQ-ERROR VALUE 'O'. DTSCS13 -00268 88 REQ-JUMP VALUE 'J'. DTSCS13 -00269 88 REQ-INQUIRE VALUE 'I'. DTSCS13 -00270 88 REQ-CLEAR VALUE 'C'. DTSCS13 -00271 88 REQ-EDIT VALUE 'E'. DTSCS13 -00272 88 REQ-UPDATE VALUE 'U'. DTSCS13 -00273 88 REQ-CURSOR-TO-GOTO VALUE 'G'. DTSCS13 -00274 DTSCS13 -00275 05 RESP-IND PIC X(01). DTSCS13 -00276 88 RESP-SEND-MSGONLY VALUE 'O'. DTSCS13 -00277 88 RESP-SEND-MAP VALUE 'M'. DTSCS13 -00278 88 RESP-JUMP VALUE 'J'. DTSCS13 -00279 88 RESP-CURSOR-TO-GOTO VALUE 'G'. DTSCS13 -00280 DTSCS13 -00281 05 SCR-ATB-AN PIC X(01). DTSCS13 -00282 05 SCR-ATB-NUM PIC X(01). DTSCS13 -00283 DTSCS13 -00284 01 MSG-LITERALS. DTSCS13 -00285 DTSCS13 -00286 05 MSG-E131-AREA. DTSCS13 -00287 10 FILLER PIC X(04) VALUE 'E131'. DTSCS13 -00288 10 FILLER PIC X(30) DTSCS13 -00289 VALUE 'NOT ALLOWED - PRIMARY NAME IS '. DTSCS13 -00290 10 FILLER PIC X(30) DTSCS13 -00291 VALUE 'ENTITY NAME '. DTSCS13 -00292 DTSCS13 -00293 05 MSG-E132-AREA. DTSCS13 -00294 10 FILLER PIC X(04) VALUE 'E132'. DTSCS13 -00295 10 FILLER PIC X(30) DTSCS13 -00296 VALUE 'NOT ALLOWED - PRIMARY AND ENTI'. DTSCS13 -00297 10 FILLER PIC X(30) DTSCS13 -00298 VALUE 'TY NAMES CANNOT BE IDENTICAL '. DTSCS13 -00299 DTSCS13 -00300 05 MSG-E133-AREA. DTSCS13 -00301 10 FILLER PIC X(04) VALUE 'E133'. DTSCS13 -00302 10 FILLER PIC X(30) DTSCS13 -00303 VALUE 'NOT ALLOWED - CHANGE OR REMOVE'. DTSCS13 -00304 10 FILLER PIC X(30) DTSCS13 -00305 VALUE ' FISC AGNT TO CHANGE MAIL ADDR'. DTSCS13 -00306 DTSCS13 -00307 05 MSG-E134-AREA. DTSCS13 -00308 10 FILLER PIC X(04) VALUE 'E134'. DTSCS13 -00309 10 FILLER PIC X(30) DTSCS13 -00310 VALUE 'FISCAL AGENT REMOVED - EMPLOYE'. DTSCS13 -00311 10 FILLER PIC X(30) DTSCS13 -00312 VALUE 'R MAILING ADDRESS REQUIRED '. DTSCS13 -00313 DTSCS13 -00314 05 MSG-E135-AREA. DTSCS13 -00315 10 FILLER PIC X(04) VALUE 'E135'. DTSCS13 -00316 10 FILLER PIC X(30) DTSCS13 -00317 VALUE 'FISCAL AGENT REMOVED - EMPLOYE'. DTSCS13 -00318 10 FILLER PIC X(30) DTSCS13 -00319 VALUE 'R PHONE NUMBER REQUIRED '. DTSCS13 -00320 DTSCS13 -00321 05 MSG-E136-AREA. DTSCS13 -00322 10 FILLER PIC X(04) VALUE 'E136'. DTSCS13 -00323 10 FILLER PIC X(50) VALUE DTSCS13 -00324 'NO DC ADDRESS - VERIFY TO CONTINUE '. DTSCS13 -00325 DTSCS13 -00326 05 MSG-E137-AREA. DTSCS13 -00327 10 FILLER PIC X(04) VALUE 'E137'. DTSCS13 -00328 10 FILLER PIC X(50) VALUE DTSCS13 -00329 'PO BOX - VERIFY TO CONTINUE '. DTSCS13 -00330 DTSCS13 -00331 EJECT DTSCS13 -00332 01 L018-COMM-AREA. DTSCS13 -00333 ++INCLUDE DTSIL018 DTSCS13 -00334 EJECT DTSCS13 -00335 01 L021-COMM-AREA. DTSCS13 -00336 ++INCLUDE DTSIL021 DTSCS13 -00337 EJECT DTSCS13 -00338 01 L072-COMM-AREA. DTSCS13 -00339 ++INCLUDE DTSIL072 DTSCS13 -00340 EJECT DTSCS13 -00341 01 L073-COMM-AREA. DTSCS13 -00342 ++INCLUDE DTSIL073 DTSCS13 -00343 EJECT DTSCS13 -00344 01 L203-COMM-AREA. DTSCS13 -00345 ++INCLUDE DTSIL203 DTSCS13 -00346 EJECT DTSCS13 -00347 01 L221-COMM-AREA. DTSCS13 -00348 ++INCLUDE DTSIL221 DTSCS13 -00349 EJECT DTSCS13 -00350 01 L331-COMM-AREA. DTSCS13 -00351 ++INCLUDE DTSIL331 DTSCS13 -00352 EJECT DTSCS13 -00353 01 L805-COMM-AREA. DTSCS13 -00354 ++INCLUDE DTSIL805 DTSCS13 -00355 EJECT DTSCS13 -00356 01 L810-COMM-AREA. DTSCS13 -00357 05 L810-CONTROL-BLOCK. DTSCS13 -00358 ++INCLUDE DTSIL810 DTSCS13 +00266 05 WRK-RETURN-MAIL-IND PIC X(01). DTSCS13 +00267 88 WRK-MAIL-ADDR-CHNG-YES VALUE 'Y'. DTSCS13 +00268 88 WRK-MAIL-ADDR-CHNG-NO VALUE 'N'. DTSCS13 +00269 DTSCS13 +00270 05 REQ-IND PIC X(01). DTSCS13 +00271 88 REQ-ERROR VALUE 'O'. DTSCS13 +00272 88 REQ-JUMP VALUE 'J'. DTSCS13 +00273 88 REQ-INQUIRE VALUE 'I'. DTSCS13 +00274 88 REQ-CLEAR VALUE 'C'. DTSCS13 +00275 88 REQ-EDIT VALUE 'E'. DTSCS13 +00276 88 REQ-UPDATE VALUE 'U'. DTSCS13 +00277 88 REQ-CURSOR-TO-GOTO VALUE 'G'. DTSCS13 +00278 DTSCS13 +00279 05 RESP-IND PIC X(01). DTSCS13 +00280 88 RESP-SEND-MSGONLY VALUE 'O'. DTSCS13 +00281 88 RESP-SEND-MAP VALUE 'M'. DTSCS13 +00282 88 RESP-JUMP VALUE 'J'. DTSCS13 +00283 88 RESP-CURSOR-TO-GOTO VALUE 'G'. DTSCS13 +00284 DTSCS13 +00285 05 SCR-ATB-AN PIC X(01). DTSCS13 +00286 05 SCR-ATB-NUM PIC X(01). DTSCS13 +00287 DTSCS13 +00288 01 MSG-LITERALS. DTSCS13 +00289 DTSCS13 +00290 05 MSG-E131-AREA. DTSCS13 +00291 10 FILLER PIC X(04) VALUE 'E131'. DTSCS13 +00292 10 FILLER PIC X(30) DTSCS13 +00293 VALUE 'NOT ALLOWED - PRIMARY NAME IS '. DTSCS13 +00294 10 FILLER PIC X(30) DTSCS13 +00295 VALUE 'ENTITY NAME '. DTSCS13 +00296 DTSCS13 +00297 05 MSG-E132-AREA. DTSCS13 +00298 10 FILLER PIC X(04) VALUE 'E132'. DTSCS13 +00299 10 FILLER PIC X(30) DTSCS13 +00300 VALUE 'NOT ALLOWED - PRIMARY AND ENTI'. DTSCS13 +00301 10 FILLER PIC X(30) DTSCS13 +00302 VALUE 'TY NAMES CANNOT BE IDENTICAL '. DTSCS13 +00303 DTSCS13 +00304 05 MSG-E133-AREA. DTSCS13 +00305 10 FILLER PIC X(04) VALUE 'E133'. DTSCS13 +00306 10 FILLER PIC X(30) DTSCS13 +00307 VALUE 'NOT ALLOWED - CHANGE OR REMOVE'. DTSCS13 +00308 10 FILLER PIC X(30) DTSCS13 +00309 VALUE ' FISC AGNT TO CHANGE MAIL ADDR'. DTSCS13 +00310 DTSCS13 +00311 05 MSG-E134-AREA. DTSCS13 +00312 10 FILLER PIC X(04) VALUE 'E134'. DTSCS13 +00313 10 FILLER PIC X(30) DTSCS13 +00314 VALUE 'FISCAL AGENT REMOVED - EMPLOYE'. DTSCS13 +00315 10 FILLER PIC X(30) DTSCS13 +00316 VALUE 'R MAILING ADDRESS REQUIRED '. DTSCS13 +00317 DTSCS13 +00318 05 MSG-E135-AREA. DTSCS13 +00319 10 FILLER PIC X(04) VALUE 'E135'. DTSCS13 +00320 10 FILLER PIC X(30) DTSCS13 +00321 VALUE 'FISCAL AGENT REMOVED - EMPLOYE'. DTSCS13 +00322 10 FILLER PIC X(30) DTSCS13 +00323 VALUE 'R PHONE NUMBER REQUIRED '. DTSCS13 +00324 DTSCS13 +00325 05 MSG-E136-AREA. DTSCS13 +00326 10 FILLER PIC X(04) VALUE 'E136'. DTSCS13 +00327 10 FILLER PIC X(50) VALUE DTSCS13 +00328 'NO DC ADDRESS - VERIFY TO CONTINUE '. DTSCS13 +00329 DTSCS13 +00330 05 MSG-E137-AREA. DTSCS13 +00331 10 FILLER PIC X(04) VALUE 'E137'. DTSCS13 +00332 10 FILLER PIC X(50) VALUE DTSCS13 +00333 'PO BOX - VERIFY TO CONTINUE '. DTSCS13 +00334 DTSCS13 +00335 EJECT DTSCS13 +00336 01 L018-COMM-AREA. DTSCS13 +00337 ++INCLUDE DTSIL018 DTSCS13 +00338 EJECT DTSCS13 +00339 01 L021-COMM-AREA. DTSCS13 +00340 ++INCLUDE DTSIL021 DTSCS13 +00341 EJECT DTSCS13 +00342 01 L072-COMM-AREA. DTSCS13 +00343 ++INCLUDE DTSIL072 DTSCS13 +00344 EJECT DTSCS13 +00345 01 L073-COMM-AREA. DTSCS13 +00346 ++INCLUDE DTSIL073 DTSCS13 +00347 EJECT DTSCS13 +00348 01 L203-COMM-AREA. DTSCS13 +00349 ++INCLUDE DTSIL203 DTSCS13 +00350 EJECT DTSCS13 +00351 01 L221-COMM-AREA. DTSCS13 +00352 ++INCLUDE DTSIL221 DTSCS13 +00353 EJECT DTSCS13 +00354 01 L331-COMM-AREA. DTSCS13 +00355 ++INCLUDE DTSIL331 DTSCS13 +00356 EJECT DTSCS13 +00357 01 L805-COMM-AREA. DTSCS13 +00358 ++INCLUDE DTSIL805 DTSCS13 00359 EJECT DTSCS13 -00360 05 MSKL-REC. DTSCS13 -00361 ++INCLUDE DTSIMSKL DTSCS13 -00362 EJECT DTSCS13 +00360 01 L810-COMM-AREA. DTSCS13 +00361 05 L810-CONTROL-BLOCK. DTSCS13 +00362 ++INCLUDE DTSIL810 DTSCS13 00363 EJECT DTSCS13 -00364 01 L831-COMM-AREA. DTSCS13 -00365 05 L831-CONTROL-BLOCK. DTSCS13 -00366 ++INCLUDE DTSIL831 DTSCS13 +00364 05 MSKL-REC. DTSCS13 +00365 ++INCLUDE DTSIMSKL DTSCS13 +00366 EJECT DTSCS13 00367 EJECT DTSCS13 -00368 05 FSKL-REC. DTSCS13 -00369 ++INCLUDE DTSIFSKL DTSCS13 -00370 EJECT DTSCS13 -00371 05 MFAE-REC. DTSCS13 -00372 ++INCLUDE DTSIMFAE DTSCS13 -00373 EJECT DTSCS13 -00374 05 FFIS-REC. DTSCS13 -00375 ++INCLUDE DTSIFFIS DTSCS13 -00376 EJECT DTSCS13 -00377 01 MHDR-REC. DTSCS13 -00378 ++INCLUDE DTSIMHDR DTSCS13 -00379 EJECT DTSCS13 -00380 01 MPRF-REC. DTSCS13 -00381 ++INCLUDE DTSIMPRF DTSCS13 -00382 EJECT DTSCS13 -00383 01 MTAD-REC. DTSCS13 -00384 ++INCLUDE DTSIMTAD DTSCS13 -00385 EJECT DTSCS13 -00386 01 MEVL-REC. DTSCS13 -00387 ++INCLUDE DTSIMEVL DTSCS13 -00388 EJECT DTSCS13 -00389 * MAP DEFINITION DTSCS13 -00390 01 L851-COMM-AREA. DTSCS13 -00391 ++INCLUDE DTSIL851 DTSCS13 -00392 SKIP3 DTSCS13 -00393 05 MAP-AREA REDEFINES L851-MAP-AREA. DTSCS13 -00394 ++INCLUDE DTSIS13 DTSCS13 -00395 EJECT DTSCS13 -00396 01 CATB-LITERALS. DTSCS13 -00397 ++INCLUDE DTSICATB DTSCS13 -00398 SKIP3 DTSCS13 -00399 01 CFKD-LITERALS. DTSCS13 -00400 ++INCLUDE DTSICFKD DTSCS13 -00401 EJECT DTSCS13 -00402 01 CECD-LITERALS. DTSCS13 -00403 ++INCLUDE DTSICECD DTSCS13 -00404 SKIP3 DTSCS13 -00405 01 CPCD-LITERALS. DTSCS13 -00406 ++INCLUDE DTSICPCD DTSCS13 -00407 EJECT DTSCS13 -00408 LINKAGE SECTION. DTSCS13 -00409 SKIP3 DTSCS13 -00410 01 DFHCOMMAREA. DTSCS13 -00411 ++INCLUDE DTSILCCM DTSCS13 -00412 SKIP3 DTSCS13 -00413 15 FILLER REDEFINES LCCM-SCR-HOLD-AREA. DTSCS13 -00414 20 LCCM-HOLD-ADDRESS OCCURS 2 PIC X(171). DTSCS13 -00415 EJECT DTSCS13 -00416 ******************************************************************DTSCS13 -00417 * *DTSCS13 -00418 ******************************************************************DTSCS13 -00419 DTSCS13 -00420 PROCEDURE DIVISION. DTSCS13 -00421 SKIP2 DTSCS13 -00422 MOVE +0 TO WRK-EMP-NO. DTSCS13 +00368 01 L831-COMM-AREA. DTSCS13 +00369 05 L831-CONTROL-BLOCK. DTSCS13 +00370 ++INCLUDE DTSIL831 DTSCS13 +00371 EJECT DTSCS13 +00372 05 FSKL-REC. DTSCS13 +00373 ++INCLUDE DTSIFSKL DTSCS13 +00374 EJECT DTSCS13 +00375 05 MFAE-REC. DTSCS13 +00376 ++INCLUDE DTSIMFAE DTSCS13 +00377 EJECT DTSCS13 +00378 05 FFIS-REC. DTSCS13 +00379 ++INCLUDE DTSIFFIS DTSCS13 +00380 EJECT DTSCS13 +00381 01 MHDR-REC. DTSCS13 +00382 ++INCLUDE DTSIMHDR DTSCS13 +00383 EJECT DTSCS13 +00384 01 MPRF-REC. DTSCS13 +00385 ++INCLUDE DTSIMPRF DTSCS13 +00386 EJECT DTSCS13 +00387 01 MTAD-REC. DTSCS13 +00388 ++INCLUDE DTSIMTAD DTSCS13 +00389 EJECT DTSCS13 +00390 01 MEVL-REC. DTSCS13 +00391 ++INCLUDE DTSIMEVL DTSCS13 +00392 EJECT DTSCS13 +00393 * MAP DEFINITION DTSCS13 +00394 01 L851-COMM-AREA. DTSCS13 +00395 ++INCLUDE DTSIL851 DTSCS13 +00396 SKIP3 DTSCS13 +00397 05 MAP-AREA REDEFINES L851-MAP-AREA. DTSCS13 +00398 ++INCLUDE DTSIS13 DTSCS13 +00399 EJECT DTSCS13 +00400 01 CATB-LITERALS. DTSCS13 +00401 ++INCLUDE DTSICATB DTSCS13 +00402 SKIP3 DTSCS13 +00403 01 CFKD-LITERALS. DTSCS13 +00404 ++INCLUDE DTSICFKD DTSCS13 +00405 EJECT DTSCS13 +00406 01 CECD-LITERALS. DTSCS13 +00407 ++INCLUDE DTSICECD DTSCS13 +00408 SKIP3 DTSCS13 +00409 01 CPCD-LITERALS. DTSCS13 +00410 ++INCLUDE DTSICPCD DTSCS13 +00411 EJECT DTSCS13 +00412 LINKAGE SECTION. DTSCS13 +00413 SKIP3 DTSCS13 +00414 01 DFHCOMMAREA. DTSCS13 +00415 ++INCLUDE DTSILCCM DTSCS13 +00416 SKIP3 DTSCS13 +00417 15 FILLER REDEFINES LCCM-SCR-HOLD-AREA. DTSCS13 +00418 20 LCCM-HOLD-ADDRESS OCCURS 2 PIC X(171). DTSCS13 +00419 EJECT DTSCS13 +00420 ******************************************************************DTSCS13 +00421 * *DTSCS13 +00422 ******************************************************************DTSCS13 00423 DTSCS13 -00424 SET CURSOR-SET-NO TO TRUE. DTSCS13 -00425 DTSCS13 -00426 MOVE LOW-VALUES TO MAP-AREA. DTSCS13 +00424 PROCEDURE DIVISION. DTSCS13 +00425 SKIP2 DTSCS13 +00426 MOVE +0 TO WRK-EMP-NO. DTSCS13 00427 DTSCS13 -00428 MOVE LCCM-SCR-NUM-ACCESS-IND (WRK-SCR-ID-9) DTSCS13 -00429 TO SCR-ACCESS-IND. DTSCS13 -00430 SKIP3 DTSCS13 -00431 MOVE SPACE TO REQ-IND. DTSCS13 -00432 DTSCS13 -00433 PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT. DTSCS13 -00434 DTSCS13 -00435 *----------------------------------------------------- DTSCS13 -00436 * P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE DTSCS13 -00437 * "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT DTSCS13 -00438 * REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE DTSCS13 -00439 * OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED. DTSCS13 -00440 * DTSCS13 -00441 * THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE DTSCS13 -00442 * PROCESSED. DTSCS13 -00443 * DTSCS13 -00444 * THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND, DTSCS13 -00445 * INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE DTSCS13 -00446 * WORK STATION OPERATOR. DTSCS13 -00447 *----------------------------------------------------- DTSCS13 -00448 DTSCS13 -00449 MOVE SPACE TO RESP-IND. DTSCS13 -00450 DTSCS13 -00451 IF REQ-ERROR DTSCS13 -00452 PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT DTSCS13 -00453 ELSE DTSCS13 -00454 IF REQ-JUMP DTSCS13 -00455 PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT DTSCS13 -00456 ELSE DTSCS13 -00457 IF REQ-CLEAR DTSCS13 -00458 PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT DTSCS13 -00459 ELSE DTSCS13 -00460 IF REQ-CURSOR-TO-GOTO DTSCS13 -00461 PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT DTSCS13 -00462 ELSE DTSCS13 -00463 IF REQ-INQUIRE DTSCS13 -00464 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT DTSCS13 -00465 ELSE DTSCS13 -00466 IF REQ-EDIT DTSCS13 -00467 PERFORM P7000-REQUEST-EDIT THRU P7000-EXIT DTSCS13 -00468 ELSE DTSCS13 -00469 IF REQ-UPDATE DTSCS13 -00470 PERFORM P8000-REQUEST-UPDATE THRU P8000-EXIT DTSCS13 -00471 ELSE DTSCS13 -00472 GO TO S899-ABEND. DTSCS13 -00473 SKIP3 DTSCS13 -00474 *----------------------------------------------------- DTSCS13 -00475 * THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED DTSCS13 -00476 * IN RESP-IND THE TYPE OF RESPONSE TO BE MADE. DTSCS13 -00477 *----------------------------------------------------- DTSCS13 -00478 DTSCS13 -00479 IF RESP-SEND-MAP DTSCS13 -00480 PERFORM S9300-SEND-MAP THRU S9300-EXIT DTSCS13 -00481 SET LCCM-END-TASK-88 TO TRUE DTSCS13 -00482 ELSE DTSCS13 -00483 IF RESP-SEND-MSGONLY DTSCS13 -00484 OR RESP-CURSOR-TO-GOTO DTSCS13 -00485 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS13 -00486 SET LCCM-END-TASK-88 TO TRUE DTSCS13 -00487 ELSE DTSCS13 -00488 IF RESP-JUMP DTSCS13 -00489 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS13 -00490 ELSE DTSCS13 -00491 GO TO S899-ABEND. DTSCS13 -00492 SKIP3 DTSCS13 -00493 MAINLINE-EXIT. DTSCS13 -00494 DTSCS13 -00495 EXEC CICS DTSCS13 -00496 RETURN DTSCS13 -00497 END-EXEC. DTSCS13 -00498 SKIP2 DTSCS13 -00499 /*****************************************************************DTSCS13 -00500 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION *DTSCS13 -00501 ******************************************************************DTSCS13 -00502 P1000-ANALYZE-REQUEST. DTSCS13 -00503 DTSCS13 -00504 *----------------------------------------------------- DTSCS13 -00505 * IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE) DTSCS13 -00506 * THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE DTSCS13 -00507 * REPLACED WITH ENTER) DTSCS13 +00428 SET CURSOR-SET-NO TO TRUE. DTSCS13 +00429 DTSCS13 +00430 MOVE LOW-VALUES TO MAP-AREA. DTSCS13 +00431 DTSCS13 +00432 MOVE LCCM-SCR-NUM-ACCESS-IND (WRK-SCR-ID-9) DTSCS13 +00433 TO SCR-ACCESS-IND. DTSCS13 +00434 SKIP3 DTSCS13 +00435 MOVE SPACE TO REQ-IND. DTSCS13 +00436 DTSCS13 +00437 PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT. DTSCS13 +00438 DTSCS13 +00439 *----------------------------------------------------- DTSCS13 +00440 * P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE DTSCS13 +00441 * "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT DTSCS13 +00442 * REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE DTSCS13 +00443 * OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED. DTSCS13 +00444 * DTSCS13 +00445 * THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE DTSCS13 +00446 * PROCESSED. DTSCS13 +00447 * DTSCS13 +00448 * THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND, DTSCS13 +00449 * INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE DTSCS13 +00450 * WORK STATION OPERATOR. DTSCS13 +00451 *----------------------------------------------------- DTSCS13 +00452 DTSCS13 +00453 MOVE SPACE TO RESP-IND. DTSCS13 +00454 DTSCS13 +00455 IF REQ-ERROR DTSCS13 +00456 PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT DTSCS13 +00457 ELSE DTSCS13 +00458 IF REQ-JUMP DTSCS13 +00459 PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT DTSCS13 +00460 ELSE DTSCS13 +00461 IF REQ-CLEAR DTSCS13 +00462 PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT DTSCS13 +00463 ELSE DTSCS13 +00464 IF REQ-CURSOR-TO-GOTO DTSCS13 +00465 PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT DTSCS13 +00466 ELSE DTSCS13 +00467 IF REQ-INQUIRE DTSCS13 +00468 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT DTSCS13 +00469 ELSE DTSCS13 +00470 IF REQ-EDIT DTSCS13 +00471 PERFORM P7000-REQUEST-EDIT THRU P7000-EXIT DTSCS13 +00472 ELSE DTSCS13 +00473 IF REQ-UPDATE DTSCS13 +00474 PERFORM P8000-REQUEST-UPDATE THRU P8000-EXIT DTSCS13 +00475 ELSE DTSCS13 +00476 GO TO S899-ABEND. DTSCS13 +00477 SKIP3 DTSCS13 +00478 *----------------------------------------------------- DTSCS13 +00479 * THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED DTSCS13 +00480 * IN RESP-IND THE TYPE OF RESPONSE TO BE MADE. DTSCS13 +00481 *----------------------------------------------------- DTSCS13 +00482 DTSCS13 +00483 IF RESP-SEND-MAP DTSCS13 +00484 PERFORM S9300-SEND-MAP THRU S9300-EXIT DTSCS13 +00485 SET LCCM-END-TASK-88 TO TRUE DTSCS13 +00486 ELSE DTSCS13 +00487 IF RESP-SEND-MSGONLY DTSCS13 +00488 OR RESP-CURSOR-TO-GOTO DTSCS13 +00489 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS13 +00490 SET LCCM-END-TASK-88 TO TRUE DTSCS13 +00491 ELSE DTSCS13 +00492 IF RESP-JUMP DTSCS13 +00493 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS13 +00494 ELSE DTSCS13 +00495 GO TO S899-ABEND. DTSCS13 +00496 SKIP3 DTSCS13 +00497 MAINLINE-EXIT. DTSCS13 +00498 DTSCS13 +00499 EXEC CICS DTSCS13 +00500 RETURN DTSCS13 +00501 END-EXEC. DTSCS13 +00502 SKIP2 DTSCS13 +00503 /*****************************************************************DTSCS13 +00504 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION *DTSCS13 +00505 ******************************************************************DTSCS13 +00506 P1000-ANALYZE-REQUEST. DTSCS13 +00507 DTSCS13 00508 *----------------------------------------------------- DTSCS13 -00509 IF LCCM-SCR-ID NOT = WRK-SCR-ID DTSCS13 -00510 SET LCCM-ENTER-88 TO TRUE DTSCS13 -00511 SET REQ-INQUIRE TO TRUE DTSCS13 -00512 IF LCCM-EMP-NO > ZERO DTSCS13 -00513 MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1 DTSCS13 -00514 MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2 DTSCS13 -00515 END-IF DTSCS13 -00516 GO TO P1000-EXIT. DTSCS13 -00517 SKIP3 DTSCS13 -00518 *----------------------------------------------------- DTSCS13 -00519 * MAP IS RECEIVED DTSCS13 -00520 *----------------------------------------------------- DTSCS13 -00521 PERFORM S9100-RECEIVE THRU S9100-EXIT. DTSCS13 -00522 SKIP3 DTSCS13 -00523 *----------------------------------------------------- DTSCS13 -00524 * CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE DTSCS13 -00525 * WORK STATION DTSCS13 -00526 *----------------------------------------------------- DTSCS13 -00527 IF LCCM-CLEAR-88 DTSCS13 -00528 SET REQ-CLEAR TO TRUE DTSCS13 -00529 GO TO P1000-EXIT. DTSCS13 -00530 SKIP3 DTSCS13 -00531 *----------------------------------------------------- DTSCS13 -00532 * IF IN UPDATE MODE, SPECIFIC KEYS MUST BE CHECKED DTSCS13 -00533 *----------------------------------------------------- DTSCS13 -00534 IF LCCM-SCR-UPDATE-LOCKED DTSCS13 -00535 PERFORM P1100-UPDATE-LOCKED THRU P1100-EXIT DTSCS13 -00536 GO TO P1000-EXIT. DTSCS13 -00537 SKIP3 DTSCS13 -00538 *----------------------------------------------------- DTSCS13 -00539 * PA2 IS A REQUEST TO POSITION CURSOR AT GO TO: DTSCS13 -00540 *----------------------------------------------------- DTSCS13 -00541 IF LCCM-PA2-88 DTSCS13 -00542 SET REQ-CURSOR-TO-GOTO TO TRUE DTSCS13 -00543 GO TO P1000-EXIT. DTSCS13 -00544 SKIP3 DTSCS13 -00545 *----------------------------------------------------- DTSCS13 -00546 * ALL OTHER PA KEYS ARE NOT ACTIVE DTSCS13 -00547 *----------------------------------------------------- DTSCS13 -00548 IF LCCM-PA-88 DTSCS13 -00549 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS13 -00550 SET REQ-ERROR TO TRUE DTSCS13 -00551 GO TO P1000-EXIT. DTSCS13 -00552 SKIP3 DTSCS13 -00553 *----------------------------------------------------- DTSCS13 -00554 * IF F12 IS PRESSED AND UPDATE NOT IN PROGRESS THEN DTSCS13 -00555 * CLEAR SCREEN DTSCS13 -00556 *----------------------------------------------------- DTSCS13 -00557 IF LCCM-F12-88 DTSCS13 -00558 MOVE LOW-VALUES TO MAP-AREA DTSCS13 -00559 SET REQ-CLEAR TO TRUE DTSCS13 -00560 GO TO P1000-EXIT. DTSCS13 -00561 SKIP3 DTSCS13 -00562 *----------------------------------------------------- DTSCS13 -00563 * IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION DTSCS13 -00564 *----------------------------------------------------- DTSCS13 -00565 IF LCCM-F03-88 DTSCS13 -00566 MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID DTSCS13 -00567 SET REQ-JUMP TO TRUE DTSCS13 -00568 GO TO P1000-EXIT. DTSCS13 -00569 SKIP3 DTSCS13 -00570 *----------------------------------------------------- DTSCS13 -00571 * IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN DTSCS13 -00572 *----------------------------------------------------- DTSCS13 -00573 IF LCCM-F04-88 DTSCS13 -00574 MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS13 -00575 SET REQ-JUMP TO TRUE DTSCS13 -00576 GO TO P1000-EXIT. DTSCS13 -00577 SKIP3 DTSCS13 -00578 *----------------------------------------------------- DTSCS13 -00579 * IF CORRESPONDENCE SCREEN KEY PRESSED, JUMP TO DTSCS13 -00580 * CORRESPONDENCE SCREEN DTSCS13 -00581 *----------------------------------------------------- DTSCS13 -00582 IF LCCM-F14-88 DTSCS13 -00583 MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS13 -00584 SET REQ-JUMP TO TRUE DTSCS13 -00585 GO TO P1000-EXIT. DTSCS13 -00586 SKIP3 DTSCS13 -00587 *----------------------------------------------------- DTSCS13 -00588 * IF REGISTRATION INQUIRY SCREEN KEY PRESSED, DTSCS13 -00589 * THEN JUMP TO REGISTRATION INQUIRY SCREEN. DTSCS13 -00590 *----------------------------------------------------- DTSCS13 -00591 * IF LCCM-F17-88 DTSCS13 -00592 * MOVE '11' TO LCCM-REQ-SCR-ID DTSCS13 -00593 * SET REQ-JUMP TO TRUE DTSCS13 -00594 * GO TO P1000-EXIT. DTSCS13 -00595 * SKIP3 DTSCS13 -00596 *----------------------------------------------------- DTSCS13 -00597 * IF REGISTRATION SEARCHES SCREEN KEY PRESSED, DTSCS13 -00598 * THEN JUMP TO REGISTRATION SEARCHES SCREEN. DTSCS13 -00599 *----------------------------------------------------- DTSCS13 -00600 * IF LCCM-F18-88 DTSCS13 -00601 * MOVE '12' TO LCCM-REQ-SCR-ID DTSCS13 -00602 * SET REQ-JUMP TO TRUE DTSCS13 -00603 * GO TO P1000-EXIT. DTSCS13 -00604 * SKIP3 DTSCS13 -00605 *----------------------------------------------------- DTSCS13 -00606 * IF OWNER/PARTNER/OFFICER INQUIRY/UPDATE SCREEN KEY PRESSED, DTSCS13 -00607 * THEN JUMP TO OWNER/PARTNER/OFFICER INQUIRY/UPDATE SCREEN. DTSCS13 -00608 *----------------------------------------------------- DTSCS13 -00609 * IF LCCM-F21-88 DTSCS13 -00610 ** MOVE '15' TO LCCM-REQ-SCR-ID DTSCS13 -00611 * SET REQ-JUMP TO TRUE DTSCS13 -00612 * GO TO P1000-EXIT. DTSCS13 -00613 * SKIP3 DTSCS13 -00614 *----------------------------------------------------- DTSCS13 -00615 * IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO DTSCS13 -00616 * REQUESTED SCREEN TYPE DTSCS13 -00617 *----------------------------------------------------- DTSCS13 -00618 IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID DTSCS13 -00619 NEXT SENTENCE DTSCS13 -00620 ELSE DTSCS13 -00621 MOVE MAP-GOTO TO LCCM-REQ-SCR-ID DTSCS13 -00622 SET REQ-JUMP TO TRUE DTSCS13 -00623 GO TO P1000-EXIT. DTSCS13 -00624 SKIP3 DTSCS13 -00625 *----------------------------------------------------- DTSCS13 -00626 * IF REQUEST TO UPDATE THE DATA (ADD, MOD, DEL) DTSCS13 -00627 * VERIFY USER ACCESS TO PERFORM UPDATE DTSCS13 -00628 *----------------------------------------------------- DTSCS13 -00629 IF LCCM-F10-88 DTSCS13 -00630 IF SCR-ACCESS-UPDATE DTSCS13 -00631 SET REQ-EDIT TO TRUE DTSCS13 -00632 GO TO P1000-EXIT DTSCS13 -00633 ELSE DTSCS13 -00634 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS13 -00635 SET REQ-ERROR TO TRUE DTSCS13 -00636 GO TO P1000-EXIT. DTSCS13 -00637 SKIP3 DTSCS13 -00638 *----------------------------------------------------- DTSCS13 -00639 * IF INQUIRY TYPE KEY PRESSED (ENTER, PAGE DOWN, DTSCS13 -00640 * PAGE UP), INDICATE INQUIRY REQUEST DTSCS13 -00641 *----------------------------------------------------- DTSCS13 -00642 IF LCCM-ENTER-88 DTSCS13 -00643 SET REQ-INQUIRE TO TRUE DTSCS13 -00644 GO TO P1000-EXIT. DTSCS13 -00645 SKIP3 DTSCS13 -00646 *----------------------------------------------------- DTSCS13 -00647 * ANY OTHER KEY IS INVALID DTSCS13 -00648 *----------------------------------------------------- DTSCS13 -00649 PERFORM S804-INVALID-KEY THRU S804-EXIT. DTSCS13 -00650 SET REQ-ERROR TO TRUE. DTSCS13 -00651 P1000-EXIT. EXIT. DTSCS13 -00652 SKIP3 DTSCS13 -00653 ******************************************************************DTSCS13 -00654 * THE SCREEN IS LOCKED FOR UPDATE AND THE USER CONFIRMS HIS WISH *DTSCS13 -00655 ******************************************************************DTSCS13 -00656 DTSCS13 -00657 P1100-UPDATE-LOCKED. DTSCS13 -00658 *----------------------------------------------------- DTSCS13 -00659 * IF THE SCREEN IS "LOCKED FOR UPDATE", THEN DTSCS13 -00660 * THE ONLY VALID OPERATOR REQUESTS ARE ENTER DTSCS13 -00661 * (CONFIRMING UPDATE) OR F12 (CANCELLING UPDATE). DTSCS13 +00509 * IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE) DTSCS13 +00510 * THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE DTSCS13 +00511 * REPLACED WITH ENTER) DTSCS13 +00512 *----------------------------------------------------- DTSCS13 +00513 IF LCCM-SCR-ID NOT = WRK-SCR-ID DTSCS13 +00514 SET LCCM-ENTER-88 TO TRUE DTSCS13 +00515 SET REQ-INQUIRE TO TRUE DTSCS13 +00516 IF LCCM-EMP-NO > ZERO DTSCS13 +00517 MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1 DTSCS13 +00518 MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2 DTSCS13 +00519 END-IF DTSCS13 +00520 GO TO P1000-EXIT. DTSCS13 +00521 SKIP3 DTSCS13 +00522 *----------------------------------------------------- DTSCS13 +00523 * MAP IS RECEIVED DTSCS13 +00524 *----------------------------------------------------- DTSCS13 +00525 PERFORM S9100-RECEIVE THRU S9100-EXIT. DTSCS13 +00526 SKIP3 DTSCS13 +00527 *----------------------------------------------------- DTSCS13 +00528 * CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE DTSCS13 +00529 * WORK STATION DTSCS13 +00530 *----------------------------------------------------- DTSCS13 +00531 IF LCCM-CLEAR-88 DTSCS13 +00532 SET REQ-CLEAR TO TRUE DTSCS13 +00533 GO TO P1000-EXIT. DTSCS13 +00534 SKIP3 DTSCS13 +00535 *----------------------------------------------------- DTSCS13 +00536 * IF IN UPDATE MODE, SPECIFIC KEYS MUST BE CHECKED DTSCS13 +00537 *----------------------------------------------------- DTSCS13 +00538 IF LCCM-SCR-UPDATE-LOCKED DTSCS13 +00539 PERFORM P1100-UPDATE-LOCKED THRU P1100-EXIT DTSCS13 +00540 GO TO P1000-EXIT. DTSCS13 +00541 SKIP3 DTSCS13 +00542 *----------------------------------------------------- DTSCS13 +00543 * PA2 IS A REQUEST TO POSITION CURSOR AT GO TO: DTSCS13 +00544 *----------------------------------------------------- DTSCS13 +00545 IF LCCM-PA2-88 DTSCS13 +00546 SET REQ-CURSOR-TO-GOTO TO TRUE DTSCS13 +00547 GO TO P1000-EXIT. DTSCS13 +00548 SKIP3 DTSCS13 +00549 *----------------------------------------------------- DTSCS13 +00550 * ALL OTHER PA KEYS ARE NOT ACTIVE DTSCS13 +00551 *----------------------------------------------------- DTSCS13 +00552 IF LCCM-PA-88 DTSCS13 +00553 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS13 +00554 SET REQ-ERROR TO TRUE DTSCS13 +00555 GO TO P1000-EXIT. DTSCS13 +00556 SKIP3 DTSCS13 +00557 *----------------------------------------------------- DTSCS13 +00558 * IF F12 IS PRESSED AND UPDATE NOT IN PROGRESS THEN DTSCS13 +00559 * CLEAR SCREEN DTSCS13 +00560 *----------------------------------------------------- DTSCS13 +00561 IF LCCM-F12-88 DTSCS13 +00562 MOVE LOW-VALUES TO MAP-AREA DTSCS13 +00563 SET REQ-CLEAR TO TRUE DTSCS13 +00564 GO TO P1000-EXIT. DTSCS13 +00565 SKIP3 DTSCS13 +00566 *----------------------------------------------------- DTSCS13 +00567 * IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION DTSCS13 +00568 *----------------------------------------------------- DTSCS13 +00569 IF LCCM-F03-88 DTSCS13 +00570 MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID DTSCS13 +00571 SET REQ-JUMP TO TRUE DTSCS13 +00572 GO TO P1000-EXIT. DTSCS13 +00573 SKIP3 DTSCS13 +00574 *----------------------------------------------------- DTSCS13 +00575 * IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN DTSCS13 +00576 *----------------------------------------------------- DTSCS13 +00577 IF LCCM-F04-88 DTSCS13 +00578 MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS13 +00579 SET REQ-JUMP TO TRUE DTSCS13 +00580 GO TO P1000-EXIT. DTSCS13 +00581 SKIP3 DTSCS13 +00582 *----------------------------------------------------- DTSCS13 +00583 * IF CORRESPONDENCE SCREEN KEY PRESSED, JUMP TO DTSCS13 +00584 * CORRESPONDENCE SCREEN DTSCS13 +00585 *----------------------------------------------------- DTSCS13 +00586 IF LCCM-F14-88 DTSCS13 +00587 MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS13 +00588 SET REQ-JUMP TO TRUE DTSCS13 +00589 GO TO P1000-EXIT. DTSCS13 +00590 SKIP3 DTSCS13 +00591 *----------------------------------------------------- DTSCS13 +00592 * IF REGISTRATION INQUIRY SCREEN KEY PRESSED, DTSCS13 +00593 * THEN JUMP TO REGISTRATION INQUIRY SCREEN. DTSCS13 +00594 *----------------------------------------------------- DTSCS13 +00595 * IF LCCM-F17-88 DTSCS13 +00596 * MOVE '11' TO LCCM-REQ-SCR-ID DTSCS13 +00597 * SET REQ-JUMP TO TRUE DTSCS13 +00598 * GO TO P1000-EXIT. DTSCS13 +00599 * SKIP3 DTSCS13 +00600 *----------------------------------------------------- DTSCS13 +00601 * IF REGISTRATION SEARCHES SCREEN KEY PRESSED, DTSCS13 +00602 * THEN JUMP TO REGISTRATION SEARCHES SCREEN. DTSCS13 +00603 *----------------------------------------------------- DTSCS13 +00604 * IF LCCM-F18-88 DTSCS13 +00605 * MOVE '12' TO LCCM-REQ-SCR-ID DTSCS13 +00606 * SET REQ-JUMP TO TRUE DTSCS13 +00607 * GO TO P1000-EXIT. DTSCS13 +00608 * SKIP3 DTSCS13 +00609 *----------------------------------------------------- DTSCS13 +00610 * IF OWNER/PARTNER/OFFICER INQUIRY/UPDATE SCREEN KEY PRESSED, DTSCS13 +00611 * THEN JUMP TO OWNER/PARTNER/OFFICER INQUIRY/UPDATE SCREEN. DTSCS13 +00612 *----------------------------------------------------- DTSCS13 +00613 * IF LCCM-F21-88 DTSCS13 +00614 ** MOVE '15' TO LCCM-REQ-SCR-ID DTSCS13 +00615 * SET REQ-JUMP TO TRUE DTSCS13 +00616 * GO TO P1000-EXIT. DTSCS13 +00617 * SKIP3 DTSCS13 +00618 *----------------------------------------------------- DTSCS13 +00619 * IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO DTSCS13 +00620 * REQUESTED SCREEN TYPE DTSCS13 +00621 *----------------------------------------------------- DTSCS13 +00622 IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID DTSCS13 +00623 NEXT SENTENCE DTSCS13 +00624 ELSE DTSCS13 +00625 MOVE MAP-GOTO TO LCCM-REQ-SCR-ID DTSCS13 +00626 SET REQ-JUMP TO TRUE DTSCS13 +00627 GO TO P1000-EXIT. DTSCS13 +00628 SKIP3 DTSCS13 +00629 *----------------------------------------------------- DTSCS13 +00630 * IF REQUEST TO UPDATE THE DATA (ADD, MOD, DEL) DTSCS13 +00631 * VERIFY USER ACCESS TO PERFORM UPDATE DTSCS13 +00632 *----------------------------------------------------- DTSCS13 +00633 IF LCCM-F10-88 DTSCS13 +00634 IF SCR-ACCESS-UPDATE DTSCS13 +00635 SET REQ-EDIT TO TRUE DTSCS13 +00636 GO TO P1000-EXIT DTSCS13 +00637 ELSE DTSCS13 +00638 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS13 +00639 SET REQ-ERROR TO TRUE DTSCS13 +00640 GO TO P1000-EXIT. DTSCS13 +00641 SKIP3 DTSCS13 +00642 *----------------------------------------------------- DTSCS13 +00643 * IF INQUIRY TYPE KEY PRESSED (ENTER, PAGE DOWN, DTSCS13 +00644 * PAGE UP), INDICATE INQUIRY REQUEST DTSCS13 +00645 *----------------------------------------------------- DTSCS13 +00646 IF LCCM-ENTER-88 DTSCS13 +00647 SET REQ-INQUIRE TO TRUE DTSCS13 +00648 GO TO P1000-EXIT. DTSCS13 +00649 SKIP3 DTSCS13 +00650 *----------------------------------------------------- DTSCS13 +00651 * ANY OTHER KEY IS INVALID DTSCS13 +00652 *----------------------------------------------------- DTSCS13 +00653 PERFORM S804-INVALID-KEY THRU S804-EXIT. DTSCS13 +00654 SET REQ-ERROR TO TRUE. DTSCS13 +00655 P1000-EXIT. EXIT. DTSCS13 +00656 SKIP3 DTSCS13 +00657 ******************************************************************DTSCS13 +00658 * THE SCREEN IS LOCKED FOR UPDATE AND THE USER CONFIRMS HIS WISH *DTSCS13 +00659 ******************************************************************DTSCS13 +00660 DTSCS13 +00661 P1100-UPDATE-LOCKED. DTSCS13 00662 *----------------------------------------------------- DTSCS13 -00663 IF LCCM-ENTER-88 OR LCCM-F12-88 DTSCS13 -00664 SET REQ-UPDATE TO TRUE DTSCS13 -00665 ELSE DTSCS13 -00666 SET REQ-ERROR TO TRUE DTSCS13 -00667 IF LCCM-SCR-MOD-LOCKED DTSCS13 -00668 MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-AREA DTSCS13 -00669 ELSE DTSCS13 -00670 GO TO S899-ABEND. DTSCS13 -00671 P1100-EXIT. EXIT. DTSCS13 -00672 /*****************************************************************DTSCS13 -00673 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED. *DTSCS13 -00674 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN. *DTSCS13 -00675 ******************************************************************DTSCS13 -00676 DTSCS13 -00677 P2000-REQUEST-ERROR. DTSCS13 -00678 IF LCCM-MSG DTSCS13 -00679 SET RESP-SEND-MSGONLY TO TRUE DTSCS13 -00680 ELSE DTSCS13 -00681 GO TO S899-ABEND. DTSCS13 -00682 P2000-EXIT. EXIT. DTSCS13 -00683 /*****************************************************************DTSCS13 -00684 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED *DTSCS13 -00685 ******************************************************************DTSCS13 -00686 DTSCS13 -00687 P3000-REQUEST-JUMP. DTSCS13 -00688 *----------------------------------------------------- DTSCS13 -00689 * VERIFY THAT THE REQUESTED SCREEN EXISTS AND IS ACCESSIBLE DTSCS13 -00690 * BY USER DTSCS13 -00691 *----------------------------------------------------- DTSCS13 -00692 PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT. DTSCS13 -00693 SKIP3 DTSCS13 -00694 *----------------------------------------------------- DTSCS13 -00695 * VERIFICATION RETURN LCCM-MSG IF ERROR DETECTED DTSCS13 -00696 *----------------------------------------------------- DTSCS13 -00697 IF LCCM-MSG DTSCS13 -00698 SET RESP-SEND-MSGONLY TO TRUE DTSCS13 -00699 SET CURSOR-SET-GOTO TO TRUE DTSCS13 -00700 GO TO P3000-EXIT. DTSCS13 -00701 SKIP3 DTSCS13 -00702 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS13 -00703 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS13 -00704 IF L018-VALID DTSCS13 -00705 MOVE L018-EMP-NO TO LCCM-EMP-NO. DTSCS13 -00706 SKIP3 DTSCS13 -00707 *----------------------------------------------------- DTSCS13 -00708 * CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING DTSCS13 -00709 *----------------------------------------------------- DTSCS13 -00710 MOVE LOW-VALUES TO LCCM-SCR-STATUS DTSCS13 -00711 LCCM-SCR-HOLD-AREA. DTSCS13 -00712 MOVE +0 TO LCCM-SCR-ABSTIME. DTSCS13 -00713 SET RESP-JUMP TO TRUE. DTSCS13 -00714 P3000-EXIT. EXIT. DTSCS13 -00715 /*****************************************************************DTSCS13 -00716 * CLEAR KEY WAS PRESSED *DTSCS13 -00717 ******************************************************************DTSCS13 -00718 DTSCS13 -00719 P4000-REQUEST-CLEAR. DTSCS13 -00720 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS13 -00721 SKIP3 DTSCS13 -00722 *----------------------------------------------------- DTSCS13 -00723 * CLEAN UP INDICATORS AND PAGING STORAGE. RESET KEY DTSCS13 -00724 * FIELDS FROM EARLIER REQUESTS DTSCS13 -00725 *----------------------------------------------------- DTSCS13 -00726 IF LCCM-EMP-NO > ZERO DTSCS13 -00727 MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1 DTSCS13 -00728 MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2. DTSCS13 -00729 MOVE ZERO TO LCCM-EMP-NO. DTSCS13 -00730 DTSCS13 -00731 MOVE LOW-VALUES TO LCCM-SCR-HOLD-AREA. DTSCS13 -00732 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS13 -00733 SET LCCM-SCR-CLEAR TO TRUE. DTSCS13 -00734 SET RESP-SEND-MAP TO TRUE. DTSCS13 -00735 P4000-EXIT. EXIT. DTSCS13 -00736 /*****************************************************************DTSCS13 -00737 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED *DTSCS13 -00738 ******************************************************************DTSCS13 -00739 DTSCS13 -00740 P5000-CURSOR-TO-GOTO. DTSCS13 -00741 SET CURSOR-SET-GOTO TO TRUE. DTSCS13 -00742 SET RESP-CURSOR-TO-GOTO TO TRUE. DTSCS13 -00743 P5000-EXIT. EXIT. DTSCS13 -00744 /*****************************************************************DTSCS13 -00745 * INQUIRY WAS REQUESTED *DTSCS13 -00746 ******************************************************************DTSCS13 -00747 DTSCS13 -00748 P6000-REQUEST-INQUIRE. DTSCS13 -00749 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS13 -00750 MOVE LOW-VALUES TO MAP-AREA. DTSCS13 -00751 MOVE L018-S-EMP-NO-AREA TO MAP-EMP-NO-AREA. DTSCS13 -00752 DTSCS13 -00753 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS13 -00754 DTSCS13 -00755 SET LCCM-SCR-CLEAR TO TRUE. DTSCS13 -00756 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS13 -00757 DTSCS13 -00758 PERFORM S1001-SCREEN-KEY-EDITS THRU S1001-EXIT. DTSCS13 -00759 DTSCS13 -00760 IF LCCM-NO-MSG DTSCS13 -00761 IF LCCM-ENTER-88 DTSCS13 -00762 PERFORM P6100-NO-PAGE THRU P6100-EXIT DTSCS13 -00763 ELSE DTSCS13 -00764 GO TO S899-ABEND. DTSCS13 -00765 DTSCS13 -00766 SET RESP-SEND-MAP TO TRUE. DTSCS13 -00767 P6000-EXIT. EXIT. DTSCS13 -00768 EJECT DTSCS13 -00769 P6100-NO-PAGE. DTSCS13 -00770 PERFORM S8100-READ-MPRF THRU S8100-EXIT. DTSCS13 -00771 IF L810-NO-REC-88 DTSCS13 -00772 MOVE EMSG-NO-EMPLOYER TO WRK-MSG-AREA DTSCS13 -00773 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS13 -00774 ELSE DTSCS13 -00775 MOVE MSKL-REC TO MPRF-REC DTSCS13 -00776 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT. DTSCS13 -00777 P6100-EXIT. EXIT. DTSCS13 -00778 /*****************************************************************DTSCS13 -00779 * THE RECORD WAS FOUND SO FORMAT AND PLACE ALL FIELDS *DTSCS13 -00780 ******************************************************************DTSCS13 -00781 DTSCS13 -00782 P6900-CONSTRUCT-SCREEN. DTSCS13 -00783 IF SCR-ACCESS-UPDATE DTSCS13 -00784 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS13 +00663 * IF THE SCREEN IS "LOCKED FOR UPDATE", THEN DTSCS13 +00664 * THE ONLY VALID OPERATOR REQUESTS ARE ENTER DTSCS13 +00665 * (CONFIRMING UPDATE) OR F12 (CANCELLING UPDATE). DTSCS13 +00666 *----------------------------------------------------- DTSCS13 +00667 IF LCCM-ENTER-88 OR LCCM-F12-88 DTSCS13 +00668 SET REQ-UPDATE TO TRUE DTSCS13 +00669 ELSE DTSCS13 +00670 SET REQ-ERROR TO TRUE DTSCS13 +00671 IF LCCM-SCR-MOD-LOCKED DTSCS13 +00672 MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-AREA DTSCS13 +00673 ELSE DTSCS13 +00674 GO TO S899-ABEND. DTSCS13 +00675 P1100-EXIT. EXIT. DTSCS13 +00676 /*****************************************************************DTSCS13 +00677 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED. *DTSCS13 +00678 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN. *DTSCS13 +00679 ******************************************************************DTSCS13 +00680 DTSCS13 +00681 P2000-REQUEST-ERROR. DTSCS13 +00682 IF LCCM-MSG DTSCS13 +00683 SET RESP-SEND-MSGONLY TO TRUE DTSCS13 +00684 ELSE DTSCS13 +00685 GO TO S899-ABEND. DTSCS13 +00686 P2000-EXIT. EXIT. DTSCS13 +00687 /*****************************************************************DTSCS13 +00688 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED *DTSCS13 +00689 ******************************************************************DTSCS13 +00690 DTSCS13 +00691 P3000-REQUEST-JUMP. DTSCS13 +00692 *----------------------------------------------------- DTSCS13 +00693 * VERIFY THAT THE REQUESTED SCREEN EXISTS AND IS ACCESSIBLE DTSCS13 +00694 * BY USER DTSCS13 +00695 *----------------------------------------------------- DTSCS13 +00696 PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT. DTSCS13 +00697 SKIP3 DTSCS13 +00698 *----------------------------------------------------- DTSCS13 +00699 * VERIFICATION RETURN LCCM-MSG IF ERROR DETECTED DTSCS13 +00700 *----------------------------------------------------- DTSCS13 +00701 IF LCCM-MSG DTSCS13 +00702 SET RESP-SEND-MSGONLY TO TRUE DTSCS13 +00703 SET CURSOR-SET-GOTO TO TRUE DTSCS13 +00704 GO TO P3000-EXIT. DTSCS13 +00705 SKIP3 DTSCS13 +00706 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS13 +00707 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS13 +00708 IF L018-VALID DTSCS13 +00709 MOVE L018-EMP-NO TO LCCM-EMP-NO. DTSCS13 +00710 SKIP3 DTSCS13 +00711 *----------------------------------------------------- DTSCS13 +00712 * CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING DTSCS13 +00713 *----------------------------------------------------- DTSCS13 +00714 MOVE LOW-VALUES TO LCCM-SCR-STATUS DTSCS13 +00715 LCCM-SCR-HOLD-AREA. DTSCS13 +00716 MOVE +0 TO LCCM-SCR-ABSTIME. DTSCS13 +00717 SET RESP-JUMP TO TRUE. DTSCS13 +00718 P3000-EXIT. EXIT. DTSCS13 +00719 /*****************************************************************DTSCS13 +00720 * CLEAR KEY WAS PRESSED *DTSCS13 +00721 ******************************************************************DTSCS13 +00722 DTSCS13 +00723 P4000-REQUEST-CLEAR. DTSCS13 +00724 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS13 +00725 SKIP3 DTSCS13 +00726 *----------------------------------------------------- DTSCS13 +00727 * CLEAN UP INDICATORS AND PAGING STORAGE. RESET KEY DTSCS13 +00728 * FIELDS FROM EARLIER REQUESTS DTSCS13 +00729 *----------------------------------------------------- DTSCS13 +00730 IF LCCM-EMP-NO > ZERO DTSCS13 +00731 MOVE LCCM-EMP-NO-1 TO MAP-EMP-NO-1 DTSCS13 +00732 MOVE LCCM-EMP-NO-2 TO MAP-EMP-NO-2. DTSCS13 +00733 MOVE ZERO TO LCCM-EMP-NO. DTSCS13 +00734 DTSCS13 +00735 MOVE LOW-VALUES TO LCCM-SCR-HOLD-AREA. DTSCS13 +00736 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS13 +00737 SET LCCM-SCR-CLEAR TO TRUE. DTSCS13 +00738 SET RESP-SEND-MAP TO TRUE. DTSCS13 +00739 P4000-EXIT. EXIT. DTSCS13 +00740 /*****************************************************************DTSCS13 +00741 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED *DTSCS13 +00742 ******************************************************************DTSCS13 +00743 DTSCS13 +00744 P5000-CURSOR-TO-GOTO. DTSCS13 +00745 SET CURSOR-SET-GOTO TO TRUE. DTSCS13 +00746 SET RESP-CURSOR-TO-GOTO TO TRUE. DTSCS13 +00747 P5000-EXIT. EXIT. DTSCS13 +00748 /*****************************************************************DTSCS13 +00749 * INQUIRY WAS REQUESTED *DTSCS13 +00750 ******************************************************************DTSCS13 +00751 DTSCS13 +00752 P6000-REQUEST-INQUIRE. DTSCS13 +00753 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS13 +00754 MOVE LOW-VALUES TO MAP-AREA. DTSCS13 +00755 MOVE L018-S-EMP-NO-AREA TO MAP-EMP-NO-AREA. DTSCS13 +00756 DTSCS13 +00757 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS13 +00758 DTSCS13 +00759 SET LCCM-SCR-CLEAR TO TRUE. DTSCS13 +00760 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS13 +00761 DTSCS13 +00762 PERFORM S1001-SCREEN-KEY-EDITS THRU S1001-EXIT. DTSCS13 +00763 DTSCS13 +00764 IF LCCM-NO-MSG DTSCS13 +00765 IF LCCM-ENTER-88 DTSCS13 +00766 PERFORM P6100-NO-PAGE THRU P6100-EXIT DTSCS13 +00767 ELSE DTSCS13 +00768 GO TO S899-ABEND. DTSCS13 +00769 DTSCS13 +00770 SET RESP-SEND-MAP TO TRUE. DTSCS13 +00771 P6000-EXIT. EXIT. DTSCS13 +00772 EJECT DTSCS13 +00773 P6100-NO-PAGE. DTSCS13 +00774 PERFORM S8100-READ-MPRF THRU S8100-EXIT. DTSCS13 +00775 IF L810-NO-REC-88 DTSCS13 +00776 MOVE EMSG-NO-EMPLOYER TO WRK-MSG-AREA DTSCS13 +00777 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS13 +00778 ELSE DTSCS13 +00779 MOVE MSKL-REC TO MPRF-REC DTSCS13 +00780 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT. DTSCS13 +00781 P6100-EXIT. EXIT. DTSCS13 +00782 /*****************************************************************DTSCS13 +00783 * THE RECORD WAS FOUND SO FORMAT AND PLACE ALL FIELDS *DTSCS13 +00784 ******************************************************************DTSCS13 00785 DTSCS13 -00786 PERFORM P6910-FROM-MPRF THRU P6910-EXIT. DTSCS13 -00787 PERFORM P6920-FROM-MTAD THRU P6920-EXIT DTSCS13 -00788 VARYING WRK-TAD FROM 1 BY 1 DTSCS13 -00789 UNTIL WRK-TAD GREATER THAN 2. DTSCS13 -00790 SKIP3 DTSCS13 -00791 DTSCS13 -00792 PERFORM P6930-FROM-MFAE THRU P6930-EXIT. DTSCS13 -00793 DTSCS13 -00794 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS13 -00795 MOVE WRK-EMP-NO TO LCCM-EMP-NO. DTSCS13 -00796 P6900-EXIT. EXIT. DTSCS13 -00797 SKIP3 DTSCS13 -00798 ******************************************************************DTSCS13 -00799 * *DTSCS13 -00800 ******************************************************************DTSCS13 -00801 P6910-FROM-MPRF. DTSCS13 -00802 MOVE MPRF-PRIMARY-NAME TO MAP-PRIMARY-NAME. DTSCS13 -00803 MOVE MPRF-ENTITY-NAME TO MAP-ENTITY-NAME. DTSCS13 -00804 MOVE MPRF-ENTITY-NAME-IND TO MAP-ENTITY-NAME-IND. DTSCS13 -00805 P6910-EXIT. EXIT. DTSCS13 -00806 SKIP3 DTSCS13 -00807 ******************************************************************DTSCS13 -00808 * STEP THROUGH TAX ADDRESSES 1, AND 2 *DTSCS13 -00809 ******************************************************************DTSCS13 -00810 P6920-FROM-MTAD. DTSCS13 -00811 PERFORM S8200-READ-MTAD THRU S8200-EXIT. DTSCS13 -00812 IF L810-NO-REC-88 DTSCS13 -00813 GO TO P6920-EXIT. DTSCS13 -00814 DTSCS13 -00815 MOVE MSKL-REC TO MTAD-REC. DTSCS13 -00816 MOVE MTAD-ATTN-LINE TO MAP-ATTN (WRK-TAD). DTSCS13 -00817 MOVE MTAD-DELIV-LINE-1 TO MAP-DLV1 (WRK-TAD). DTSCS13 -00818 MOVE MTAD-DELIV-LINE-2 TO MAP-DLV2 (WRK-TAD). DTSCS13 -00819 MOVE MTAD-CITY TO MAP-CITY (WRK-TAD). DTSCS13 -00820 MOVE MTAD-ST TO MAP-STAT (WRK-TAD). DTSCS13 -00821 MOVE MTAD-ZIP TO MAP-ZIPC (WRK-TAD). DTSCS13 -00822 IF MTAD-PHONE-NUMBERS NOT = SPACE DTSCS13 -00823 MOVE MTAD-VOICE-1-AREA-CD TO MAP-PHONE-A-CD (WRK-TAD, 1) DTSCS13 -00824 MOVE MTAD-VOICE-1-PREFIX TO MAP-PHONE-PREF (WRK-TAD, 1) DTSCS13 -00825 MOVE MTAD-VOICE-1-SUFFIX TO MAP-PHONE-SUFF (WRK-TAD, 1) DTSCS13 -00826 MOVE MTAD-VOICE-1-EXT TO MAP-PHONE-EXT (WRK-TAD, 1) DTSCS13 -00827 MOVE MTAD-VOICE-2-AREA-CD TO MAP-PHONE-A-CD (WRK-TAD, 2) DTSCS13 -00828 MOVE MTAD-VOICE-2-PREFIX TO MAP-PHONE-PREF (WRK-TAD, 2) DTSCS13 -00829 MOVE MTAD-VOICE-2-SUFFIX TO MAP-PHONE-SUFF (WRK-TAD, 2) DTSCS13 -00830 MOVE MTAD-VOICE-2-EXT TO MAP-PHONE-EXT (WRK-TAD, 2) DTSCS13 -00831 MOVE MTAD-FAX-AREA-CD TO MAP-PHONE-A-CD (WRK-TAD, 3) DTSCS13 -00832 MOVE MTAD-FAX-PREFIX TO MAP-PHONE-PREF (WRK-TAD, 3) DTSCS13 -00833 MOVE MTAD-FAX-SUFFIX TO MAP-PHONE-SUFF (WRK-TAD, 3) DTSCS13 -00834 MOVE MTAD-FAX-EXT TO MAP-PHONE-EXT (WRK-TAD, 3). DTSCS13 -00835 MOVE MTAD-EMAIL-ADDRESS TO MAP-EMAIL(WRK-TAD). DTSCS13 -00836 MOVE MTAD-UC223-IND TO MAP-MEMO (WRK-TAD). DTSCS13 -00837 MOVE MTAD-MISSING-RPT-LETTERS-IND TO MAP-MISS(WRK-TAD). DTSCS13 -00838 MOVE MTAD-PHYSICAL-ADDRESS-IND TO MAP-ADDR(WRK-TAD). DTSCS13 -00839 P6920-EXIT. EXIT. DTSCS13 -00840 DTSCS13 -00841 P6930-FROM-MFAE. DTSCS13 -00842 MOVE LOW-VALUES TO MFAE-KEY-AREA. DTSCS13 -00843 DTSCS13 -00844 MOVE WRK-EMP-NO TO MFAE-EMP-NO. DTSCS13 -00845 DTSCS13 -00846 SET MFAE-FAE-88 TO TRUE. DTSCS13 +00786 P6900-CONSTRUCT-SCREEN. DTSCS13 +00787 IF SCR-ACCESS-UPDATE DTSCS13 +00788 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS13 +00789 DTSCS13 +00790 PERFORM P6910-FROM-MPRF THRU P6910-EXIT. DTSCS13 +00791 PERFORM P6920-FROM-MTAD THRU P6920-EXIT DTSCS13 +00792 VARYING WRK-TAD FROM 1 BY 1 DTSCS13 +00793 UNTIL WRK-TAD GREATER THAN 2. DTSCS13 +00794 SKIP3 DTSCS13 +00795 DTSCS13 +00796 PERFORM P6930-FROM-MFAE THRU P6930-EXIT. DTSCS13 +00797 DTSCS13 +00798 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS13 +00799 MOVE WRK-EMP-NO TO LCCM-EMP-NO. DTSCS13 +00800 P6900-EXIT. EXIT. DTSCS13 +00801 SKIP3 DTSCS13 +00802 ******************************************************************DTSCS13 +00803 * *DTSCS13 +00804 ******************************************************************DTSCS13 +00805 P6910-FROM-MPRF. DTSCS13 +00806 MOVE MPRF-PRIMARY-NAME TO MAP-PRIMARY-NAME. DTSCS13 +00807 MOVE MPRF-ENTITY-NAME TO MAP-ENTITY-NAME. DTSCS13 +00808 MOVE MPRF-ENTITY-NAME-IND TO MAP-ENTITY-NAME-IND. DTSCS13 +00809 P6910-EXIT. EXIT. DTSCS13 +00810 SKIP3 DTSCS13 +00811 ******************************************************************DTSCS13 +00812 * STEP THROUGH TAX ADDRESSES 1, AND 2 *DTSCS13 +00813 ******************************************************************DTSCS13 +00814 P6920-FROM-MTAD. DTSCS13 +00815 PERFORM S8200-READ-MTAD THRU S8200-EXIT. DTSCS13 +00816 IF L810-NO-REC-88 DTSCS13 +00817 GO TO P6920-EXIT. DTSCS13 +00818 DTSCS13 +00819 MOVE MSKL-REC TO MTAD-REC. DTSCS13 +00820 MOVE MTAD-ATTN-LINE TO MAP-ATTN (WRK-TAD). DTSCS13 +00821 MOVE MTAD-DELIV-LINE-1 TO MAP-DLV1 (WRK-TAD). DTSCS13 +00822 MOVE MTAD-DELIV-LINE-2 TO MAP-DLV2 (WRK-TAD). DTSCS13 +00823 MOVE MTAD-CITY TO MAP-CITY (WRK-TAD). DTSCS13 +00824 MOVE MTAD-ST TO MAP-STAT (WRK-TAD). DTSCS13 +00825 MOVE MTAD-ZIP TO MAP-ZIPC (WRK-TAD). DTSCS13 +00826 IF MTAD-PHONE-NUMBERS NOT = SPACE DTSCS13 +00827 MOVE MTAD-VOICE-1-AREA-CD TO MAP-PHONE-A-CD (WRK-TAD, 1) DTSCS13 +00828 MOVE MTAD-VOICE-1-PREFIX TO MAP-PHONE-PREF (WRK-TAD, 1) DTSCS13 +00829 MOVE MTAD-VOICE-1-SUFFIX TO MAP-PHONE-SUFF (WRK-TAD, 1) DTSCS13 +00830 MOVE MTAD-VOICE-1-EXT TO MAP-PHONE-EXT (WRK-TAD, 1) DTSCS13 +00831 MOVE MTAD-VOICE-2-AREA-CD TO MAP-PHONE-A-CD (WRK-TAD, 2) DTSCS13 +00832 MOVE MTAD-VOICE-2-PREFIX TO MAP-PHONE-PREF (WRK-TAD, 2) DTSCS13 +00833 MOVE MTAD-VOICE-2-SUFFIX TO MAP-PHONE-SUFF (WRK-TAD, 2) DTSCS13 +00834 MOVE MTAD-VOICE-2-EXT TO MAP-PHONE-EXT (WRK-TAD, 2) DTSCS13 +00835 MOVE MTAD-FAX-AREA-CD TO MAP-PHONE-A-CD (WRK-TAD, 3) DTSCS13 +00836 MOVE MTAD-FAX-PREFIX TO MAP-PHONE-PREF (WRK-TAD, 3) DTSCS13 +00837 MOVE MTAD-FAX-SUFFIX TO MAP-PHONE-SUFF (WRK-TAD, 3) DTSCS13 +00838 MOVE MTAD-FAX-EXT TO MAP-PHONE-EXT (WRK-TAD, 3). DTSCS13 +00839 MOVE MTAD-EMAIL-ADDRESS TO MAP-EMAIL(WRK-TAD). DTSCS13 +00840 MOVE MTAD-UC223-IND TO MAP-MEMO (WRK-TAD). DTSCS13 +00841 MOVE MTAD-MISSING-RPT-LETTERS-IND TO MAP-MISS(WRK-TAD). DTSCS13 +00842 MOVE MTAD-PHYSICAL-ADDRESS-IND TO MAP-ADDR(WRK-TAD). DTSCS13 +00843 P6920-EXIT. EXIT. DTSCS13 +00844 DTSCS13 +00845 P6930-FROM-MFAE. DTSCS13 +00846 MOVE LOW-VALUES TO MFAE-KEY-AREA. DTSCS13 00847 DTSCS13 -00848 SET MFAE-SERVICE-CORRESPOND-88 TO TRUE. DTSCS13 +00848 MOVE WRK-EMP-NO TO MFAE-EMP-NO. DTSCS13 00849 DTSCS13 -00850 MOVE MFAE-KEY-AREA TO MSKL-KEY-AREA. DTSCS13 +00850 SET MFAE-FAE-88 TO TRUE. DTSCS13 00851 DTSCS13 -00852 PERFORM S810-READ THRU S810-EXIT. DTSCS13 -00853 IF L810-OK-88 DTSCS13 -00854 MOVE MSKL-REC TO MFAE-REC DTSCS13 -00855 MOVE MFAE-FISCAL-AGENT-CD TO MAP-FISC-AGNT-CD DTSCS13 -00856 SET WRK-MFAE-YES-88 TO TRUE. DTSCS13 -00857 DTSCS13 -00858 P6930-EXIT. DTSCS13 -00859 EXIT. DTSCS13 -00860 /*****************************************************************DTSCS13 +00852 SET MFAE-SERVICE-CORRESPOND-88 TO TRUE. DTSCS13 +00853 DTSCS13 +00854 MOVE MFAE-KEY-AREA TO MSKL-KEY-AREA. DTSCS13 +00855 DTSCS13 +00856 PERFORM S810-READ THRU S810-EXIT. DTSCS13 +00857 IF L810-OK-88 DTSCS13 +00858 MOVE MSKL-REC TO MFAE-REC DTSCS13 +00859 MOVE MFAE-FISCAL-AGENT-CD TO MAP-FISC-AGNT-CD DTSCS13 +00860 SET WRK-MFAE-YES-88 TO TRUE. DTSCS13 00861 DTSCS13 -00862 DTSCS13 -00863 /*****************************************************************DTSCS13 -00864 * FUNCTION KEY TO ADD, MOD OR DEL THE RECORD WAS PRESSED. *DTSCS13 -00865 ******************************************************************DTSCS13 +00862 P6930-EXIT. DTSCS13 +00863 EXIT. DTSCS13 +00864 /*****************************************************************DTSCS13 +00865 DTSCS13 00866 DTSCS13 -00867 P7000-REQUEST-EDIT. DTSCS13 -00868 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS13 -00869 DTSCS13 -00870 IF LCCM-F10-88 DTSCS13 -00871 PERFORM P7200-EDIT-MOD THRU P7200-EXIT DTSCS13 -00872 ELSE DTSCS13 -00873 GO TO S899-ABEND. DTSCS13 -00874 SKIP3 DTSCS13 -00875 *------------------------------------------------------ DTSCS13 -00876 * SCREEN STATUS IS NOT CHANGED IF AN ERROR IS DETECTED. DTSCS13 -00877 * IN ORDER TO CONTINUE TO ATTEMPT AN ADD THE SCREEN MUST REMAIN DTSCS13 -00878 * IN A 'CLEAR' STATE. THE SCREEN MUST BE IN 'INQUIRE' STATUS DTSCS13 -00879 * IF MOD OR DEL FUNCTIONS ARE BEING REQUESTED. DTSCS13 -00880 *------------------------------------------------------ DTSCS13 -00881 DTSCS13 -00882 IF LCCM-MSG DTSCS13 -00883 NEXT SENTENCE DTSCS13 -00884 ELSE DTSCS13 -00885 PERFORM S5100-SET-LOCK-ATTRB THRU S5100-EXIT DTSCS13 -00886 IF LCCM-F10-88 DTSCS13 -00887 SET LCCM-SCR-MOD-LOCKED TO TRUE DTSCS13 -00888 MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-AREA. DTSCS13 -00889 DTSCS13 -00890 SET RESP-SEND-MAP TO TRUE. DTSCS13 -00891 P7000-EXIT. EXIT. DTSCS13 -00892 /*****************************************************************DTSCS13 -00893 * MODIFICATION FUNCTION WAS REQUESTED *DTSCS13 -00894 ******************************************************************DTSCS13 -00895 DTSCS13 -00896 P7200-EDIT-MOD. DTSCS13 -00897 *----------------------------------------------------- DTSCS13 -00898 * MODIFICATION REQUIRES THAT A RECORD WAS SUCCESSFULLY DTSCS13 -00899 * INQUIRED DTSCS13 -00900 *----------------------------------------------------- DTSCS13 -00901 IF NOT LCCM-SCR-INQUIRE DTSCS13 -00902 MOVE EMSG-MOD-PRECEDED TO LCCM-MSG-AREA DTSCS13 -00903 GO TO P7200-EXIT. DTSCS13 -00904 SKIP3 DTSCS13 -00905 *----------------------------------------------------- DTSCS13 -00906 * MAP-EMP-NO MAY NOT BE CHANGED DURING THE MOD DTSCS13 -00907 *----------------------------------------------------- DTSCS13 -00908 DTSCS13 -00909 PERFORM S1001-SCREEN-KEY-EDITS THRU S1001-EXIT. DTSCS13 -00910 IF LCCM-MSG DTSCS13 -00911 GO TO P7200-EXIT. DTSCS13 +00867 /*****************************************************************DTSCS13 +00868 * FUNCTION KEY TO ADD, MOD OR DEL THE RECORD WAS PRESSED. *DTSCS13 +00869 ******************************************************************DTSCS13 +00870 DTSCS13 +00871 P7000-REQUEST-EDIT. DTSCS13 +00872 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS13 +00873 DTSCS13 +00874 IF LCCM-F10-88 DTSCS13 +00875 PERFORM P7200-EDIT-MOD THRU P7200-EXIT DTSCS13 +00876 ELSE DTSCS13 +00877 GO TO S899-ABEND. DTSCS13 +00878 SKIP3 DTSCS13 +00879 *------------------------------------------------------ DTSCS13 +00880 * SCREEN STATUS IS NOT CHANGED IF AN ERROR IS DETECTED. DTSCS13 +00881 * IN ORDER TO CONTINUE TO ATTEMPT AN ADD THE SCREEN MUST REMAIN DTSCS13 +00882 * IN A 'CLEAR' STATE. THE SCREEN MUST BE IN 'INQUIRE' STATUS DTSCS13 +00883 * IF MOD OR DEL FUNCTIONS ARE BEING REQUESTED. DTSCS13 +00884 *------------------------------------------------------ DTSCS13 +00885 DTSCS13 +00886 IF LCCM-MSG DTSCS13 +00887 NEXT SENTENCE DTSCS13 +00888 ELSE DTSCS13 +00889 PERFORM S5100-SET-LOCK-ATTRB THRU S5100-EXIT DTSCS13 +00890 IF LCCM-F10-88 DTSCS13 +00891 SET LCCM-SCR-MOD-LOCKED TO TRUE DTSCS13 +00892 MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-AREA. DTSCS13 +00893 DTSCS13 +00894 SET RESP-SEND-MAP TO TRUE. DTSCS13 +00895 P7000-EXIT. EXIT. DTSCS13 +00896 /*****************************************************************DTSCS13 +00897 * MODIFICATION FUNCTION WAS REQUESTED *DTSCS13 +00898 ******************************************************************DTSCS13 +00899 DTSCS13 +00900 P7200-EDIT-MOD. DTSCS13 +00901 *----------------------------------------------------- DTSCS13 +00902 * MODIFICATION REQUIRES THAT A RECORD WAS SUCCESSFULLY DTSCS13 +00903 * INQUIRED DTSCS13 +00904 *----------------------------------------------------- DTSCS13 +00905 IF NOT LCCM-SCR-INQUIRE DTSCS13 +00906 MOVE EMSG-MOD-PRECEDED TO LCCM-MSG-AREA DTSCS13 +00907 GO TO P7200-EXIT. DTSCS13 +00908 SKIP3 DTSCS13 +00909 *----------------------------------------------------- DTSCS13 +00910 * MAP-EMP-NO MAY NOT BE CHANGED DURING THE MOD DTSCS13 +00911 *----------------------------------------------------- DTSCS13 00912 DTSCS13 -00913 IF LCCM-EMP-NO NOT = WRK-EMP-NO DTSCS13 -00914 MOVE EMSG-NO-FIELD-CHANGE-UPDATE TO WRK-MSG-AREA DTSCS13 -00915 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS13 -00916 GO TO P7200-EXIT. DTSCS13 -00917 DTSCS13 -00918 PERFORM S8100-READ-MPRF THRU S8100-EXIT. DTSCS13 -00919 IF L810-NO-REC-88 DTSCS13 -00920 MOVE EMSG-NO-EMPLOYER TO WRK-MSG-AREA DTSCS13 -00921 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS13 -00922 ELSE DTSCS13 -00923 MOVE MSKL-REC TO MPRF-REC DTSCS13 -00924 PERFORM S1002-SCREEN-DATA-EDITS THRU S1002-EXIT. DTSCS13 -00925 P7200-EXIT. EXIT. DTSCS13 -00926 /*****************************************************************DTSCS13 -00927 * THE UPDATE/ADD/DELETE FUNCTION WAS CONFIRMED OR CANCELED *DTSCS13 -00928 ******************************************************************DTSCS13 -00929 DTSCS13 -00930 P8000-REQUEST-UPDATE. DTSCS13 -00931 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS13 -00932 DTSCS13 -00933 IF LCCM-SCR-MOD-LOCKED DTSCS13 -00934 PERFORM P8200-MOD THRU P8200-EXIT DTSCS13 -00935 ELSE DTSCS13 -00936 GO TO S899-ABEND. DTSCS13 -00937 DTSCS13 -00938 SET RESP-SEND-MAP TO TRUE. DTSCS13 -00939 P8000-EXIT. EXIT. DTSCS13 -00940 /*****************************************************************DTSCS13 -00941 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS *DTSCS13 -00942 ******************************************************************DTSCS13 -00943 DTSCS13 -00944 P8200-MOD. DTSCS13 -00945 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS13 -00946 DTSCS13 -00947 IF LCCM-F12-88 DTSCS13 -00948 MOVE PMSG-MOD-CANCELED TO LCCM-MSG-AREA DTSCS13 -00949 GO TO P8200-EXIT. DTSCS13 +00913 PERFORM S1001-SCREEN-KEY-EDITS THRU S1001-EXIT. DTSCS13 +00914 IF LCCM-MSG DTSCS13 +00915 GO TO P7200-EXIT. DTSCS13 +00916 DTSCS13 +00917 IF LCCM-EMP-NO NOT = WRK-EMP-NO DTSCS13 +00918 MOVE EMSG-NO-FIELD-CHANGE-UPDATE TO WRK-MSG-AREA DTSCS13 +00919 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS13 +00920 GO TO P7200-EXIT. DTSCS13 +00921 DTSCS13 +00922 PERFORM S8100-READ-MPRF THRU S8100-EXIT. DTSCS13 +00923 IF L810-NO-REC-88 DTSCS13 +00924 MOVE EMSG-NO-EMPLOYER TO WRK-MSG-AREA DTSCS13 +00925 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS13 +00926 ELSE DTSCS13 +00927 MOVE MSKL-REC TO MPRF-REC DTSCS13 +00928 PERFORM S1002-SCREEN-DATA-EDITS THRU S1002-EXIT. DTSCS13 +00929 P7200-EXIT. EXIT. DTSCS13 +00930 /*****************************************************************DTSCS13 +00931 * THE UPDATE/ADD/DELETE FUNCTION WAS CONFIRMED OR CANCELED *DTSCS13 +00932 ******************************************************************DTSCS13 +00933 DTSCS13 +00934 P8000-REQUEST-UPDATE. DTSCS13 +00935 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS13 +00936 DTSCS13 +00937 IF LCCM-SCR-MOD-LOCKED DTSCS13 +00938 PERFORM P8200-MOD THRU P8200-EXIT DTSCS13 +00939 ELSE DTSCS13 +00940 GO TO S899-ABEND. DTSCS13 +00941 DTSCS13 +00942 SET RESP-SEND-MAP TO TRUE. DTSCS13 +00943 P8000-EXIT. EXIT. DTSCS13 +00944 /*****************************************************************DTSCS13 +00945 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS *DTSCS13 +00946 ******************************************************************DTSCS13 +00947 DTSCS13 +00948 P8200-MOD. DTSCS13 +00949 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS13 00950 DTSCS13 -00951 PERFORM S1001-SCREEN-KEY-EDITS THRU S1001-EXIT. DTSCS13 -00952 SKIP3 DTSCS13 -00953 MOVE 'M' TO L221-UPDATE-FUNCTION. DTSCS13 -00954 PERFORM P8800-LOCK-EMPLOYER THRU P8800-EXIT. DTSCS13 -00955 IF LCCM-MSG DTSCS13 -00956 GO TO P8200-EXIT. DTSCS13 -00957 DTSCS13 -00958 PERFORM S330-EMP-INIT-MLOG THRU S330-EXIT. DTSCS13 -00959 DTSCS13 -00960 PERFORM S8100-READ-MPRF THRU S8100-EXIT. DTSCS13 -00961 IF L810-NO-REC-88 DTSCS13 -00962 GO TO S899-ABEND DTSCS13 -00963 ELSE DTSCS13 -00964 MOVE MSKL-REC TO MPRF-REC. DTSCS13 -00965 DTSCS13 -00966 ** NOTE: MTAD RECORDS MUST BE UPDATED BEFORE THE MPRF RECORD IS. DTSCS13 -00967 PERFORM P8910-MTAD-UPDATE THRU P8910-EXIT DTSCS13 -00968 VARYING WRK-TAD FROM 1 BY 1 DTSCS13 -00969 UNTIL WRK-TAD GREATER THAN 2. DTSCS13 -00970 DTSCS13 -00971 SET WRK-RET-MAIL-NO-88 TO TRUE. DTSCS13 -00972 PERFORM P8920-MPRF-UPDATE THRU P8920-EXIT. DTSCS13 -00973 DTSCS13 -00974 PERFORM P8930-MFAE-UPDATE THRU P8930-EXIT. DTSCS13 -00975 DTSCS13 -00976 IF WRK-RET-MAIL-YES-88 DTSCS13 -00977 PERFORM P8940-ADD-MEVL THRU P8940-EXIT DTSCS13 -00978 END-IF. DTSCS13 +00951 IF LCCM-F12-88 DTSCS13 +00952 MOVE PMSG-MOD-CANCELED TO LCCM-MSG-AREA DTSCS13 +00953 GO TO P8200-EXIT. DTSCS13 +00954 DTSCS13 +00955 PERFORM S1001-SCREEN-KEY-EDITS THRU S1001-EXIT. DTSCS13 +00956 SKIP3 DTSCS13 +00957 MOVE 'M' TO L221-UPDATE-FUNCTION. DTSCS13 +00958 PERFORM P8800-LOCK-EMPLOYER THRU P8800-EXIT. DTSCS13 +00959 IF LCCM-MSG DTSCS13 +00960 GO TO P8200-EXIT. DTSCS13 +00961 DTSCS13 +00962 PERFORM S330-EMP-INIT-MLOG THRU S330-EXIT. DTSCS13 +00963 DTSCS13 +00964 PERFORM S8100-READ-MPRF THRU S8100-EXIT. DTSCS13 +00965 IF L810-NO-REC-88 DTSCS13 +00966 GO TO S899-ABEND DTSCS13 +00967 ELSE DTSCS13 +00968 MOVE MSKL-REC TO MPRF-REC. DTSCS13 +00969 DTSCS13 +00970 ** NOTE: MTAD RECORDS MUST BE UPDATED BEFORE THE MPRF RECORD IS. DTSCS13 +00971 PERFORM P8910-MTAD-UPDATE THRU P8910-EXIT DTSCS13 +00972 VARYING WRK-TAD FROM 1 BY 1 DTSCS13 +00973 UNTIL WRK-TAD GREATER THAN 2. DTSCS13 +00974 DTSCS13 +00975 SET WRK-RET-MAIL-NO-88 TO TRUE. DTSCS13 +00976 PERFORM P8920-MPRF-UPDATE THRU P8920-EXIT. DTSCS13 +00977 DTSCS13 +00978 PERFORM P8930-MFAE-UPDATE THRU P8930-EXIT. DTSCS13 00979 DTSCS13 -00980 PERFORM S221-EMP-UNLOCK THRU S221-EXIT. DTSCS13 -00981 SKIP3 DTSCS13 -00982 MOVE PMSG-MOD-SUCCESSFUL TO LCCM-MSG-AREA. DTSCS13 -00983 MOVE L221-UPDATE-END-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS13 -00984 DTSCS13 -00985 MOVE LOW-VALUES TO MAP-CIND (1) MAP-CASS (1) DTSCS13 -00986 MAP-CIND (2) MAP-CASS (2). DTSCS13 -00987 DTSCS13 -00988 * IF MAP-FISC-AGNT-CD > SPACES DTSCS13 -00989 * MOVE CATB-ASKIP-BRT-MDTON TO MAP-ATTN-A (1) DTSCS13 -00990 * MAP-DLV1-A (1) DTSCS13 -00991 * MAP-DLV2-A (1) DTSCS13 -00992 * MAP-CITY-A (1) DTSCS13 -00993 * MAP-STAT-A (1) DTSCS13 -00994 * MAP-ZIPC-A (1). DTSCS13 -00995 P8200-EXIT. EXIT. DTSCS13 -00996 /*****************************************************************DTSCS13 -00997 * *DTSCS13 -00998 ******************************************************************DTSCS13 -00999 /*****************************************************************DTSCS13 -01000 * *DTSCS13 -01001 ******************************************************************DTSCS13 -01002 P8800-LOCK-EMPLOYER. DTSCS13 -01003 MOVE WRK-EMP-NO TO L221-EMP-NO. DTSCS13 -01004 MOVE LCCM-SCR-ABSTIME TO L221-SCR-ABSTIME. DTSCS13 -01005 MOVE LCCM-TASK-ID TO L221-UPDATE-TASK-ID. DTSCS13 -01006 MOVE LCCM-OP-ID TO L221-UPDATE-OP-ID. DTSCS13 -01007 MOVE LCCM-CICS-TERM-ID TO L221-UPDATE-TERMID. DTSCS13 -01008 MOVE LCCM-TASK-NETNAME TO L221-UPDATE-NETNAME. DTSCS13 -01009 MOVE LCCM-TASK-START-DATE TO L221-UPDATE-START-DATE. DTSCS13 -01010 MOVE LCCM-TASK-START-TIME TO L221-UPDATE-START-TIME. DTSCS13 -01011 MOVE WRK-SCR-ID TO L221-UPDATE-SCR-ID. DTSCS13 -01012 DTSCS13 -01013 PERFORM S221-EMP-LOCK THRU S221-EXIT. DTSCS13 -01014 P8800-EXIT. EXIT. DTSCS13 -01015 /*****************************************************************DTSCS13 -01016 * STEP THROUGH TAX ADDRESSES 1, AND 2 *DTSCS13 -01017 * MOVE ALL NON-KEY SCREEN FIELDS TO MTAD RECORD LAYOUT *DTSCS13 -01018 ******************************************************************DTSCS13 -01019 P8910-MTAD-UPDATE. DTSCS13 -01020 DTSCS13 -01021 PERFORM S1510-IS-MAP-ADDR-BLANK THRU S1510-EXIT. DTSCS13 -01022 DTSCS13 -01023 PERFORM S8200-READ-MTAD THRU S8200-EXIT. DTSCS13 -01024 IF L810-OK-88 DTSCS13 -01025 IF WRK-MAP-ADDR-HAS-DATA (WRK-TAD) DTSCS13 -01026 MOVE MSKL-REC TO MTAD-REC DTSCS13 -01027 PERFORM P8912-UPDATE THRU P8912-EXIT DTSCS13 -01028 MOVE MTAD-REC TO MSKL-REC DTSCS13 -01029 PERFORM S810-REWRITE THRU S810-EXIT DTSCS13 -01030 ELSE DTSCS13 -01031 PERFORM P8913-DELETE-PREP THRU P8913-EXIT DTSCS13 -01032 MOVE MSKL-REC TO MTAD-REC DTSCS13 -01033 PERFORM P8912-UPDATE THRU P8912-EXIT DTSCS13 -01034 MOVE MTAD-REC TO MSKL-REC DTSCS13 -01035 PERFORM S810-DELETE THRU S810-EXIT DTSCS13 -01036 ELSE DTSCS13 -01037 IF WRK-MAP-ADDR-HAS-DATA (WRK-TAD) DTSCS13 -01038 PERFORM P8911-MTAD-INITIALIZE THRU P8911-EXIT DTSCS13 -01039 PERFORM P8912-UPDATE THRU P8912-EXIT DTSCS13 -01040 MOVE MTAD-REC TO MSKL-REC DTSCS13 -01041 PERFORM S810-WRITE THRU S810-EXIT. DTSCS13 -01042 P8910-EXIT. EXIT. DTSCS13 -01043 SKIP3 DTSCS13 -01044 P8911-MTAD-INITIALIZE. DTSCS13 -01045 MOVE +0 TO MTAD-PURGE-DATE. DTSCS13 -01046 MOVE LOW-VALUES TO MTAD-DATA-AREA. DTSCS13 -01047 MOVE SPACES TO MTAD-ADDRESS DTSCS13 -01048 MTAD-PHONE-NUMBERS DTSCS13 -01049 MTAD-EMAIL-ADDRESS DTSCS13 -01050 MTAD-UC223-IND DTSCS13 -01051 MTAD-MISSING-RPT-LETTERS-IND DTSCS13 -01052 MTAD-PHYSICAL-ADDRESS-IND. DTSCS13 -01053 SET MTAD-NOT-CONVERTED-88 TO TRUE. DTSCS13 -01054 MOVE LCCM-CURR-RUN-DATE TO MTAD-ESTB-DATE DTSCS13 -01055 MTAD-CHNG-DATE. DTSCS13 -01056 P8911-EXIT. EXIT. DTSCS13 -01057 SKIP3 DTSCS13 -01058 P8912-UPDATE. DTSCS13 -01059 MOVE LCCM-HOLD-ADDRESS (WRK-TAD) TO L072-ADDRESS. DTSCS13 -01060 DTSCS13 -01061 IF WRK-TAD = +1 DTSCS13 -01062 MOVE 'MAILING ADDRESS ' TO L331-REC-OCC-ID DTSCS13 -01063 SET WRK-MAIL-ADDR-CHNG-YES TO TRUE DTSCS13 -01064 ELSE DTSCS13 -01065 MOVE 'RECORDS ADDRESS ' TO L331-REC-OCC-ID. DTSCS13 -01066 IF L072-ATTN-LINE NOT = MTAD-ATTN-LINE DTSCS13 -01067 MOVE 'MTAD-ATTN-LINE' TO L331-FIELD-NAME DTSCS13 -01068 MOVE MTAD-ATTN-LINE TO L331-FROM-VALUE DTSCS13 -01069 MOVE L072-ATTN-LINE TO L331-TO-VALUE DTSCS13 -01070 PERFORM S331-EMP-WRITE-MLOG THRU S331-EXIT DTSCS13 -01071 MOVE L072-ATTN-LINE TO MTAD-ATTN-LINE DTSCS13 -01072 MOVE LCCM-CURR-RUN-DATE TO MTAD-CHNG-DATE. DTSCS13 -01073 DTSCS13 -01074 DTSCS13 -01075 IF L072-DELIV-LINE-1 NOT = MTAD-DELIV-LINE-1 DTSCS13 -01076 MOVE 'MTAD-DELIV-LINE-1' TO L331-FIELD-NAME DTSCS13 -01077 MOVE MTAD-DELIV-LINE-1 TO L331-FROM-VALUE DTSCS13 -01078 MOVE L072-DELIV-LINE-1 TO L331-TO-VALUE DTSCS13 -01079 PERFORM S331-EMP-WRITE-MLOG THRU S331-EXIT DTSCS13 -01080 MOVE L072-DELIV-LINE-1 TO MTAD-DELIV-LINE-1 DTSCS13 -01081 MOVE LCCM-CURR-RUN-DATE TO MTAD-CHNG-DATE. DTSCS13 -01082 DTSCS13 -01083 IF L072-DELIV-LINE-2 NOT = MTAD-DELIV-LINE-2 DTSCS13 -01084 MOVE 'MTAD-DELIV-LINE-2' TO L331-FIELD-NAME DTSCS13 -01085 MOVE MTAD-DELIV-LINE-2 TO L331-FROM-VALUE DTSCS13 -01086 MOVE L072-DELIV-LINE-2 TO L331-TO-VALUE DTSCS13 -01087 PERFORM S331-EMP-WRITE-MLOG THRU S331-EXIT DTSCS13 -01088 MOVE L072-DELIV-LINE-2 TO MTAD-DELIV-LINE-2 DTSCS13 -01089 MOVE LCCM-CURR-RUN-DATE TO MTAD-CHNG-DATE. DTSCS13 -01090 DTSCS13 -01091 IF L072-CITY NOT = MTAD-CITY DTSCS13 -01092 MOVE 'MTAD-CITY' TO L331-FIELD-NAME DTSCS13 -01093 MOVE MTAD-CITY TO L331-FROM-VALUE DTSCS13 -01094 MOVE L072-CITY TO L331-TO-VALUE DTSCS13 -01095 PERFORM S331-EMP-WRITE-MLOG THRU S331-EXIT DTSCS13 -01096 MOVE L072-CITY TO MTAD-CITY DTSCS13 -01097 MOVE LCCM-CURR-RUN-DATE TO MTAD-CHNG-DATE. DTSCS13 -01098 DTSCS13 -01099 IF L072-ST NOT = MTAD-ST DTSCS13 -01100 MOVE 'MTAD-ST' TO L331-FIELD-NAME DTSCS13 -01101 MOVE MTAD-ST TO L331-FROM-VALUE DTSCS13 -01102 MOVE L072-ST TO L331-TO-VALUE DTSCS13 -01103 PERFORM S331-EMP-WRITE-MLOG THRU S331-EXIT DTSCS13 -01104 MOVE L072-ST TO MTAD-ST DTSCS13 -01105 MOVE LCCM-CURR-RUN-DATE TO MTAD-CHNG-DATE. DTSCS13 -01106 DTSCS13 -01107 IF L072-ZIP NOT = MTAD-ZIP DTSCS13 -01108 MOVE 'MTAD-ZIP' TO L331-FIELD-NAME DTSCS13 -01109 MOVE MTAD-ZIP TO L331-FROM-VALUE DTSCS13 -01110 MOVE L072-ZIP TO L331-TO-VALUE DTSCS13 -01111 PERFORM S331-EMP-WRITE-MLOG THRU S331-EXIT DTSCS13 -01112 MOVE L072-ZIP TO MTAD-ZIP DTSCS13 -01113 MOVE LCCM-CURR-RUN-DATE TO MTAD-CHNG-DATE. DTSCS13 -01114 DTSCS13 -01115 DTSCS13 -01116 IF L072-ADVANCED-BARCODE NOT = MTAD-ADVANCED-BARCODE DTSCS13 -01117 MOVE L072-ADVANCED-BARCODE TO MTAD-ADVANCED-BARCODE DTSCS13 -01118 MOVE LCCM-CURR-RUN-DATE TO MTAD-CHNG-DATE. DTSCS13 +00980 IF WRK-RET-MAIL-YES-88 DTSCS13 +00981 PERFORM P8940-ADD-MEVL THRU P8940-EXIT DTSCS13 +00982 END-IF. DTSCS13 +00983 DTSCS13 +00984 PERFORM S221-EMP-UNLOCK THRU S221-EXIT. DTSCS13 +00985 SKIP3 DTSCS13 +00986 MOVE PMSG-MOD-SUCCESSFUL TO LCCM-MSG-AREA. DTSCS13 +00987 MOVE L221-UPDATE-END-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS13 +00988 DTSCS13 +00989 MOVE LOW-VALUES TO MAP-CIND (1) MAP-CASS (1) DTSCS13 +00990 MAP-CIND (2) MAP-CASS (2). DTSCS13 +00991 DTSCS13 +00992 * IF MAP-FISC-AGNT-CD > SPACES DTSCS13 +00993 * MOVE CATB-ASKIP-BRT-MDTON TO MAP-ATTN-A (1) DTSCS13 +00994 * MAP-DLV1-A (1) DTSCS13 +00995 * MAP-DLV2-A (1) DTSCS13 +00996 * MAP-CITY-A (1) DTSCS13 +00997 * MAP-STAT-A (1) DTSCS13 +00998 * MAP-ZIPC-A (1). DTSCS13 +00999 P8200-EXIT. EXIT. DTSCS13 +01000 /*****************************************************************DTSCS13 +01001 * *DTSCS13 +01002 ******************************************************************DTSCS13 +01003 /*****************************************************************DTSCS13 +01004 * *DTSCS13 +01005 ******************************************************************DTSCS13 +01006 P8800-LOCK-EMPLOYER. DTSCS13 +01007 MOVE WRK-EMP-NO TO L221-EMP-NO. DTSCS13 +01008 MOVE LCCM-SCR-ABSTIME TO L221-SCR-ABSTIME. DTSCS13 +01009 MOVE LCCM-TASK-ID TO L221-UPDATE-TASK-ID. DTSCS13 +01010 MOVE LCCM-OP-ID TO L221-UPDATE-OP-ID. DTSCS13 +01011 MOVE LCCM-CICS-TERM-ID TO L221-UPDATE-TERMID. DTSCS13 +01012 MOVE LCCM-TASK-NETNAME TO L221-UPDATE-NETNAME. DTSCS13 +01013 MOVE LCCM-TASK-START-DATE TO L221-UPDATE-START-DATE. DTSCS13 +01014 MOVE LCCM-TASK-START-TIME TO L221-UPDATE-START-TIME. DTSCS13 +01015 MOVE WRK-SCR-ID TO L221-UPDATE-SCR-ID. DTSCS13 +01016 DTSCS13 +01017 PERFORM S221-EMP-LOCK THRU S221-EXIT. DTSCS13 +01018 P8800-EXIT. EXIT. DTSCS13 +01019 /*****************************************************************DTSCS13 +01020 * STEP THROUGH TAX ADDRESSES 1, AND 2 *DTSCS13 +01021 * MOVE ALL NON-KEY SCREEN FIELDS TO MTAD RECORD LAYOUT *DTSCS13 +01022 ******************************************************************DTSCS13 +01023 P8910-MTAD-UPDATE. DTSCS13 +01024 DTSCS13 +01025 PERFORM S1510-IS-MAP-ADDR-BLANK THRU S1510-EXIT. DTSCS13 +01026 DTSCS13 +01027 PERFORM S8200-READ-MTAD THRU S8200-EXIT. DTSCS13 +01028 IF L810-OK-88 DTSCS13 +01029 IF WRK-MAP-ADDR-HAS-DATA (WRK-TAD) DTSCS13 +01030 MOVE MSKL-REC TO MTAD-REC DTSCS13 +01031 PERFORM P8912-UPDATE THRU P8912-EXIT DTSCS13 +01032 MOVE MTAD-REC TO MSKL-REC DTSCS13 +01033 PERFORM S810-REWRITE THRU S810-EXIT DTSCS13 +01034 ELSE DTSCS13 +01035 PERFORM P8913-DELETE-PREP THRU P8913-EXIT DTSCS13 +01036 MOVE MSKL-REC TO MTAD-REC DTSCS13 +01037 PERFORM P8912-UPDATE THRU P8912-EXIT DTSCS13 +01038 MOVE MTAD-REC TO MSKL-REC DTSCS13 +01039 PERFORM S810-DELETE THRU S810-EXIT DTSCS13 +01040 ELSE DTSCS13 +01041 IF WRK-MAP-ADDR-HAS-DATA (WRK-TAD) DTSCS13 +01042 PERFORM P8911-MTAD-INITIALIZE THRU P8911-EXIT DTSCS13 +01043 PERFORM P8912-UPDATE THRU P8912-EXIT DTSCS13 +01044 MOVE MTAD-REC TO MSKL-REC DTSCS13 +01045 PERFORM S810-WRITE THRU S810-EXIT. DTSCS13 +01046 P8910-EXIT. EXIT. DTSCS13 +01047 SKIP3 DTSCS13 +01048 P8911-MTAD-INITIALIZE. DTSCS13 +01049 MOVE +0 TO MTAD-PURGE-DATE. DTSCS13 +01050 MOVE LOW-VALUES TO MTAD-DATA-AREA. DTSCS13 +01051 MOVE SPACES TO MTAD-ADDRESS DTSCS13 +01052 MTAD-PHONE-NUMBERS DTSCS13 +01053 MTAD-EMAIL-ADDRESS DTSCS13 +01054 MTAD-UC223-IND DTSCS13 +01055 MTAD-MISSING-RPT-LETTERS-IND DTSCS13 +01056 MTAD-PHYSICAL-ADDRESS-IND. DTSCS13 +01057 SET MTAD-NOT-CONVERTED-88 TO TRUE. DTSCS13 +01058 MOVE LCCM-CURR-RUN-DATE TO MTAD-ESTB-DATE DTSCS13 +01059 MTAD-CHNG-DATE. DTSCS13 +01060 P8911-EXIT. EXIT. DTSCS13 +01061 SKIP3 DTSCS13 +01062 P8912-UPDATE. DTSCS13 +01063 MOVE LCCM-HOLD-ADDRESS (WRK-TAD) TO L072-ADDRESS. DTSCS13 +01064 DTSCS13 +01065 IF WRK-TAD = +1 DTSCS13 +01066 MOVE 'MAILING ADDRESS ' TO L331-REC-OCC-ID DTSCS13 +01067 SET WRK-MAIL-ADDR-CHNG-YES TO TRUE DTSCS13 +01068 ELSE DTSCS13 +01069 MOVE 'RECORDS ADDRESS ' TO L331-REC-OCC-ID. DTSCS13 +01070 IF L072-ATTN-LINE NOT = MTAD-ATTN-LINE DTSCS13 +01071 MOVE 'MTAD-ATTN-LINE' TO L331-FIELD-NAME DTSCS13 +01072 MOVE MTAD-ATTN-LINE TO L331-FROM-VALUE DTSCS13 +01073 MOVE L072-ATTN-LINE TO L331-TO-VALUE DTSCS13 +01074 PERFORM S331-EMP-WRITE-MLOG THRU S331-EXIT DTSCS13 +01075 MOVE L072-ATTN-LINE TO MTAD-ATTN-LINE DTSCS13 +01076 MOVE LCCM-CURR-RUN-DATE TO MTAD-CHNG-DATE. DTSCS13 +01077 DTSCS13 +01078 DTSCS13 +01079 IF L072-DELIV-LINE-1 NOT = MTAD-DELIV-LINE-1 DTSCS13 +01080 MOVE 'MTAD-DELIV-LINE-1' TO L331-FIELD-NAME DTSCS13 +01081 MOVE MTAD-DELIV-LINE-1 TO L331-FROM-VALUE DTSCS13 +01082 MOVE L072-DELIV-LINE-1 TO L331-TO-VALUE DTSCS13 +01083 PERFORM S331-EMP-WRITE-MLOG THRU S331-EXIT DTSCS13 +01084 MOVE L072-DELIV-LINE-1 TO MTAD-DELIV-LINE-1 DTSCS13 +01085 MOVE LCCM-CURR-RUN-DATE TO MTAD-CHNG-DATE. DTSCS13 +01086 DTSCS13 +01087 IF L072-DELIV-LINE-2 NOT = MTAD-DELIV-LINE-2 DTSCS13 +01088 MOVE 'MTAD-DELIV-LINE-2' TO L331-FIELD-NAME DTSCS13 +01089 MOVE MTAD-DELIV-LINE-2 TO L331-FROM-VALUE DTSCS13 +01090 MOVE L072-DELIV-LINE-2 TO L331-TO-VALUE DTSCS13 +01091 PERFORM S331-EMP-WRITE-MLOG THRU S331-EXIT DTSCS13 +01092 MOVE L072-DELIV-LINE-2 TO MTAD-DELIV-LINE-2 DTSCS13 +01093 MOVE LCCM-CURR-RUN-DATE TO MTAD-CHNG-DATE. DTSCS13 +01094 DTSCS13 +01095 IF L072-CITY NOT = MTAD-CITY DTSCS13 +01096 MOVE 'MTAD-CITY' TO L331-FIELD-NAME DTSCS13 +01097 MOVE MTAD-CITY TO L331-FROM-VALUE DTSCS13 +01098 MOVE L072-CITY TO L331-TO-VALUE DTSCS13 +01099 PERFORM S331-EMP-WRITE-MLOG THRU S331-EXIT DTSCS13 +01100 MOVE L072-CITY TO MTAD-CITY DTSCS13 +01101 MOVE LCCM-CURR-RUN-DATE TO MTAD-CHNG-DATE. DTSCS13 +01102 DTSCS13 +01103 IF L072-ST NOT = MTAD-ST DTSCS13 +01104 MOVE 'MTAD-ST' TO L331-FIELD-NAME DTSCS13 +01105 MOVE MTAD-ST TO L331-FROM-VALUE DTSCS13 +01106 MOVE L072-ST TO L331-TO-VALUE DTSCS13 +01107 PERFORM S331-EMP-WRITE-MLOG THRU S331-EXIT DTSCS13 +01108 MOVE L072-ST TO MTAD-ST DTSCS13 +01109 MOVE LCCM-CURR-RUN-DATE TO MTAD-CHNG-DATE. DTSCS13 +01110 DTSCS13 +01111 IF L072-ZIP NOT = MTAD-ZIP DTSCS13 +01112 MOVE 'MTAD-ZIP' TO L331-FIELD-NAME DTSCS13 +01113 MOVE MTAD-ZIP TO L331-FROM-VALUE DTSCS13 +01114 MOVE L072-ZIP TO L331-TO-VALUE DTSCS13 +01115 PERFORM S331-EMP-WRITE-MLOG THRU S331-EXIT DTSCS13 +01116 MOVE L072-ZIP TO MTAD-ZIP DTSCS13 +01117 MOVE LCCM-CURR-RUN-DATE TO MTAD-CHNG-DATE. DTSCS13 +01118 DTSCS13 01119 DTSCS13 -01120 DTSCS13 -01121 MOVE MTAD-VOICE-1 TO WRK-MTAD-PHONE (1). DTSCS13 -01122 MOVE MTAD-VOICE-2 TO WRK-MTAD-PHONE (2). DTSCS13 -01123 MOVE MTAD-FAX TO WRK-MTAD-PHONE (3). DTSCS13 -01124 PERFORM P8912A-UPDATE-PHONES THRU P8912A-EXIT DTSCS13 -01125 VARYING WRK-PHONE FROM 1 BY 1 DTSCS13 -01126 UNTIL WRK-PHONE GREATER THAN 3. DTSCS13 -01127 MOVE WRK-MTAD-PHONE (1) TO MTAD-VOICE-1. DTSCS13 -01128 MOVE WRK-MTAD-PHONE (2) TO MTAD-VOICE-2. DTSCS13 -01129 MOVE WRK-MTAD-PHONE (3) TO MTAD-FAX. DTSCS13 -01130 DTSCS13 -01131 IF MAP-EMAIL (WRK-TAD) NOT = MTAD-EMAIL-ADDRESS DTSCS13 -01132 MOVE 'MTAD-EMAIL-ADDRESS' TO L331-FIELD-NAME DTSCS13 -01133 MOVE MTAD-EMAIL-ADDRESS TO L331-FROM-VALUE DTSCS13 -01134 MOVE MAP-EMAIL (WRK-TAD) TO L331-TO-VALUE DTSCS13 -01135 PERFORM S331-EMP-WRITE-MLOG THRU S331-EXIT DTSCS13 -01136 MOVE MAP-EMAIL (WRK-TAD) TO MTAD-EMAIL-ADDRESS DTSCS13 -01137 MOVE LCCM-CURR-RUN-DATE TO MTAD-CHNG-DATE. DTSCS13 -01138 DTSCS13 -01139 PERFORM P8912B-UPDATE-TAX-ADDR-IND THRU P8912B-EXIT. DTSCS13 -01140 P8912-EXIT. EXIT. DTSCS13 -01141 SKIP3 DTSCS13 -01142 P8912A-UPDATE-PHONES. DTSCS13 -01143 MOVE MAP-PHONE-AREA (WRK-TAD, WRK-PHONE) TO L021-S-TNO-AREA. DTSCS13 -01144 PERFORM S021-TELNO-FROM-SCREEN THRU S021-EXIT. DTSCS13 -01145 IF L021-TNO NOT = WRK-MTAD-PHONE (WRK-PHONE) DTSCS13 -01146 MOVE WRK-331-FIELD-NAME (WRK-PHONE) TO L331-FIELD-NAME DTSCS13 -01147 MOVE SPACE TO L331-FROM-VALUE DTSCS13 -01148 L331-TO-VALUE DTSCS13 -01149 STRING WRK-MTAD-PHONE-A-CD (WRK-PHONE) DTSCS13 -01150 ' ' DTSCS13 -01151 WRK-MTAD-PHONE-PREF (WRK-PHONE) DTSCS13 -01152 ' ' DTSCS13 -01153 WRK-MTAD-PHONE-SUFF (WRK-PHONE) DTSCS13 +01120 IF L072-ADVANCED-BARCODE NOT = MTAD-ADVANCED-BARCODE DTSCS13 +01121 MOVE L072-ADVANCED-BARCODE TO MTAD-ADVANCED-BARCODE DTSCS13 +01122 MOVE LCCM-CURR-RUN-DATE TO MTAD-CHNG-DATE. DTSCS13 +01123 DTSCS13 +01124 DTSCS13 +01125 MOVE MTAD-VOICE-1 TO WRK-MTAD-PHONE (1). DTSCS13 +01126 MOVE MTAD-VOICE-2 TO WRK-MTAD-PHONE (2). DTSCS13 +01127 MOVE MTAD-FAX TO WRK-MTAD-PHONE (3). DTSCS13 +01128 PERFORM P8912A-UPDATE-PHONES THRU P8912A-EXIT DTSCS13 +01129 VARYING WRK-PHONE FROM 1 BY 1 DTSCS13 +01130 UNTIL WRK-PHONE GREATER THAN 3. DTSCS13 +01131 MOVE WRK-MTAD-PHONE (1) TO MTAD-VOICE-1. DTSCS13 +01132 MOVE WRK-MTAD-PHONE (2) TO MTAD-VOICE-2. DTSCS13 +01133 MOVE WRK-MTAD-PHONE (3) TO MTAD-FAX. DTSCS13 +01134 DTSCS13 +01135 IF MAP-EMAIL (WRK-TAD) NOT = MTAD-EMAIL-ADDRESS DTSCS13 +01136 MOVE 'MTAD-EMAIL-ADDRESS' TO L331-FIELD-NAME DTSCS13 +01137 MOVE MTAD-EMAIL-ADDRESS TO L331-FROM-VALUE DTSCS13 +01138 MOVE MAP-EMAIL (WRK-TAD) TO L331-TO-VALUE DTSCS13 +01139 PERFORM S331-EMP-WRITE-MLOG THRU S331-EXIT DTSCS13 +01140 MOVE MAP-EMAIL (WRK-TAD) TO MTAD-EMAIL-ADDRESS DTSCS13 +01141 MOVE LCCM-CURR-RUN-DATE TO MTAD-CHNG-DATE. DTSCS13 +01142 DTSCS13 +01143 PERFORM P8912B-UPDATE-TAX-ADDR-IND THRU P8912B-EXIT. DTSCS13 +01144 P8912-EXIT. EXIT. DTSCS13 +01145 SKIP3 DTSCS13 +01146 P8912A-UPDATE-PHONES. DTSCS13 +01147 MOVE MAP-PHONE-AREA (WRK-TAD, WRK-PHONE) TO L021-S-TNO-AREA. DTSCS13 +01148 PERFORM S021-TELNO-FROM-SCREEN THRU S021-EXIT. DTSCS13 +01149 IF L021-TNO NOT = WRK-MTAD-PHONE (WRK-PHONE) DTSCS13 +01150 MOVE WRK-331-FIELD-NAME (WRK-PHONE) TO L331-FIELD-NAME DTSCS13 +01151 MOVE SPACE TO L331-FROM-VALUE DTSCS13 +01152 L331-TO-VALUE DTSCS13 +01153 STRING WRK-MTAD-PHONE-A-CD (WRK-PHONE) DTSCS13 01154 ' ' DTSCS13 -01155 WRK-MTAD-PHONE-EXT (WRK-PHONE) DELIMITED BY SIZE DTSCS13 -01156 INTO L331-FROM-VALUE DTSCS13 -01157 STRING L021-TNO-AREA-CD DTSCS13 +01155 WRK-MTAD-PHONE-PREF (WRK-PHONE) DTSCS13 +01156 ' ' DTSCS13 +01157 WRK-MTAD-PHONE-SUFF (WRK-PHONE) DTSCS13 01158 ' ' DTSCS13 -01159 L021-TNO-PREFIX DTSCS13 -01160 ' ' DTSCS13 -01161 L021-TNO-SUFFIX DTSCS13 +01159 WRK-MTAD-PHONE-EXT (WRK-PHONE) DELIMITED BY SIZE DTSCS13 +01160 INTO L331-FROM-VALUE DTSCS13 +01161 STRING L021-TNO-AREA-CD DTSCS13 01162 ' ' DTSCS13 -01163 L021-TNO-EXT DELIMITED BY SIZE DTSCS13 -01164 INTO L331-TO-VALUE DTSCS13 -01165 PERFORM S331-EMP-WRITE-MLOG THRU S331-EXIT DTSCS13 -01166 MOVE L021-TNO TO WRK-MTAD-PHONE (WRK-PHONE) DTSCS13 -01167 MOVE LCCM-CURR-RUN-DATE TO MTAD-CHNG-DATE. DTSCS13 -01168 DTSCS13 -01169 P8912A-EXIT. EXIT. DTSCS13 -01170 SKIP3 DTSCS13 -01171 P8912B-UPDATE-TAX-ADDR-IND. DTSCS13 -01172 IF MAP-MEMO (WRK-TAD) NOT = MTAD-UC223-IND DTSCS13 -01173 MOVE 'MTAD-UC223-IND' TO L331-FIELD-NAME DTSCS13 -01174 MOVE MTAD-UC223-IND TO L331-FROM-VALUE DTSCS13 -01175 MOVE MAP-MEMO (WRK-TAD) TO MTAD-UC223-IND DTSCS13 -01176 MOVE MTAD-UC223-IND TO L331-TO-VALUE DTSCS13 -01177 PERFORM S331-EMP-WRITE-MLOG THRU S331-EXIT DTSCS13 -01178 MOVE LCCM-CURR-RUN-DATE TO MTAD-CHNG-DATE. DTSCS13 -01179 DTSCS13 -01180 SKIP3 DTSCS13 -01181 IF MAP-MISS (WRK-TAD) NOT = MTAD-MISSING-RPT-LETTERS-IND DTSCS13 -01182 MOVE 'MTAD-MISSING-RPT-LETTERS-IND' DTSCS13 -01183 TO L331-FIELD-NAME DTSCS13 -01184 MOVE MTAD-MISSING-RPT-LETTERS-IND DTSCS13 -01185 TO L331-FROM-VALUE DTSCS13 -01186 MOVE MAP-MISS (WRK-TAD) DTSCS13 -01187 TO MTAD-MISSING-RPT-LETTERS-IND DTSCS13 +01163 L021-TNO-PREFIX DTSCS13 +01164 ' ' DTSCS13 +01165 L021-TNO-SUFFIX DTSCS13 +01166 ' ' DTSCS13 +01167 L021-TNO-EXT DELIMITED BY SIZE DTSCS13 +01168 INTO L331-TO-VALUE DTSCS13 +01169 PERFORM S331-EMP-WRITE-MLOG THRU S331-EXIT DTSCS13 +01170 MOVE L021-TNO TO WRK-MTAD-PHONE (WRK-PHONE) DTSCS13 +01171 MOVE LCCM-CURR-RUN-DATE TO MTAD-CHNG-DATE. DTSCS13 +01172 DTSCS13 +01173 P8912A-EXIT. EXIT. DTSCS13 +01174 SKIP3 DTSCS13 +01175 P8912B-UPDATE-TAX-ADDR-IND. DTSCS13 +01176 IF MAP-MEMO (WRK-TAD) NOT = MTAD-UC223-IND DTSCS13 +01177 MOVE 'MTAD-UC223-IND' TO L331-FIELD-NAME DTSCS13 +01178 MOVE MTAD-UC223-IND TO L331-FROM-VALUE DTSCS13 +01179 MOVE MAP-MEMO (WRK-TAD) TO MTAD-UC223-IND DTSCS13 +01180 MOVE MTAD-UC223-IND TO L331-TO-VALUE DTSCS13 +01181 PERFORM S331-EMP-WRITE-MLOG THRU S331-EXIT DTSCS13 +01182 MOVE LCCM-CURR-RUN-DATE TO MTAD-CHNG-DATE. DTSCS13 +01183 DTSCS13 +01184 SKIP3 DTSCS13 +01185 IF MAP-MISS (WRK-TAD) NOT = MTAD-MISSING-RPT-LETTERS-IND DTSCS13 +01186 MOVE 'MTAD-MISSING-RPT-LETTERS-IND' DTSCS13 +01187 TO L331-FIELD-NAME DTSCS13 01188 MOVE MTAD-MISSING-RPT-LETTERS-IND DTSCS13 -01189 TO L331-TO-VALUE DTSCS13 -01190 PERFORM S331-EMP-WRITE-MLOG THRU S331-EXIT DTSCS13 -01191 MOVE LCCM-CURR-RUN-DATE TO MTAD-CHNG-DATE. DTSCS13 -01192 DTSCS13 -01193 SKIP3 DTSCS13 -01194 IF MAP-ADDR (WRK-TAD) NOT = MTAD-PHYSICAL-ADDRESS-IND DTSCS13 -01195 MOVE 'MTAD-PHYSCIAL-ADDRESS-IND' TO L331-FIELD-NAME DTSCS13 -01196 MOVE MTAD-PHYSICAL-ADDRESS-IND DTSCS13 -01197 TO L331-FROM-VALUE DTSCS13 -01198 MOVE MAP-ADDR (WRK-TAD) DTSCS13 -01199 TO MTAD-PHYSICAL-ADDRESS-IND DTSCS13 +01189 TO L331-FROM-VALUE DTSCS13 +01190 MOVE MAP-MISS (WRK-TAD) DTSCS13 +01191 TO MTAD-MISSING-RPT-LETTERS-IND DTSCS13 +01192 MOVE MTAD-MISSING-RPT-LETTERS-IND DTSCS13 +01193 TO L331-TO-VALUE DTSCS13 +01194 PERFORM S331-EMP-WRITE-MLOG THRU S331-EXIT DTSCS13 +01195 MOVE LCCM-CURR-RUN-DATE TO MTAD-CHNG-DATE. DTSCS13 +01196 DTSCS13 +01197 SKIP3 DTSCS13 +01198 IF MAP-ADDR (WRK-TAD) NOT = MTAD-PHYSICAL-ADDRESS-IND DTSCS13 +01199 MOVE 'MTAD-PHYSCIAL-ADDRESS-IND' TO L331-FIELD-NAME DTSCS13 01200 MOVE MTAD-PHYSICAL-ADDRESS-IND DTSCS13 -01201 TO L331-TO-VALUE DTSCS13 -01202 PERFORM S331-EMP-WRITE-MLOG THRU S331-EXIT DTSCS13 -01203 MOVE LCCM-CURR-RUN-DATE TO MTAD-CHNG-DATE. DTSCS13 -01204 DTSCS13 -01205 P8912B-EXIT. EXIT. DTSCS13 -01206 SKIP3 DTSCS13 -01207 P8913-DELETE-PREP. DTSCS13 +01201 TO L331-FROM-VALUE DTSCS13 +01202 MOVE MAP-ADDR (WRK-TAD) DTSCS13 +01203 TO MTAD-PHYSICAL-ADDRESS-IND DTSCS13 +01204 MOVE MTAD-PHYSICAL-ADDRESS-IND DTSCS13 +01205 TO L331-TO-VALUE DTSCS13 +01206 PERFORM S331-EMP-WRITE-MLOG THRU S331-EXIT DTSCS13 +01207 MOVE LCCM-CURR-RUN-DATE TO MTAD-CHNG-DATE. DTSCS13 01208 DTSCS13 -01209 MOVE SPACE TO L072-ATTN-LINE DTSCS13 -01210 L072-DELIV-LINE-1 DTSCS13 -01211 L072-DELIV-LINE-2 DTSCS13 -01212 L072-CITY DTSCS13 -01213 L072-ST DTSCS13 -01214 L072-ZIP. DTSCS13 -01215 DTSCS13 -01216 P8913-EXIT. EXIT. DTSCS13 -01217 /*****************************************************************DTSCS13 -01218 * MOVE ALL NON-KEY SCREEN FIELDS TO MPRF RECORD LAYOUT *DTSCS13 -01219 ******************************************************************DTSCS13 -01220 P8920-MPRF-UPDATE. DTSCS13 -01221 DTSCS13 -01222 MOVE SPACES TO L331-REC-OCC-ID. DTSCS13 -01223 DTSCS13 -01224 IF MAP-PRIMARY-NAME NOT = MPRF-PRIMARY-NAME DTSCS13 -01225 MOVE 'MPRF-PRIMARY-NAME' TO L331-FIELD-NAME DTSCS13 -01226 MOVE MPRF-PRIMARY-NAME TO L331-FROM-VALUE DTSCS13 -01227 MOVE MAP-PRIMARY-NAME TO L331-TO-VALUE DTSCS13 -01228 PERFORM S331-EMP-WRITE-MLOG THRU S331-EXIT DTSCS13 -01229 MOVE MAP-PRIMARY-NAME TO MPRF-PRIMARY-NAME DTSCS13 -01230 MOVE LCCM-CURR-RUN-DATE TO MPRF-CHNG-DATE. DTSCS13 -01231 DTSCS13 -01232 IF MAP-ENTITY-NAME-IND NOT = MPRF-ENTITY-NAME-IND DTSCS13 -01233 MOVE 'MPRF-ENTITY-NAME-IND' TO L331-FIELD-NAME DTSCS13 -01234 MOVE MPRF-ENTITY-NAME-IND TO L331-FROM-VALUE DTSCS13 -01235 MOVE MAP-ENTITY-NAME-IND TO L331-TO-VALUE DTSCS13 -01236 PERFORM S331-EMP-WRITE-MLOG THRU S331-EXIT DTSCS13 -01237 MOVE MAP-ENTITY-NAME-IND TO MPRF-ENTITY-NAME-IND DTSCS13 -01238 MOVE LCCM-CURR-RUN-DATE TO MPRF-CHNG-DATE. DTSCS13 -01239 DTSCS13 -01240 IF MAP-ENTITY-NAME NOT = MPRF-ENTITY-NAME DTSCS13 -01241 MOVE 'MPRF-ENTITY-NAME' TO L331-FIELD-NAME DTSCS13 -01242 MOVE MPRF-ENTITY-NAME TO L331-FROM-VALUE DTSCS13 -01243 MOVE MAP-ENTITY-NAME TO L331-TO-VALUE DTSCS13 -01244 PERFORM S331-EMP-WRITE-MLOG THRU S331-EXIT DTSCS13 -01245 MOVE MAP-ENTITY-NAME TO MPRF-ENTITY-NAME DTSCS13 -01246 MOVE LCCM-CURR-RUN-DATE TO MPRF-CHNG-DATE. DTSCS13 -01247 DTSCS13 -01248 IF MPRF-TAX-REC-ADDR-NO-88 DTSCS13 -01249 IF WRK-MAP-ADDR-HAS-DATA (2) DTSCS13 -01250 SET MPRF-TAX-REC-ADDR-YES-88 TO TRUE DTSCS13 -01251 MOVE LCCM-CURR-RUN-DATE TO MPRF-CHNG-DATE DTSCS13 -01252 ELSE DTSCS13 -01253 NEXT SENTENCE DTSCS13 -01254 ELSE DTSCS13 -01255 IF WRK-MAP-ADDR-BLANK (2) DTSCS13 -01256 SET MPRF-TAX-REC-ADDR-NO-88 TO TRUE DTSCS13 -01257 MOVE LCCM-CURR-RUN-DATE TO MPRF-CHNG-DATE. DTSCS13 -01258 DTSCS13 -01259 MOVE WRK-EMP-NO TO L203-EMP-NO. DTSCS13 -01260 MOVE MPRF-TAX-REC-ADDR-EXISTS-IND DTSCS13 -01261 TO L203-TAX-REC-ADDR-EXISTS-IND. DTSCS13 -01262 PERFORM S203-DETER-ZIPS THRU S203-EXIT. DTSCS13 -01263 IF L203-FLD-ZIP NOT = MPRF-FLD-ZIP DTSCS13 -01264 MOVE L203-FLD-ZIP TO MPRF-FLD-ZIP DTSCS13 -01265 MOVE LCCM-CURR-RUN-DATE TO MPRF-CHNG-DATE. DTSCS13 -01266 IF L203-FLD-STATE NOT = MPRF-FLD-ST DTSCS13 -01267 MOVE L203-FLD-STATE TO MPRF-FLD-ST DTSCS13 -01268 MOVE LCCM-CURR-RUN-DATE TO MPRF-CHNG-DATE. DTSCS13 -01269 DTSCS13 -01270 IF WRK-MAIL-ADDR-CHNG-YES DTSCS13 -01271 IF MPRF-RETURN-MAIL-YES-88 DTSCS13 -01272 SET WRK-RET-MAIL-YES-88 TO TRUE DTSCS13 -01273 MOVE 'MPRF-RETURN-MAIL-IND' TO L331-FIELD-NAME DTSCS13 -01274 MOVE MPRF-RETURN-MAIL-IND TO L331-FROM-VALUE DTSCS13 -01275 SET MPRF-RETURN-MAIL-NO-88 TO TRUE DTSCS13 -01276 MOVE MPRF-RETURN-MAIL-IND TO L331-TO-VALUE DTSCS13 -01277 PERFORM S331-EMP-WRITE-MLOG THRU S331-EXIT DTSCS13 -01278 MOVE LCCM-CURR-RUN-DATE TO MPRF-CHNG-DATE DTSCS13 -01279 END-IF DTSCS13 -01280 END-IF. DTSCS13 -01281 DTSCS13 -01282 MOVE MPRF-REC TO MSKL-REC. DTSCS13 -01283 PERFORM S810-REWRITE THRU S810-EXIT. DTSCS13 -01284 P8920-EXIT. EXIT. DTSCS13 -01285 SKIP3 DTSCS13 -01286 /*****************************************************************DTSCS13 -01287 * MOVE ALL NON-KEY SCREEN FIELDS TO MFAE RECORD LAYOUT *DTSCS13 -01288 ******************************************************************DTSCS13 -01289 P8930-MFAE-UPDATE. DTSCS13 -01290 DTSCS13 -01291 PERFORM S8300-READ-MFAE THRU S8300-EXIT. DTSCS13 -01292 DTSCS13 -01293 IF NOT L810-OK-88 DTSCS13 -01294 IF MAP-FISC-AGNT-CD > SPACES DTSCS13 -01295 PERFORM P8931-ADD-MFAE THRU P8931-EXIT DTSCS13 -01296 ELSE DTSCS13 -01297 GO TO P8930-EXIT DTSCS13 -01298 ELSE DTSCS13 -01299 IF MAP-FISC-AGNT-CD = SPACES DTSCS13 -01300 PERFORM P8932-DELETE-MFAE THRU P8932-EXIT DTSCS13 -01301 ELSE DTSCS13 -01302 IF MAP-FISC-AGNT-CD NOT = MFAE-FISCAL-AGENT-CD DTSCS13 -01303 PERFORM P8933-UPDATE-MFAE THRU P8933-EXIT DTSCS13 -01304 END-IF. DTSCS13 -01305 DTSCS13 -01306 P8930-EXIT. DTSCS13 -01307 EXIT. DTSCS13 -01308 DTSCS13 -01309 P8931-ADD-MFAE. DTSCS13 -01310 MOVE LOW-VALUES TO MFAE-REC. DTSCS13 -01311 DTSCS13 -01312 MOVE WRK-EMP-NO TO MFAE-EMP-NO. DTSCS13 -01313 DTSCS13 -01314 SET MFAE-FAE-88 TO TRUE. DTSCS13 +01209 P8912B-EXIT. EXIT. DTSCS13 +01210 SKIP3 DTSCS13 +01211 P8913-DELETE-PREP. DTSCS13 +01212 DTSCS13 +01213 MOVE SPACE TO L072-ATTN-LINE DTSCS13 +01214 L072-DELIV-LINE-1 DTSCS13 +01215 L072-DELIV-LINE-2 DTSCS13 +01216 L072-CITY DTSCS13 +01217 L072-ST DTSCS13 +01218 L072-ZIP. DTSCS13 +01219 DTSCS13 +01220 P8913-EXIT. EXIT. DTSCS13 +01221 /*****************************************************************DTSCS13 +01222 * MOVE ALL NON-KEY SCREEN FIELDS TO MPRF RECORD LAYOUT *DTSCS13 +01223 ******************************************************************DTSCS13 +01224 P8920-MPRF-UPDATE. DTSCS13 +01225 DTSCS13 +01226 MOVE SPACES TO L331-REC-OCC-ID. DTSCS13 +01227 DTSCS13 +01228 IF MAP-PRIMARY-NAME NOT = MPRF-PRIMARY-NAME DTSCS13 +01229 MOVE 'MPRF-PRIMARY-NAME' TO L331-FIELD-NAME DTSCS13 +01230 MOVE MPRF-PRIMARY-NAME TO L331-FROM-VALUE DTSCS13 +01231 MOVE MAP-PRIMARY-NAME TO L331-TO-VALUE DTSCS13 +01232 PERFORM S331-EMP-WRITE-MLOG THRU S331-EXIT DTSCS13 +01233 MOVE MAP-PRIMARY-NAME TO MPRF-PRIMARY-NAME DTSCS13 +01234 MOVE LCCM-CURR-RUN-DATE TO MPRF-CHNG-DATE. DTSCS13 +01235 DTSCS13 +01236 IF MAP-ENTITY-NAME-IND NOT = MPRF-ENTITY-NAME-IND DTSCS13 +01237 MOVE 'MPRF-ENTITY-NAME-IND' TO L331-FIELD-NAME DTSCS13 +01238 MOVE MPRF-ENTITY-NAME-IND TO L331-FROM-VALUE DTSCS13 +01239 MOVE MAP-ENTITY-NAME-IND TO L331-TO-VALUE DTSCS13 +01240 PERFORM S331-EMP-WRITE-MLOG THRU S331-EXIT DTSCS13 +01241 MOVE MAP-ENTITY-NAME-IND TO MPRF-ENTITY-NAME-IND DTSCS13 +01242 MOVE LCCM-CURR-RUN-DATE TO MPRF-CHNG-DATE. DTSCS13 +01243 DTSCS13 +01244 IF MAP-ENTITY-NAME NOT = MPRF-ENTITY-NAME DTSCS13 +01245 MOVE 'MPRF-ENTITY-NAME' TO L331-FIELD-NAME DTSCS13 +01246 MOVE MPRF-ENTITY-NAME TO L331-FROM-VALUE DTSCS13 +01247 MOVE MAP-ENTITY-NAME TO L331-TO-VALUE DTSCS13 +01248 PERFORM S331-EMP-WRITE-MLOG THRU S331-EXIT DTSCS13 +01249 MOVE MAP-ENTITY-NAME TO MPRF-ENTITY-NAME DTSCS13 +01250 MOVE LCCM-CURR-RUN-DATE TO MPRF-CHNG-DATE. DTSCS13 +01251 DTSCS13 +01252 IF MPRF-TAX-REC-ADDR-NO-88 DTSCS13 +01253 IF WRK-MAP-ADDR-HAS-DATA (2) DTSCS13 +01254 SET MPRF-TAX-REC-ADDR-YES-88 TO TRUE DTSCS13 +01255 MOVE LCCM-CURR-RUN-DATE TO MPRF-CHNG-DATE DTSCS13 +01256 ELSE DTSCS13 +01257 NEXT SENTENCE DTSCS13 +01258 ELSE DTSCS13 +01259 IF WRK-MAP-ADDR-BLANK (2) DTSCS13 +01260 SET MPRF-TAX-REC-ADDR-NO-88 TO TRUE DTSCS13 +01261 MOVE LCCM-CURR-RUN-DATE TO MPRF-CHNG-DATE. DTSCS13 +01262 DTSCS13 +01263 MOVE WRK-EMP-NO TO L203-EMP-NO. DTSCS13 +01264 MOVE MPRF-TAX-REC-ADDR-EXISTS-IND DTSCS13 +01265 TO L203-TAX-REC-ADDR-EXISTS-IND. DTSCS13 +01266 PERFORM S203-DETER-ZIPS THRU S203-EXIT. DTSCS13 +01267 IF L203-FLD-ZIP NOT = MPRF-FLD-ZIP DTSCS13 +01268 MOVE L203-FLD-ZIP TO MPRF-FLD-ZIP DTSCS13 +01269 MOVE LCCM-CURR-RUN-DATE TO MPRF-CHNG-DATE. DTSCS13 +01270 IF L203-FLD-STATE NOT = MPRF-FLD-ST DTSCS13 +01271 MOVE L203-FLD-STATE TO MPRF-FLD-ST DTSCS13 +01272 MOVE LCCM-CURR-RUN-DATE TO MPRF-CHNG-DATE. DTSCS13 +01273 DTSCS13 +01274 IF WRK-MAIL-ADDR-CHNG-YES DTSCS13 +01275 IF MPRF-RETURN-MAIL-YES-88 DTSCS13 +01276 SET WRK-RET-MAIL-YES-88 TO TRUE DTSCS13 +01277 MOVE 'MPRF-RETURN-MAIL-IND' TO L331-FIELD-NAME DTSCS13 +01278 MOVE MPRF-RETURN-MAIL-IND TO L331-FROM-VALUE DTSCS13 +01279 SET MPRF-RETURN-MAIL-NO-88 TO TRUE DTSCS13 +01280 MOVE MPRF-RETURN-MAIL-IND TO L331-TO-VALUE DTSCS13 +01281 PERFORM S331-EMP-WRITE-MLOG THRU S331-EXIT DTSCS13 +01282 MOVE LCCM-CURR-RUN-DATE TO MPRF-CHNG-DATE DTSCS13 +01283 END-IF DTSCS13 +01284 END-IF. DTSCS13 +01285 DTSCS13 +01286 MOVE MPRF-REC TO MSKL-REC. DTSCS13 +01287 PERFORM S810-REWRITE THRU S810-EXIT. DTSCS13 +01288 P8920-EXIT. EXIT. DTSCS13 +01289 SKIP3 DTSCS13 +01290 /*****************************************************************DTSCS13 +01291 * MOVE ALL NON-KEY SCREEN FIELDS TO MFAE RECORD LAYOUT *DTSCS13 +01292 ******************************************************************DTSCS13 +01293 P8930-MFAE-UPDATE. DTSCS13 +01294 DTSCS13 +01295 PERFORM S8300-READ-MFAE THRU S8300-EXIT. DTSCS13 +01296 DTSCS13 +01297 IF NOT L810-OK-88 DTSCS13 +01298 IF MAP-FISC-AGNT-CD > SPACES DTSCS13 +01299 PERFORM P8931-ADD-MFAE THRU P8931-EXIT DTSCS13 +01300 ELSE DTSCS13 +01301 GO TO P8930-EXIT DTSCS13 +01302 ELSE DTSCS13 +01303 IF MAP-FISC-AGNT-CD = SPACES DTSCS13 +01304 PERFORM P8932-DELETE-MFAE THRU P8932-EXIT DTSCS13 +01305 ELSE DTSCS13 +01306 IF MAP-FISC-AGNT-CD NOT = MFAE-FISCAL-AGENT-CD DTSCS13 +01307 PERFORM P8933-UPDATE-MFAE THRU P8933-EXIT DTSCS13 +01308 END-IF. DTSCS13 +01309 DTSCS13 +01310 P8930-EXIT. DTSCS13 +01311 EXIT. DTSCS13 +01312 DTSCS13 +01313 P8931-ADD-MFAE. DTSCS13 +01314 MOVE LOW-VALUES TO MFAE-REC. DTSCS13 01315 DTSCS13 -01316 SET MFAE-SERVICE-CORRESPOND-88 TO TRUE. DTSCS13 +01316 MOVE WRK-EMP-NO TO MFAE-EMP-NO. DTSCS13 01317 DTSCS13 -01318 IF MAP-FISC-AGNT-CD NOT = MFAE-FISCAL-AGENT-CD DTSCS13 -01319 MOVE 'FISCAL AGENT ' TO L331-REC-OCC-ID DTSCS13 -01320 MOVE 'FISC-AGNT-CD ' TO L331-FIELD-NAME DTSCS13 -01321 MOVE MFAE-FISCAL-AGENT-CD TO L331-FROM-VALUE DTSCS13 -01322 MOVE MAP-FISC-AGNT-CD TO L331-TO-VALUE DTSCS13 -01323 PERFORM S331-EMP-WRITE-MLOG THRU S331-EXIT. DTSCS13 -01324 DTSCS13 -01325 MOVE MAP-FISC-AGNT-CD TO MFAE-FISCAL-AGENT-CD. DTSCS13 -01326 DTSCS13 -01327 MOVE ZEROS TO MFAE-PURGE-DATE. DTSCS13 +01318 SET MFAE-FAE-88 TO TRUE. DTSCS13 +01319 DTSCS13 +01320 SET MFAE-SERVICE-CORRESPOND-88 TO TRUE. DTSCS13 +01321 DTSCS13 +01322 IF MAP-FISC-AGNT-CD NOT = MFAE-FISCAL-AGENT-CD DTSCS13 +01323 MOVE 'FISCAL AGENT ' TO L331-REC-OCC-ID DTSCS13 +01324 MOVE 'FISC-AGNT-CD ' TO L331-FIELD-NAME DTSCS13 +01325 MOVE MFAE-FISCAL-AGENT-CD TO L331-FROM-VALUE DTSCS13 +01326 MOVE MAP-FISC-AGNT-CD TO L331-TO-VALUE DTSCS13 +01327 PERFORM S331-EMP-WRITE-MLOG THRU S331-EXIT. DTSCS13 01328 DTSCS13 -01329 SET MFAE-NOT-CONVERTED-88 TO TRUE. DTSCS13 +01329 MOVE MAP-FISC-AGNT-CD TO MFAE-FISCAL-AGENT-CD. DTSCS13 01330 DTSCS13 -01331 MOVE LCCM-CURR-RUN-DATE TO MFAE-ESTB-DATE DTSCS13 -01332 MFAE-CHNG-DATE. DTSCS13 -01333 DTSCS13 -01334 MOVE MFAE-REC TO MSKL-REC. DTSCS13 -01335 DTSCS13 -01336 PERFORM S810-WRITE THRU S810-EXIT. DTSCS13 -01337 P8931-EXIT. DTSCS13 -01338 EXIT. DTSCS13 +01331 MOVE ZEROS TO MFAE-PURGE-DATE. DTSCS13 +01332 DTSCS13 +01333 SET MFAE-NOT-CONVERTED-88 TO TRUE. DTSCS13 +01334 DTSCS13 +01335 MOVE LCCM-CURR-RUN-DATE TO MFAE-ESTB-DATE DTSCS13 +01336 MFAE-CHNG-DATE. DTSCS13 +01337 DTSCS13 +01338 MOVE MFAE-REC TO MSKL-REC. DTSCS13 01339 DTSCS13 -01340 P8932-DELETE-MFAE. DTSCS13 -01341 MOVE 'FISCAL AGENT ' TO L331-REC-OCC-ID. DTSCS13 -01342 MOVE 'FISC-AGNT-CD ' TO L331-FIELD-NAME DTSCS13 -01343 MOVE MFAE-FISCAL-AGENT-CD TO L331-FROM-VALUE DTSCS13 -01344 MOVE MAP-FISC-AGNT-CD TO L331-TO-VALUE DTSCS13 -01345 PERFORM S331-EMP-WRITE-MLOG THRU S331-EXIT. DTSCS13 -01346 DTSCS13 -01347 MOVE MFAE-REC TO MSKL-REC. DTSCS13 -01348 PERFORM S810-DELETE THRU S810-EXIT. DTSCS13 -01349 P8932-EXIT. EXIT. DTSCS13 -01350 SKIP3 DTSCS13 -01351 DTSCS13 -01352 P8933-UPDATE-MFAE. DTSCS13 -01353 DTSCS13 -01354 IF MAP-FISC-AGNT-CD NOT = MFAE-FISCAL-AGENT-CD DTSCS13 -01355 MOVE 'FISCAL AGENT ' TO L331-REC-OCC-ID. DTSCS13 -01356 MOVE 'FISC-AGNT-CD ' TO L331-FIELD-NAME DTSCS13 -01357 MOVE MFAE-FISCAL-AGENT-CD TO L331-FROM-VALUE DTSCS13 -01358 MOVE MAP-FISC-AGNT-CD TO L331-TO-VALUE DTSCS13 -01359 PERFORM S331-EMP-WRITE-MLOG THRU S331-EXIT. DTSCS13 -01360 DTSCS13 -01361 MOVE MAP-FISC-AGNT-CD TO MFAE-FISCAL-AGENT-CD. DTSCS13 -01362 MOVE LCCM-CURR-RUN-DATE TO MFAE-CHNG-DATE. DTSCS13 -01363 MOVE MFAE-REC TO MSKL-REC. DTSCS13 -01364 PERFORM S810-REWRITE THRU S810-EXIT. DTSCS13 -01365 P8933-EXIT. EXIT. DTSCS13 -01366 SKIP3 DTSCS13 -01367 P8940-ADD-MEVL. DTSCS13 -01368 MOVE LOW-VALUES TO MEVL-REC. DTSCS13 -01369 DTSCS13 -01370 MOVE WRK-EMP-NO TO MEVL-EMP-NO. DTSCS13 -01371 DTSCS13 -01372 SET MEVL-EVL-88 TO TRUE. DTSCS13 +01340 PERFORM S810-WRITE THRU S810-EXIT. DTSCS13 +01341 P8931-EXIT. DTSCS13 +01342 EXIT. DTSCS13 +01343 DTSCS13 +01344 P8932-DELETE-MFAE. DTSCS13 +01345 MOVE 'FISCAL AGENT ' TO L331-REC-OCC-ID. DTSCS13 +01346 MOVE 'FISC-AGNT-CD ' TO L331-FIELD-NAME DTSCS13 +01347 MOVE MFAE-FISCAL-AGENT-CD TO L331-FROM-VALUE DTSCS13 +01348 MOVE MAP-FISC-AGNT-CD TO L331-TO-VALUE DTSCS13 +01349 PERFORM S331-EMP-WRITE-MLOG THRU S331-EXIT. DTSCS13 +01350 DTSCS13 +01351 MOVE MFAE-REC TO MSKL-REC. DTSCS13 +01352 PERFORM S810-DELETE THRU S810-EXIT. DTSCS13 +01353 P8932-EXIT. EXIT. DTSCS13 +01354 SKIP3 DTSCS13 +01355 DTSCS13 +01356 P8933-UPDATE-MFAE. DTSCS13 +01357 DTSCS13 +01358 IF MAP-FISC-AGNT-CD NOT = MFAE-FISCAL-AGENT-CD DTSCS13 +01359 MOVE 'FISCAL AGENT ' TO L331-REC-OCC-ID. DTSCS13 +01360 MOVE 'FISC-AGNT-CD ' TO L331-FIELD-NAME DTSCS13 +01361 MOVE MFAE-FISCAL-AGENT-CD TO L331-FROM-VALUE DTSCS13 +01362 MOVE MAP-FISC-AGNT-CD TO L331-TO-VALUE DTSCS13 +01363 PERFORM S331-EMP-WRITE-MLOG THRU S331-EXIT. DTSCS13 +01364 DTSCS13 +01365 MOVE MAP-FISC-AGNT-CD TO MFAE-FISCAL-AGENT-CD. DTSCS13 +01366 MOVE LCCM-CURR-RUN-DATE TO MFAE-CHNG-DATE. DTSCS13 +01367 MOVE MFAE-REC TO MSKL-REC. DTSCS13 +01368 PERFORM S810-REWRITE THRU S810-EXIT. DTSCS13 +01369 P8933-EXIT. EXIT. DTSCS13 +01370 SKIP3 DTSCS13 +01371 P8940-ADD-MEVL. DTSCS13 +01372 MOVE LOW-VALUES TO MEVL-REC. DTSCS13 01373 DTSCS13 -01374 MOVE LCCM-TASK-START-DATE TO MEVL-DATE. DTSCS13 +01374 MOVE WRK-EMP-NO TO MEVL-EMP-NO. DTSCS13 01375 DTSCS13 -01376 MOVE LCCM-TASK-START-TIME TO MEVL-TIME. DTSCS13 +01376 SET MEVL-EVL-88 TO TRUE. DTSCS13 01377 DTSCS13 -01378 MOVE +0 TO MEVL-PURGE-DATE. DTSCS13 +01378 MOVE LCCM-TASK-START-DATE TO MEVL-DATE. DTSCS13 01379 DTSCS13 -01380 MOVE 'MAIL ADDR CHANGED - RETURN MAIL SET TO NO' DTSCS13 -01381 TO MEVL-TEXT DTSCS13 -01382 DTSCS13 -01383 MOVE LCCM-OP-ID TO MEVL-SOURCE. DTSCS13 -01384 DTSCS13 -01385 SET MEVL-NOT-CONVERTED-88 TO TRUE. DTSCS13 +01380 MOVE LCCM-TASK-START-TIME TO MEVL-TIME. DTSCS13 +01381 DTSCS13 +01382 MOVE +0 TO MEVL-PURGE-DATE. DTSCS13 +01383 DTSCS13 +01384 MOVE 'MAIL ADDR CHANGED - RETURN MAIL SET TO NO' DTSCS13 +01385 TO MEVL-TEXT DTSCS13 01386 DTSCS13 -01387 MOVE LCCM-CURR-RUN-DATE TO MEVL-ESTB-DATE DTSCS13 -01388 MEVL-CHNG-DATE. DTSCS13 -01389 DTSCS13 -01390 MOVE MEVL-REC TO MSKL-REC. DTSCS13 -01391 DTSCS13 -01392 PERFORM S810-WRITE THRU S810-EXIT. DTSCS13 -01393 P8940-EXIT. EXIT. DTSCS13 -01394 SKIP3 DTSCS13 -01395 /*****************************************************************DTSCS13 -01396 * LINKS TO UTILITY MODULES DTSCS13 -01397 ******************************************************************DTSCS13 -01398 DTSCS13 -01399 S018-EMP-NO-FROM-SCREEN. DTSCS13 -01400 EXEC CICS LINK DTSCS13 -01401 PROGRAM ('DTSCU018') DTSCS13 -01402 COMMAREA (L018-COMM-AREA) DTSCS13 -01403 END-EXEC. DTSCS13 -01404 S018-EXIT. DTSCS13 -01405 EXIT. DTSCS13 -01406 SKIP3 DTSCS13 -01407 S021-TELNO-FROM-SCREEN. DTSCS13 -01408 EXEC CICS LINK DTSCS13 -01409 PROGRAM ('DTSCU021') DTSCS13 -01410 COMMAREA (L021-COMM-AREA) DTSCS13 -01411 END-EXEC. DTSCS13 -01412 S021-EXIT. DTSCS13 -01413 EXIT. DTSCS13 -01414 SKIP3 DTSCS13 -01415 S072-ADDRESS-EDIT. DTSCS13 -01416 EXEC CICS LINK DTSCS13 -01417 PROGRAM ('DTSCU072') DTSCS13 -01418 COMMAREA (L072-COMM-AREA) DTSCS13 -01419 END-EXEC. DTSCS13 -01420 S072-EXIT. DTSCS13 -01421 EXIT. DTSCS13 -01422 SKIP3 DTSCS13 -01423 S073-TELNO-EDIT. DTSCS13 -01424 EXEC CICS LINK DTSCS13 -01425 PROGRAM ('DTSCU073') DTSCS13 -01426 COMMAREA (L073-COMM-AREA) DTSCS13 -01427 END-EXEC. DTSCS13 -01428 S073-EXIT. DTSCS13 -01429 EXIT. DTSCS13 -01430 SKIP3 DTSCS13 -01431 S203-DETER-ZIPS. DTSCS13 -01432 EXEC CICS LINK DTSCS13 -01433 PROGRAM ('DTSCU203') DTSCS13 -01434 COMMAREA (L203-COMM-AREA) DTSCS13 -01435 END-EXEC. DTSCS13 -01436 DTSCS13 -01437 IF L203-FILE-CLOSED-88 DTSCS13 -01438 MOVE L203-MSG-AREA TO LCCM-MSG-AREA DTSCS13 -01439 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS13 -01440 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS13 -01441 GO TO MAINLINE-EXIT. DTSCS13 -01442 S203-EXIT. DTSCS13 -01443 EXIT. DTSCS13 -01444 SKIP3 DTSCS13 -01445 S221-EMP-LOCK. DTSCS13 -01446 SET L221-START-UPDATE TO TRUE. DTSCS13 -01447 GO TO S221-EMP-LOCK-UNLOCK. DTSCS13 -01448 DTSCS13 -01449 S221-EMP-UNLOCK. DTSCS13 -01450 SET L221-END-UPDATE TO TRUE. DTSCS13 +01387 MOVE LCCM-OP-ID TO MEVL-SOURCE. DTSCS13 +01388 DTSCS13 +01389 SET MEVL-NOT-CONVERTED-88 TO TRUE. DTSCS13 +01390 DTSCS13 +01391 MOVE LCCM-CURR-RUN-DATE TO MEVL-ESTB-DATE DTSCS13 +01392 MEVL-CHNG-DATE. DTSCS13 +01393 DTSCS13 +01394 MOVE MEVL-REC TO MSKL-REC. DTSCS13 +01395 DTSCS13 +01396 PERFORM S810-WRITE THRU S810-EXIT. DTSCS13 +01397 P8940-EXIT. EXIT. DTSCS13 +01398 SKIP3 DTSCS13 +01399 /*****************************************************************DTSCS13 +01400 * LINKS TO UTILITY MODULES DTSCS13 +01401 ******************************************************************DTSCS13 +01402 DTSCS13 +01403 S018-EMP-NO-FROM-SCREEN. DTSCS13 +01404 EXEC CICS LINK DTSCS13 +01405 PROGRAM ('DTSCU018') DTSCS13 +01406 COMMAREA (L018-COMM-AREA) DTSCS13 +01407 END-EXEC. DTSCS13 +01408 S018-EXIT. DTSCS13 +01409 EXIT. DTSCS13 +01410 SKIP3 DTSCS13 +01411 S021-TELNO-FROM-SCREEN. DTSCS13 +01412 EXEC CICS LINK DTSCS13 +01413 PROGRAM ('DTSCU021') DTSCS13 +01414 COMMAREA (L021-COMM-AREA) DTSCS13 +01415 END-EXEC. DTSCS13 +01416 S021-EXIT. DTSCS13 +01417 EXIT. DTSCS13 +01418 SKIP3 DTSCS13 +01419 S072-ADDRESS-EDIT. DTSCS13 +01420 EXEC CICS LINK DTSCS13 +01421 PROGRAM ('DTSCU072') DTSCS13 +01422 COMMAREA (L072-COMM-AREA) DTSCS13 +01423 END-EXEC. DTSCS13 +01424 S072-EXIT. DTSCS13 +01425 EXIT. DTSCS13 +01426 SKIP3 DTSCS13 +01427 S073-TELNO-EDIT. DTSCS13 +01428 EXEC CICS LINK DTSCS13 +01429 PROGRAM ('DTSCU073') DTSCS13 +01430 COMMAREA (L073-COMM-AREA) DTSCS13 +01431 END-EXEC. DTSCS13 +01432 S073-EXIT. DTSCS13 +01433 EXIT. DTSCS13 +01434 SKIP3 DTSCS13 +01435 S203-DETER-ZIPS. DTSCS13 +01436 EXEC CICS LINK DTSCS13 +01437 PROGRAM ('DTSCU203') DTSCS13 +01438 COMMAREA (L203-COMM-AREA) DTSCS13 +01439 END-EXEC. DTSCS13 +01440 DTSCS13 +01441 IF L203-FILE-CLOSED-88 DTSCS13 +01442 MOVE L203-MSG-AREA TO LCCM-MSG-AREA DTSCS13 +01443 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS13 +01444 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS13 +01445 GO TO MAINLINE-EXIT. DTSCS13 +01446 S203-EXIT. DTSCS13 +01447 EXIT. DTSCS13 +01448 SKIP3 DTSCS13 +01449 S221-EMP-LOCK. DTSCS13 +01450 SET L221-START-UPDATE TO TRUE. DTSCS13 01451 GO TO S221-EMP-LOCK-UNLOCK. DTSCS13 01452 DTSCS13 -01453 S221-EMP-LOCK-UNLOCK. DTSCS13 -01454 EXEC CICS LINK DTSCS13 -01455 PROGRAM ('DTSCU221') DTSCS13 -01456 COMMAREA (L221-COMM-AREA) DTSCS13 -01457 END-EXEC. DTSCS13 -01458 DTSCS13 -01459 IF L221-FILE-CLOSED DTSCS13 -01460 MOVE L221-MSG-AREA TO LCCM-MSG-AREA DTSCS13 -01461 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS13 -01462 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS13 -01463 GO TO MAINLINE-EXIT. DTSCS13 -01464 DTSCS13 -01465 IF L221-NOT-OK DTSCS13 -01466 MOVE L221-MSG-AREA TO LCCM-MSG-AREA. DTSCS13 -01467 S221-EXIT. DTSCS13 -01468 EXIT. DTSCS13 -01469 SKIP3 DTSCS13 -01470 S330-EMP-INIT-MLOG. DTSCS13 -01471 MOVE WRK-EMP-NO TO L331-EMP-NO. DTSCS13 -01472 MOVE LCCM-CURR-RUN-DATE TO L331-CURR-RUN-DATE. DTSCS13 -01473 MOVE LCCM-TASK-START-ABSTIME TO L331-UPDATE-ABSTIME. DTSCS13 -01474 MOVE LCCM-OP-ID TO L331-OP-ID. DTSCS13 -01475 S330-EXIT. EXIT. DTSCS13 -01476 DTSCS13 -01477 S331-EMP-WRITE-MLOG. DTSCS13 -01478 EXEC CICS LINK DTSCS13 -01479 PROGRAM ('DTSCU331') DTSCS13 -01480 COMMAREA (L331-COMM-AREA) DTSCS13 -01481 END-EXEC. DTSCS13 -01482 DTSCS13 -01483 IF L331-FILE-CLOSED DTSCS13 -01484 MOVE L331-MSG-AREA TO LCCM-MSG-AREA DTSCS13 -01485 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS13 -01486 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS13 -01487 GO TO MAINLINE-EXIT. DTSCS13 -01488 S331-EXIT. DTSCS13 -01489 EXIT. DTSCS13 -01490 SKIP3 DTSCS13 -01491 S803-REQ-SCR-ID-EDIT. DTSCS13 -01492 EXEC CICS LINK DTSCS13 -01493 PROGRAM ('DTSCU803') DTSCS13 -01494 COMMAREA (DFHCOMMAREA) DTSCS13 -01495 END-EXEC. DTSCS13 -01496 S803-EXIT. DTSCS13 -01497 EXIT. DTSCS13 -01498 SKIP3 DTSCS13 -01499 S804-INVALID-KEY. DTSCS13 -01500 EXEC CICS LINK DTSCS13 -01501 PROGRAM ('DTSCU804') DTSCS13 -01502 COMMAREA (DFHCOMMAREA) DTSCS13 -01503 END-EXEC. DTSCS13 -01504 S804-EXIT. DTSCS13 -01505 EXIT. DTSCS13 -01506 SKIP3 DTSCS13 -01507 S805-MSG-AREA. DTSCS13 -01508 MOVE LCCM-MSG-AREA TO L805-MSG-AREA DTSCS13 -01509 DTSCS13 -01510 EXEC CICS LINK DTSCS13 -01511 PROGRAM ('DTSCU805') DTSCS13 -01512 COMMAREA (L805-COMM-AREA) DTSCS13 -01513 END-EXEC. DTSCS13 -01514 DTSCS13 -01515 MOVE L805-S-MSG-AREA TO MAP-MSG-AREA. DTSCS13 -01516 S805-EXIT. DTSCS13 -01517 EXIT. DTSCS13 -01518 EJECT DTSCS13 -01519 S810-START-BROWSE. DTSCS13 -01520 SET L810-START-BROWSE-88 TO TRUE. DTSCS13 -01521 GO TO S810-IO. DTSCS13 -01522 DTSCS13 -01523 S810-READ. DTSCS13 -01524 SET L810-READ-88 TO TRUE. DTSCS13 +01453 S221-EMP-UNLOCK. DTSCS13 +01454 SET L221-END-UPDATE TO TRUE. DTSCS13 +01455 GO TO S221-EMP-LOCK-UNLOCK. DTSCS13 +01456 DTSCS13 +01457 S221-EMP-LOCK-UNLOCK. DTSCS13 +01458 EXEC CICS LINK DTSCS13 +01459 PROGRAM ('DTSCU221') DTSCS13 +01460 COMMAREA (L221-COMM-AREA) DTSCS13 +01461 END-EXEC. DTSCS13 +01462 DTSCS13 +01463 IF L221-FILE-CLOSED DTSCS13 +01464 MOVE L221-MSG-AREA TO LCCM-MSG-AREA DTSCS13 +01465 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS13 +01466 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS13 +01467 GO TO MAINLINE-EXIT. DTSCS13 +01468 DTSCS13 +01469 IF L221-NOT-OK DTSCS13 +01470 MOVE L221-MSG-AREA TO LCCM-MSG-AREA. DTSCS13 +01471 S221-EXIT. DTSCS13 +01472 EXIT. DTSCS13 +01473 SKIP3 DTSCS13 +01474 S330-EMP-INIT-MLOG. DTSCS13 +01475 MOVE WRK-EMP-NO TO L331-EMP-NO. DTSCS13 +01476 MOVE LCCM-CURR-RUN-DATE TO L331-CURR-RUN-DATE. DTSCS13 +01477 MOVE LCCM-TASK-START-ABSTIME TO L331-UPDATE-ABSTIME. DTSCS13 +01478 MOVE LCCM-OP-ID TO L331-OP-ID. DTSCS13 +01479 S330-EXIT. EXIT. DTSCS13 +01480 DTSCS13 +01481 S331-EMP-WRITE-MLOG. DTSCS13 +01482 EXEC CICS LINK DTSCS13 +01483 PROGRAM ('DTSCU331') DTSCS13 +01484 COMMAREA (L331-COMM-AREA) DTSCS13 +01485 END-EXEC. DTSCS13 +01486 DTSCS13 +01487 IF L331-FILE-CLOSED DTSCS13 +01488 MOVE L331-MSG-AREA TO LCCM-MSG-AREA DTSCS13 +01489 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS13 +01490 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS13 +01491 GO TO MAINLINE-EXIT. DTSCS13 +01492 S331-EXIT. DTSCS13 +01493 EXIT. DTSCS13 +01494 SKIP3 DTSCS13 +01495 S803-REQ-SCR-ID-EDIT. DTSCS13 +01496 EXEC CICS LINK DTSCS13 +01497 PROGRAM ('DTSCU803') DTSCS13 +01498 COMMAREA (DFHCOMMAREA) DTSCS13 +01499 END-EXEC. DTSCS13 +01500 S803-EXIT. DTSCS13 +01501 EXIT. DTSCS13 +01502 SKIP3 DTSCS13 +01503 S804-INVALID-KEY. DTSCS13 +01504 EXEC CICS LINK DTSCS13 +01505 PROGRAM ('DTSCU804') DTSCS13 +01506 COMMAREA (DFHCOMMAREA) DTSCS13 +01507 END-EXEC. DTSCS13 +01508 S804-EXIT. DTSCS13 +01509 EXIT. DTSCS13 +01510 SKIP3 DTSCS13 +01511 S805-MSG-AREA. DTSCS13 +01512 MOVE LCCM-MSG-AREA TO L805-MSG-AREA DTSCS13 +01513 DTSCS13 +01514 EXEC CICS LINK DTSCS13 +01515 PROGRAM ('DTSCU805') DTSCS13 +01516 COMMAREA (L805-COMM-AREA) DTSCS13 +01517 END-EXEC. DTSCS13 +01518 DTSCS13 +01519 MOVE L805-S-MSG-AREA TO MAP-MSG-AREA. DTSCS13 +01520 S805-EXIT. DTSCS13 +01521 EXIT. DTSCS13 +01522 EJECT DTSCS13 +01523 S810-START-BROWSE. DTSCS13 +01524 SET L810-START-BROWSE-88 TO TRUE. DTSCS13 01525 GO TO S810-IO. DTSCS13 01526 DTSCS13 -01527 S810-READ-NEXT. DTSCS13 -01528 SET L810-READ-NEXT-88 TO TRUE. DTSCS13 +01527 S810-READ. DTSCS13 +01528 SET L810-READ-88 TO TRUE. DTSCS13 01529 GO TO S810-IO. DTSCS13 01530 DTSCS13 -01531 S810-END-BROWSE. DTSCS13 -01532 SET L810-END-BROWSE-88 TO TRUE. DTSCS13 +01531 S810-READ-NEXT. DTSCS13 +01532 SET L810-READ-NEXT-88 TO TRUE. DTSCS13 01533 GO TO S810-IO. DTSCS13 01534 DTSCS13 -01535 S810-REWRITE. DTSCS13 -01536 SET L810-REWRITE-88 TO TRUE. DTSCS13 +01535 S810-END-BROWSE. DTSCS13 +01536 SET L810-END-BROWSE-88 TO TRUE. DTSCS13 01537 GO TO S810-IO. DTSCS13 01538 DTSCS13 -01539 S810-WRITE. DTSCS13 -01540 SET L810-WRITE-88 TO TRUE. DTSCS13 +01539 S810-REWRITE. DTSCS13 +01540 SET L810-REWRITE-88 TO TRUE. DTSCS13 01541 GO TO S810-IO. DTSCS13 01542 DTSCS13 -01543 S810-DELETE. DTSCS13 -01544 SET L810-DELETE-88 TO TRUE. DTSCS13 +01543 S810-WRITE. DTSCS13 +01544 SET L810-WRITE-88 TO TRUE. DTSCS13 01545 GO TO S810-IO. DTSCS13 01546 DTSCS13 -01547 S810-IO. DTSCS13 -01548 DTSCS13 -01549 EXEC CICS LINK DTSCS13 -01550 PROGRAM ('DTSCU810') DTSCS13 -01551 COMMAREA (L810-COMM-AREA) DTSCS13 -01552 END-EXEC. DTSCS13 -01553 DTSCS13 -01554 IF L810-FILE-CLOSED-88 DTSCS13 -01555 MOVE L810-MSG-AREA TO LCCM-MSG-AREA DTSCS13 -01556 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS13 -01557 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS13 -01558 GO TO MAINLINE-EXIT. DTSCS13 -01559 S810-EXIT. DTSCS13 -01560 EXIT. DTSCS13 -01561 EJECT DTSCS13 -01562 S831-READ. DTSCS13 -01563 SET L831-READ-88 TO TRUE. DTSCS13 -01564 SKIP1 DTSCS13 -01565 EXEC CICS LINK DTSCS13 -01566 PROGRAM ('DTSCU831') DTSCS13 -01567 COMMAREA (L831-COMM-AREA) DTSCS13 -01568 END-EXEC. DTSCS13 -01569 SKIP1 DTSCS13 -01570 IF L831-FILE-CLOSED-88 DTSCS13 -01571 MOVE L831-MSG-AREA TO LCCM-MSG-AREA DTSCS13 -01572 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS13 -01573 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS13 -01574 GO TO MAINLINE-EXIT. DTSCS13 -01575 S831-EXIT. DTSCS13 -01576 EXIT. DTSCS13 -01577 EJECT DTSCS13 -01578 S851-SCREEN-PROCESSING. DTSCS13 -01579 EXEC CICS LINK DTSCS13 -01580 PROGRAM ('DTSCU851') DTSCS13 -01581 COMMAREA (L851-COMM-AREA) DTSCS13 -01582 END-EXEC. DTSCS13 -01583 S851-EXIT. DTSCS13 -01584 EXIT. DTSCS13 -01585 SKIP3 DTSCS13 -01586 S899-ABEND. DTSCS13 -01587 EXEC CICS ABEND DTSCS13 -01588 ABCODE(WRK-ABEND-CD) DTSCS13 -01589 END-EXEC. DTSCS13 -01590 *S899-EXIT. DTSCS13 -01591 * EXIT. DTSCS13 -01592 /*****************************************************************DTSCS13 -01593 * EDIT THE INFORMATION ON THE SCREEN. *DTSCS13 -01594 ******************************************************************DTSCS13 -01595 DTSCS13 -01596 S1001-SCREEN-KEY-EDITS. DTSCS13 -01597 DTSCS13 -01598 PERFORM S1100-EMP-NO THRU S1100-EXIT. DTSCS13 +01547 S810-DELETE. DTSCS13 +01548 SET L810-DELETE-88 TO TRUE. DTSCS13 +01549 GO TO S810-IO. DTSCS13 +01550 DTSCS13 +01551 S810-IO. DTSCS13 +01552 DTSCS13 +01553 EXEC CICS LINK DTSCS13 +01554 PROGRAM ('DTSCU810') DTSCS13 +01555 COMMAREA (L810-COMM-AREA) DTSCS13 +01556 END-EXEC. DTSCS13 +01557 DTSCS13 +01558 IF L810-FILE-CLOSED-88 DTSCS13 +01559 MOVE L810-MSG-AREA TO LCCM-MSG-AREA DTSCS13 +01560 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS13 +01561 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS13 +01562 GO TO MAINLINE-EXIT. DTSCS13 +01563 S810-EXIT. DTSCS13 +01564 EXIT. DTSCS13 +01565 EJECT DTSCS13 +01566 S831-READ. DTSCS13 +01567 SET L831-READ-88 TO TRUE. DTSCS13 +01568 SKIP1 DTSCS13 +01569 EXEC CICS LINK DTSCS13 +01570 PROGRAM ('DTSCU831') DTSCS13 +01571 COMMAREA (L831-COMM-AREA) DTSCS13 +01572 END-EXEC. DTSCS13 +01573 SKIP1 DTSCS13 +01574 IF L831-FILE-CLOSED-88 DTSCS13 +01575 MOVE L831-MSG-AREA TO LCCM-MSG-AREA DTSCS13 +01576 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS13 +01577 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS13 +01578 GO TO MAINLINE-EXIT. DTSCS13 +01579 S831-EXIT. DTSCS13 +01580 EXIT. DTSCS13 +01581 EJECT DTSCS13 +01582 S851-SCREEN-PROCESSING. DTSCS13 +01583 EXEC CICS LINK DTSCS13 +01584 PROGRAM ('DTSCU851') DTSCS13 +01585 COMMAREA (L851-COMM-AREA) DTSCS13 +01586 END-EXEC. DTSCS13 +01587 S851-EXIT. DTSCS13 +01588 EXIT. DTSCS13 +01589 SKIP3 DTSCS13 +01590 S899-ABEND. DTSCS13 +01591 EXEC CICS ABEND DTSCS13 +01592 ABCODE(WRK-ABEND-CD) DTSCS13 +01593 END-EXEC. DTSCS13 +01594 *S899-EXIT. DTSCS13 +01595 * EXIT. DTSCS13 +01596 /*****************************************************************DTSCS13 +01597 * EDIT THE INFORMATION ON THE SCREEN. *DTSCS13 +01598 ******************************************************************DTSCS13 01599 DTSCS13 -01600 S1001-EXIT. EXIT. DTSCS13 -01601 SKIP3 DTSCS13 -01602 S1002-SCREEN-DATA-EDITS. DTSCS13 -01603 MOVE LOW-VALUES TO MAP-CASS (1) DTSCS13 -01604 MAP-CASS (2). DTSCS13 -01605 SET WRK-STATE-CHANGE-NULL-88 TO TRUE. DTSCS13 -01606 SET WRK-PO-BOX-CHANGE-NULL-88 TO TRUE. DTSCS13 -01607 DTSCS13 -01608 DTSCS13 -01609 PERFORM S1200-PRIMARY-NAME THRU S1200-EXIT. DTSCS13 -01610 PERFORM S1300-ENTITY-IND THRU S1300-EXIT. DTSCS13 -01611 PERFORM S1350-ENTITY-NAME THRU S1350-EXIT. DTSCS13 +01600 S1001-SCREEN-KEY-EDITS. DTSCS13 +01601 DTSCS13 +01602 PERFORM S1100-EMP-NO THRU S1100-EXIT. DTSCS13 +01603 DTSCS13 +01604 S1001-EXIT. EXIT. DTSCS13 +01605 SKIP3 DTSCS13 +01606 S1002-SCREEN-DATA-EDITS. DTSCS13 +01607 MOVE LOW-VALUES TO MAP-CASS (1) DTSCS13 +01608 MAP-CASS (2). DTSCS13 +01609 SET WRK-STATE-CHANGE-NULL-88 TO TRUE. DTSCS13 +01610 SET WRK-PO-BOX-CHANGE-NULL-88 TO TRUE. DTSCS13 +01611 DTSCS13 01612 DTSCS13 -01613 PERFORM S1400-FISCAL-AGNT THRU S1400-EXIT. DTSCS13 -01614 DTSCS13 -01615 IF LCCM-MSG DTSCS13 -01616 GO TO S1002-EXIT DTSCS13 -01617 END-IF. DTSCS13 +01613 PERFORM S1200-PRIMARY-NAME THRU S1200-EXIT. DTSCS13 +01614 PERFORM S1300-ENTITY-IND THRU S1300-EXIT. DTSCS13 +01615 PERFORM S1350-ENTITY-NAME THRU S1350-EXIT. DTSCS13 +01616 DTSCS13 +01617 PERFORM S1400-FISCAL-AGNT THRU S1400-EXIT. DTSCS13 01618 DTSCS13 -01619 PERFORM S1500-MTAD THRU S1500-EXIT DTSCS13 -01620 VARYING WRK-TAD FROM 1 BY 1 DTSCS13 -01621 UNTIL WRK-TAD GREATER THAN 2. DTSCS13 +01619 IF LCCM-MSG DTSCS13 +01620 GO TO S1002-EXIT DTSCS13 +01621 END-IF. DTSCS13 01622 DTSCS13 -01623 IF LCCM-MSG DTSCS13 -01624 GO TO S1002-EXIT DTSCS13 -01625 ELSE DTSCS13 -01626 IF MPRF-CLASS-SUB-88 DTSCS13 -01627 PERFORM S1600-CHECK-FOR-DC-ADDR THRU S1600-EXIT DTSCS13 -01628 END-IF DTSCS13 -01629 END-IF. DTSCS13 -01630 DTSCS13 -01631 S1002-EXIT. EXIT. DTSCS13 -01632 /*****************************************************************DTSCS13 -01633 * EMP-NO IS THE ONLY KEY FIELD FOR MPRF *DTSCS13 -01634 ******************************************************************DTSCS13 -01635 S1100-EMP-NO. DTSCS13 -01636 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS13 -01637 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS13 -01638 DTSCS13 -01639 IF L018-NO-ENTRY DTSCS13 -01640 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS13 -01641 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS13 -01642 ELSE DTSCS13 -01643 IF L018-NOT-VALID DTSCS13 -01644 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS13 +01623 PERFORM S1500-MTAD THRU S1500-EXIT DTSCS13 +01624 VARYING WRK-TAD FROM 1 BY 1 DTSCS13 +01625 UNTIL WRK-TAD GREATER THAN 2. DTSCS13 +01626 DTSCS13 +01627 IF LCCM-MSG DTSCS13 +01628 GO TO S1002-EXIT DTSCS13 +01629 ELSE DTSCS13 +01630 IF MPRF-CLASS-SUB-88 DTSCS13 +01631 PERFORM S1600-CHECK-FOR-DC-ADDR THRU S1600-EXIT DTSCS13 +01632 END-IF DTSCS13 +01633 END-IF. DTSCS13 +01634 DTSCS13 +01635 S1002-EXIT. EXIT. DTSCS13 +01636 /*****************************************************************DTSCS13 +01637 * EMP-NO IS THE ONLY KEY FIELD FOR MPRF *DTSCS13 +01638 ******************************************************************DTSCS13 +01639 S1100-EMP-NO. DTSCS13 +01640 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS13 +01641 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS13 +01642 DTSCS13 +01643 IF L018-NO-ENTRY DTSCS13 +01644 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS13 01645 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS13 01646 ELSE DTSCS13 -01647 MOVE L018-EMP-NO TO WRK-EMP-NO. DTSCS13 -01648 S1100-EXIT. EXIT. DTSCS13 -01649 SKIP3 DTSCS13 -01650 S1101-ERROR. DTSCS13 -01651 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-EMP-NO-1-A DTSCS13 -01652 MAP-EMP-NO-2-A. DTSCS13 -01653 IF LCCM-NO-MSG DTSCS13 -01654 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS13 -01655 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L DTSCS13 -01656 SET CURSOR-SET-YES TO TRUE. DTSCS13 -01657 S1101-EXIT. EXIT. DTSCS13 -01658 /*****************************************************************DTSCS13 -01659 * *DTSCS13 -01660 ******************************************************************DTSCS13 -01661 S1200-PRIMARY-NAME. DTSCS13 -01662 IF MAP-PRIMARY-NAME = LOW-VALUES OR SPACES DTSCS13 -01663 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS13 -01664 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS13 -01665 ELSE DTSCS13 -01666 IF MAP-PRIMARY-NAME (1:1) = LOW-VALUES OR SPACES DTSCS13 -01667 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS13 -01668 PERFORM S1201-ERROR THRU S1201-EXIT. DTSCS13 -01669 S1200-EXIT. EXIT. DTSCS13 -01670 DTSCS13 -01671 S1201-ERROR. DTSCS13 -01672 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-PRIMARY-NAME-A. DTSCS13 -01673 IF LCCM-NO-MSG DTSCS13 -01674 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS13 -01675 MOVE CATB-CURSOR TO MAP-PRIMARY-NAME-L DTSCS13 -01676 SET CURSOR-SET-YES TO TRUE. DTSCS13 -01677 S1201-EXIT. EXIT. DTSCS13 -01678 /*****************************************************************DTSCS13 -01679 * *DTSCS13 -01680 ******************************************************************DTSCS13 -01681 S1300-ENTITY-IND. DTSCS13 -01682 IF MAP-ENTITY-NAME-IND = LOW-VALUES OR SPACES DTSCS13 -01683 SET MAP-ENTITY-NAME-NO-88 TO TRUE. DTSCS13 -01684 DTSCS13 -01685 IF MAP-ENTITY-NAME-VALID-88 DTSCS13 -01686 NEXT SENTENCE DTSCS13 -01687 ELSE DTSCS13 -01688 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS13 -01689 PERFORM S1301-ERROR THRU S1301-EXIT. DTSCS13 -01690 S1300-EXIT. EXIT. DTSCS13 -01691 DTSCS13 -01692 S1301-ERROR. DTSCS13 -01693 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ENTITY-NAME-IND-A. DTSCS13 -01694 IF LCCM-NO-MSG DTSCS13 -01695 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS13 -01696 MOVE CATB-CURSOR TO MAP-ENTITY-NAME-IND-L DTSCS13 -01697 SET CURSOR-SET-YES TO TRUE. DTSCS13 -01698 S1301-EXIT. EXIT. DTSCS13 -01699 DTSCS13 -01700 /*****************************************************************DTSCS13 -01701 * PRIMARY NAME CAN BE EITHER ENTITY NAME OR TRADE NAME. SETTING *DTSCS13 -01702 * OF ENTITY NAME IND SHOWS WHETHER IT IS THE ENTITY NAME OR NOT.*DTSCS13 -01703 * IF ENTITY NAME IND = YES, DO NOT ALLOW SEPARATE ENTRY OF *DTSCS13 -01704 * ENTITY NAME - IT WILL DUPLICATE PRIMARY NAME ALREADY ENTERED. *DTSCS13 -01705 * *DTSCS13 -01706 * IF ENTITY NAME IND = NO, ENTITY NAME CANNOT EQUAL PRIMARY *DTSCS13 -01707 * NAME. *DTSCS13 -01708 ******************************************************************DTSCS13 -01709 S1350-ENTITY-NAME. DTSCS13 -01710 IF MAP-ENTITY-NAME = LOW-VALUES OR SPACES DTSCS13 -01711 MOVE SPACES TO MAP-ENTITY-NAME DTSCS13 -01712 GO TO S1350-EXIT. DTSCS13 -01713 DTSCS13 -01714 IF MAP-ENTITY-NAME-YES-88 DTSCS13 -01715 IF MAP-ENTITY-NAME > SPACES DTSCS13 -01716 MOVE MSG-E131-AREA TO WRK-MSG-AREA DTSCS13 -01717 PERFORM S1351-ERROR THRU S1351-EXIT DTSCS13 -01718 ELSE DTSCS13 -01719 GO TO S1350-EXIT DTSCS13 -01720 ELSE DTSCS13 -01721 IF MAP-PRIMARY-NAME = MAP-ENTITY-NAME DTSCS13 -01722 MOVE MSG-E132-AREA TO WRK-MSG-AREA DTSCS13 -01723 PERFORM S1351-ERROR THRU S1351-EXIT DTSCS13 -01724 GO TO S1350-EXIT. DTSCS13 -01725 DTSCS13 -01726 IF MAP-ENTITY-NAME (1:1) = LOW-VALUES OR SPACES DTSCS13 -01727 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS13 -01728 PERFORM S1351-ERROR THRU S1351-EXIT. DTSCS13 -01729 S1350-EXIT. EXIT. DTSCS13 -01730 DTSCS13 -01731 S1351-ERROR. DTSCS13 -01732 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ENTITY-NAME-A. DTSCS13 -01733 IF LCCM-NO-MSG DTSCS13 -01734 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS13 -01735 MOVE CATB-CURSOR TO MAP-ENTITY-NAME-L DTSCS13 -01736 SET CURSOR-SET-YES TO TRUE. DTSCS13 -01737 S1351-EXIT. EXIT. DTSCS13 -01738 DTSCS13 -01739 DTSCS13 -01740 S1400-FISCAL-AGNT. DTSCS13 -01741 PERFORM S8300-READ-MFAE THRU S8300-EXIT. DTSCS13 +01647 IF L018-NOT-VALID DTSCS13 +01648 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS13 +01649 PERFORM S1101-ERROR THRU S1101-EXIT DTSCS13 +01650 ELSE DTSCS13 +01651 MOVE L018-EMP-NO TO WRK-EMP-NO. DTSCS13 +01652 S1100-EXIT. EXIT. DTSCS13 +01653 SKIP3 DTSCS13 +01654 S1101-ERROR. DTSCS13 +01655 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-EMP-NO-1-A DTSCS13 +01656 MAP-EMP-NO-2-A. DTSCS13 +01657 IF LCCM-NO-MSG DTSCS13 +01658 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS13 +01659 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L DTSCS13 +01660 SET CURSOR-SET-YES TO TRUE. DTSCS13 +01661 S1101-EXIT. EXIT. DTSCS13 +01662 /*****************************************************************DTSCS13 +01663 * *DTSCS13 +01664 ******************************************************************DTSCS13 +01665 S1200-PRIMARY-NAME. DTSCS13 +01666 IF MAP-PRIMARY-NAME = LOW-VALUES OR SPACES DTSCS13 +01667 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS13 +01668 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS13 +01669 ELSE DTSCS13 +01670 IF MAP-PRIMARY-NAME (1:1) = LOW-VALUES OR SPACES DTSCS13 +01671 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS13 +01672 PERFORM S1201-ERROR THRU S1201-EXIT. DTSCS13 +01673 S1200-EXIT. EXIT. DTSCS13 +01674 DTSCS13 +01675 S1201-ERROR. DTSCS13 +01676 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-PRIMARY-NAME-A. DTSCS13 +01677 IF LCCM-NO-MSG DTSCS13 +01678 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS13 +01679 MOVE CATB-CURSOR TO MAP-PRIMARY-NAME-L DTSCS13 +01680 SET CURSOR-SET-YES TO TRUE. DTSCS13 +01681 S1201-EXIT. EXIT. DTSCS13 +01682 /*****************************************************************DTSCS13 +01683 * *DTSCS13 +01684 ******************************************************************DTSCS13 +01685 S1300-ENTITY-IND. DTSCS13 +01686 IF MAP-ENTITY-NAME-IND = LOW-VALUES OR SPACES DTSCS13 +01687 SET MAP-ENTITY-NAME-NO-88 TO TRUE. DTSCS13 +01688 DTSCS13 +01689 IF MAP-ENTITY-NAME-VALID-88 DTSCS13 +01690 NEXT SENTENCE DTSCS13 +01691 ELSE DTSCS13 +01692 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS13 +01693 PERFORM S1301-ERROR THRU S1301-EXIT. DTSCS13 +01694 S1300-EXIT. EXIT. DTSCS13 +01695 DTSCS13 +01696 S1301-ERROR. DTSCS13 +01697 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ENTITY-NAME-IND-A. DTSCS13 +01698 IF LCCM-NO-MSG DTSCS13 +01699 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS13 +01700 MOVE CATB-CURSOR TO MAP-ENTITY-NAME-IND-L DTSCS13 +01701 SET CURSOR-SET-YES TO TRUE. DTSCS13 +01702 S1301-EXIT. EXIT. DTSCS13 +01703 DTSCS13 +01704 /*****************************************************************DTSCS13 +01705 * PRIMARY NAME CAN BE EITHER ENTITY NAME OR TRADE NAME. SETTING *DTSCS13 +01706 * OF ENTITY NAME IND SHOWS WHETHER IT IS THE ENTITY NAME OR NOT.*DTSCS13 +01707 * IF ENTITY NAME IND = YES, DO NOT ALLOW SEPARATE ENTRY OF *DTSCS13 +01708 * ENTITY NAME - IT WILL DUPLICATE PRIMARY NAME ALREADY ENTERED. *DTSCS13 +01709 * *DTSCS13 +01710 * IF ENTITY NAME IND = NO, ENTITY NAME CANNOT EQUAL PRIMARY *DTSCS13 +01711 * NAME. *DTSCS13 +01712 ******************************************************************DTSCS13 +01713 S1350-ENTITY-NAME. DTSCS13 +01714 IF MAP-ENTITY-NAME = LOW-VALUES OR SPACES DTSCS13 +01715 MOVE SPACES TO MAP-ENTITY-NAME DTSCS13 +01716 GO TO S1350-EXIT. DTSCS13 +01717 DTSCS13 +01718 IF MAP-ENTITY-NAME-YES-88 DTSCS13 +01719 IF MAP-ENTITY-NAME > SPACES DTSCS13 +01720 MOVE MSG-E131-AREA TO WRK-MSG-AREA DTSCS13 +01721 PERFORM S1351-ERROR THRU S1351-EXIT DTSCS13 +01722 ELSE DTSCS13 +01723 GO TO S1350-EXIT DTSCS13 +01724 ELSE DTSCS13 +01725 IF MAP-PRIMARY-NAME = MAP-ENTITY-NAME DTSCS13 +01726 MOVE MSG-E132-AREA TO WRK-MSG-AREA DTSCS13 +01727 PERFORM S1351-ERROR THRU S1351-EXIT DTSCS13 +01728 GO TO S1350-EXIT. DTSCS13 +01729 DTSCS13 +01730 IF MAP-ENTITY-NAME (1:1) = LOW-VALUES OR SPACES DTSCS13 +01731 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS13 +01732 PERFORM S1351-ERROR THRU S1351-EXIT. DTSCS13 +01733 S1350-EXIT. EXIT. DTSCS13 +01734 DTSCS13 +01735 S1351-ERROR. DTSCS13 +01736 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ENTITY-NAME-A. DTSCS13 +01737 IF LCCM-NO-MSG DTSCS13 +01738 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS13 +01739 MOVE CATB-CURSOR TO MAP-ENTITY-NAME-L DTSCS13 +01740 SET CURSOR-SET-YES TO TRUE. DTSCS13 +01741 S1351-EXIT. EXIT. DTSCS13 01742 DTSCS13 -01743 IF MAP-FISC-AGNT-CD = SPACES DTSCS13 -01744 OR MAP-FISC-AGNT-CD = LOW-VALUES DTSCS13 -01745 MOVE SPACES TO MAP-FISC-AGNT-CD DTSCS13 -01746 END-IF. DTSCS13 -01747 DTSCS13 -01748 IF WRK-MFAE-NO-88 DTSCS13 -01749 IF MAP-FISC-AGNT-CD = SPACES DTSCS13 -01750 GO TO S1400-EXIT DTSCS13 -01751 ELSE DTSCS13 -01752 PERFORM S1410-ADD-FISCAL-AGENT THRU S1410-EXIT DTSCS13 -01753 END-IF DTSCS13 -01754 ELSE DTSCS13 -01755 PERFORM S1420-CHANGE-FISCAL-AGENT THRU S1420-EXIT DTSCS13 -01756 END-IF. DTSCS13 -01757 DTSCS13 -01758 S1400-EXIT. DTSCS13 -01759 EXIT. DTSCS13 -01760 DTSCS13 -01761 S1410-ADD-FISCAL-AGENT. DTSCS13 -01762 PERFORM S1411-EDIT-FISC-AGNT-CD THRU S1411-EXIT. DTSCS13 -01763 IF WRK-FFIS-NO-88 DTSCS13 -01764 GO TO S1410-EXIT DTSCS13 -01765 ELSE DTSCS13 -01766 PERFORM S1412-SAVE-PHYSICAL-ADDR THRU S1412-EXIT DTSCS13 -01767 PERFORM S1490-UPD-MAP-MAIL-ADDR THRU S1490-EXIT DTSCS13 -01768 END-IF. DTSCS13 -01769 DTSCS13 -01770 S1410-EXIT. DTSCS13 -01771 EXIT. DTSCS13 -01772 DTSCS13 -01773 S1411-EDIT-FISC-AGNT-CD. DTSCS13 -01774 MOVE MAP-FISC-AGNT-CD TO WRK-FISC-AGNT-CD. DTSCS13 -01775 PERFORM S8400-READ-FFIS THRU S8400-EXIT. DTSCS13 +01743 DTSCS13 +01744 S1400-FISCAL-AGNT. DTSCS13 +01745 PERFORM S8300-READ-MFAE THRU S8300-EXIT. DTSCS13 +01746 DTSCS13 +01747 IF MAP-FISC-AGNT-CD = SPACES DTSCS13 +01748 OR MAP-FISC-AGNT-CD = LOW-VALUES DTSCS13 +01749 MOVE SPACES TO MAP-FISC-AGNT-CD DTSCS13 +01750 END-IF. DTSCS13 +01751 DTSCS13 +01752 IF WRK-MFAE-NO-88 DTSCS13 +01753 IF MAP-FISC-AGNT-CD = SPACES DTSCS13 +01754 GO TO S1400-EXIT DTSCS13 +01755 ELSE DTSCS13 +01756 PERFORM S1410-ADD-FISCAL-AGENT THRU S1410-EXIT DTSCS13 +01757 END-IF DTSCS13 +01758 ELSE DTSCS13 +01759 PERFORM S1420-CHANGE-FISCAL-AGENT THRU S1420-EXIT DTSCS13 +01760 END-IF. DTSCS13 +01761 DTSCS13 +01762 S1400-EXIT. DTSCS13 +01763 EXIT. DTSCS13 +01764 DTSCS13 +01765 S1410-ADD-FISCAL-AGENT. DTSCS13 +01766 PERFORM S1411-EDIT-FISC-AGNT-CD THRU S1411-EXIT. DTSCS13 +01767 IF WRK-FFIS-NO-88 DTSCS13 +01768 GO TO S1410-EXIT DTSCS13 +01769 ELSE DTSCS13 +01770 PERFORM S1412-SAVE-PHYSICAL-ADDR THRU S1412-EXIT DTSCS13 +01771 PERFORM S1490-UPD-MAP-MAIL-ADDR THRU S1490-EXIT DTSCS13 +01772 END-IF. DTSCS13 +01773 DTSCS13 +01774 S1410-EXIT. DTSCS13 +01775 EXIT. DTSCS13 01776 DTSCS13 -01777 IF WRK-FFIS-NO-88 DTSCS13 -01778 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS13 -01779 PERFORM S1411A-ERROR THRU S1411A-EXIT DTSCS13 -01780 END-IF. DTSCS13 -01781 DTSCS13 -01782 S1411-EXIT. DTSCS13 -01783 EXIT. DTSCS13 -01784 DTSCS13 -01785 S1411A-ERROR. DTSCS13 -01786 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-FISC-AGNT-CD-A. DTSCS13 -01787 DTSCS13 -01788 IF LCCM-NO-MSG DTSCS13 -01789 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS13 -01790 MOVE CATB-CURSOR TO MAP-FISC-AGNT-CD-L DTSCS13 -01791 SET CURSOR-SET-YES TO TRUE. DTSCS13 -01792 S1411A-EXIT. DTSCS13 -01793 EXIT. DTSCS13 -01794 DTSCS13 -01795 S1412-SAVE-PHYSICAL-ADDR. DTSCS13 -01796 SET WRK-TAD-PHYS-88 TO TRUE. DTSCS13 -01797 PERFORM S1510-IS-MAP-ADDR-BLANK THRU S1510-EXIT. DTSCS13 +01777 S1411-EDIT-FISC-AGNT-CD. DTSCS13 +01778 MOVE MAP-FISC-AGNT-CD TO WRK-FISC-AGNT-CD. DTSCS13 +01779 PERFORM S8400-READ-FFIS THRU S8400-EXIT. DTSCS13 +01780 DTSCS13 +01781 IF WRK-FFIS-NO-88 DTSCS13 +01782 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS13 +01783 PERFORM S1411A-ERROR THRU S1411A-EXIT DTSCS13 +01784 END-IF. DTSCS13 +01785 DTSCS13 +01786 S1411-EXIT. DTSCS13 +01787 EXIT. DTSCS13 +01788 DTSCS13 +01789 S1411A-ERROR. DTSCS13 +01790 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-FISC-AGNT-CD-A. DTSCS13 +01791 DTSCS13 +01792 IF LCCM-NO-MSG DTSCS13 +01793 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS13 +01794 MOVE CATB-CURSOR TO MAP-FISC-AGNT-CD-L DTSCS13 +01795 SET CURSOR-SET-YES TO TRUE. DTSCS13 +01796 S1411A-EXIT. DTSCS13 +01797 EXIT. DTSCS13 01798 DTSCS13 -01799 IF WRK-MAP-ADDR-BLANK (WRK-TAD) DTSCS13 -01800 SET WRK-TAD-MAIL-88 TO TRUE DTSCS13 -01801 PERFORM S8200-READ-MTAD THRU S8200-EXIT DTSCS13 -01802 IF L810-OK-88 DTSCS13 -01803 MOVE MSKL-REC TO MTAD-REC DTSCS13 -01804 IF MTAD-ST = 'DC' DTSCS13 -01805 PERFORM S1413-MOVE-TO-MAP THRU S1413-EXIT DTSCS13 -01806 END-IF DTSCS13 -01807 END-IF DTSCS13 -01808 END-IF. DTSCS13 -01809 DTSCS13 -01810 S1412-EXIT. DTSCS13 -01811 EXIT. DTSCS13 -01812 DTSCS13 -01813 S1413-MOVE-TO-MAP. DTSCS13 -01814 SET WRK-TAD-PHYS-88 TO TRUE. DTSCS13 -01815 DTSCS13 -01816 MOVE MTAD-ATTN-LINE TO MAP-ATTN (WRK-TAD). DTSCS13 -01817 MOVE MTAD-DELIV-LINE-1 TO MAP-DLV1 (WRK-TAD). DTSCS13 -01818 MOVE MTAD-DELIV-LINE-2 TO MAP-DLV2 (WRK-TAD). DTSCS13 -01819 MOVE MTAD-CITY TO MAP-CITY (WRK-TAD). DTSCS13 -01820 MOVE MTAD-ST TO MAP-STAT (WRK-TAD). DTSCS13 -01821 MOVE MTAD-ZIP TO MAP-ZIPC (WRK-TAD). DTSCS13 -01822 IF MTAD-PHONE-NUMBERS NOT = SPACE DTSCS13 -01823 MOVE MTAD-VOICE-1-AREA-CD TO MAP-PHONE-A-CD (WRK-TAD, 1) DTSCS13 -01824 MOVE MTAD-VOICE-1-PREFIX TO MAP-PHONE-PREF (WRK-TAD, 1) DTSCS13 -01825 MOVE MTAD-VOICE-1-SUFFIX TO MAP-PHONE-SUFF (WRK-TAD, 1) DTSCS13 -01826 MOVE MTAD-VOICE-1-EXT TO MAP-PHONE-EXT (WRK-TAD, 1) DTSCS13 -01827 MOVE MTAD-VOICE-2-AREA-CD TO MAP-PHONE-A-CD (WRK-TAD, 2) DTSCS13 -01828 MOVE MTAD-VOICE-2-PREFIX TO MAP-PHONE-PREF (WRK-TAD, 2) DTSCS13 -01829 MOVE MTAD-VOICE-2-SUFFIX TO MAP-PHONE-SUFF (WRK-TAD, 2) DTSCS13 -01830 MOVE MTAD-VOICE-2-EXT TO MAP-PHONE-EXT (WRK-TAD, 2) DTSCS13 -01831 MOVE MTAD-FAX-AREA-CD TO MAP-PHONE-A-CD (WRK-TAD, 3) DTSCS13 -01832 MOVE MTAD-FAX-PREFIX TO MAP-PHONE-PREF (WRK-TAD, 3) DTSCS13 -01833 MOVE MTAD-FAX-SUFFIX TO MAP-PHONE-SUFF (WRK-TAD, 3) DTSCS13 -01834 MOVE MTAD-FAX-EXT TO MAP-PHONE-EXT (WRK-TAD, 3). DTSCS13 -01835 DTSCS13 -01836 MOVE MTAD-EMAIL-ADDRESS TO MAP-EMAIL(WRK-TAD). DTSCS13 -01837 MOVE 'N' TO MAP-MEMO(WRK-TAD) DTSCS13 -01838 MAP-MISS(WRK-TAD). DTSCS13 -01839 MOVE MTAD-PHYSICAL-ADDRESS-IND TO MAP-ADDR(WRK-TAD). DTSCS13 -01840 DTSCS13 -01841 S1413-EXIT. DTSCS13 -01842 EXIT. DTSCS13 -01843 DTSCS13 -01844 S1420-CHANGE-FISCAL-AGENT. DTSCS13 -01845 IF MFAE-FISCAL-AGENT-CD = MAP-FISC-AGNT-CD DTSCS13 -01846 PERFORM S1421-SAME-AGNT-EDITS THRU S1421-EXIT DTSCS13 -01847 ELSE DTSCS13 -01848 IF MAP-FISC-AGNT-CD = SPACES DTSCS13 -01849 PERFORM S1422-DELETED-AGNT-EDITS THRU S1422-EXIT DTSCS13 -01850 ELSE DTSCS13 -01851 PERFORM S1411-EDIT-FISC-AGNT-CD THRU S1411-EXIT DTSCS13 -01852 IF WRK-FFIS-NO-88 DTSCS13 -01853 GO TO S1420-EXIT DTSCS13 -01854 ELSE DTSCS13 -01855 PERFORM S1490-UPD-MAP-MAIL-ADDR THRU S1490-EXIT DTSCS13 -01856 END-IF DTSCS13 -01857 END-IF DTSCS13 -01858 END-IF. DTSCS13 -01859 DTSCS13 -01860 S1420-EXIT. DTSCS13 -01861 EXIT. DTSCS13 -01862 DTSCS13 -01863 S1421-SAME-AGNT-EDITS. DTSCS13 -01864 MOVE MFAE-FISCAL-AGENT-CD TO WRK-FISC-AGNT-CD DTSCS13 -01865 PERFORM S8400-READ-FFIS THRU S8400-EXIT DTSCS13 -01866 IF WRK-FFIS-NO-88 DTSCS13 -01867 GO TO S1421-EXIT. DTSCS13 -01868 DTSCS13 -01869 SET WRK-TAD-MAIL-88 TO TRUE. DTSCS13 -01870 DTSCS13 -01871 IF MAP-ATTN (WRK-TAD) = SPACES OR LOW-VALUES DTSCS13 -01872 MOVE SPACES TO MAP-ATTN (WRK-TAD). DTSCS13 -01873 DTSCS13 -01874 IF MAP-DLV1 (WRK-TAD) = SPACES OR LOW-VALUES DTSCS13 -01875 MOVE SPACES TO MAP-DLV1 (WRK-TAD). DTSCS13 -01876 DTSCS13 -01877 IF MAP-DLV2 (WRK-TAD) = SPACES OR LOW-VALUES DTSCS13 -01878 MOVE SPACES TO MAP-DLV2 (WRK-TAD). DTSCS13 -01879 DTSCS13 -01880 IF MAP-CITY (WRK-TAD) = SPACES OR LOW-VALUES DTSCS13 -01881 MOVE SPACES TO MAP-CITY (WRK-TAD). DTSCS13 -01882 DTSCS13 -01883 IF MAP-STAT (WRK-TAD) = SPACES OR LOW-VALUES DTSCS13 -01884 MOVE SPACES TO MAP-STAT (WRK-TAD). DTSCS13 -01885 DTSCS13 -01886 IF MAP-ATTN (WRK-TAD) NOT = FFIS-ATTN-LINE DTSCS13 -01887 OR MAP-DLV1 (WRK-TAD) NOT = FFIS-DELIV-LINE-1 DTSCS13 -01888 OR MAP-DLV2 (WRK-TAD) NOT = FFIS-DELIV-LINE-2 DTSCS13 -01889 OR MAP-CITY (WRK-TAD) NOT = FFIS-CITY DTSCS13 -01890 OR MAP-STAT (WRK-TAD) NOT = FFIS-ST DTSCS13 -01891 *** OR MAP-ZIPC (WRK-TAD) NOT = FFIS-ZIP DTSCS13 -01892 MOVE MSG-E133-AREA TO WRK-MSG-AREA DTSCS13 -01893 PERFORM S1421A-ERROR THRU S1421A-EXIT DTSCS13 -01894 END-IF. DTSCS13 -01895 DTSCS13 -01896 S1421-EXIT. DTSCS13 -01897 EXIT. DTSCS13 -01898 DTSCS13 -01899 S1421A-ERROR. DTSCS13 -01900 SET WRK-TAD-MAIL-88 TO TRUE. DTSCS13 -01901 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-DLV2-A (WRK-TAD). DTSCS13 -01902 IF LCCM-NO-MSG DTSCS13 -01903 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS13 -01904 MOVE CATB-CURSOR TO MAP-DLV2-L (WRK-TAD) DTSCS13 -01905 SET CURSOR-SET-YES TO TRUE. DTSCS13 -01906 S1421A-EXIT. DTSCS13 -01907 EXIT. DTSCS13 -01908 DTSCS13 -01909 S1422-DELETED-AGNT-EDITS. DTSCS13 -01910 MOVE MFAE-FISCAL-AGENT-CD TO WRK-FISC-AGNT-CD. DTSCS13 -01911 PERFORM S8400-READ-FFIS THRU S8400-EXIT. DTSCS13 -01912 IF WRK-FFIS-NO-88 DTSCS13 -01913 GO TO S1422-EXIT. DTSCS13 -01914 DTSCS13 -01915 SET WRK-TAD-MAIL-88 TO TRUE. DTSCS13 -01916 DTSCS13 -01917 IF MAP-ATTN (WRK-TAD) = SPACES OR LOW-VALUES DTSCS13 -01918 MOVE SPACES TO MAP-ATTN (WRK-TAD). DTSCS13 -01919 DTSCS13 -01920 IF MAP-DLV1 (WRK-TAD) = SPACES OR LOW-VALUES DTSCS13 -01921 MOVE SPACES TO MAP-DLV1 (WRK-TAD). DTSCS13 -01922 DTSCS13 -01923 IF MAP-DLV2 (WRK-TAD) = SPACES OR LOW-VALUES DTSCS13 -01924 MOVE SPACES TO MAP-DLV2 (WRK-TAD). DTSCS13 -01925 DTSCS13 -01926 IF MAP-CITY (WRK-TAD) = SPACES OR LOW-VALUES DTSCS13 -01927 MOVE SPACES TO MAP-CITY (WRK-TAD). DTSCS13 -01928 DTSCS13 -01929 IF MAP-STAT (WRK-TAD) = SPACES OR LOW-VALUES DTSCS13 -01930 MOVE SPACES TO MAP-STAT (WRK-TAD). DTSCS13 -01931 DTSCS13 -01932 IF MAP-ATTN (WRK-TAD) = FFIS-ATTN-LINE DTSCS13 -01933 AND MAP-DLV1 (WRK-TAD) = FFIS-DELIV-LINE-1 DTSCS13 -01934 AND MAP-DLV2 (WRK-TAD) = FFIS-DELIV-LINE-2 DTSCS13 -01935 AND MAP-CITY (WRK-TAD) = FFIS-CITY DTSCS13 -01936 AND MAP-STAT (WRK-TAD) = FFIS-ST DTSCS13 -01937 *** AND MAP-ZIPC (WRK-TAD) = FFIS-ZIP DTSCS13 -01938 SET WRK-TAD-PHYS-88 TO TRUE DTSCS13 -01939 PERFORM S1510-IS-MAP-ADDR-BLANK THRU S1510-EXIT DTSCS13 -01940 IF WRK-MAP-ADDR-HAS-DATA (WRK-TAD) DTSCS13 -01941 MOVE MAP-ATTN (2) TO MAP-ATTN (1) DTSCS13 -01942 MOVE MAP-DLV1 (2) TO MAP-DLV1 (1) DTSCS13 -01943 MOVE MAP-DLV2 (2) TO MAP-DLV2 (1) DTSCS13 -01944 MOVE MAP-CITY (2) TO MAP-CITY (1) DTSCS13 -01945 MOVE MAP-STAT (2) TO MAP-STAT (1) DTSCS13 -01946 MOVE MAP-ZIPC (2) TO MAP-ZIPC (1) DTSCS13 -01947 MOVE MAP-PHONE-A-CD (2, 1) TO MAP-PHONE-A-CD (1, 1) DTSCS13 -01948 MOVE MAP-PHONE-PREF (2, 1) TO MAP-PHONE-PREF (1, 1) DTSCS13 -01949 MOVE MAP-PHONE-SUFF (2, 1) TO MAP-PHONE-SUFF (1, 1) DTSCS13 -01950 MOVE MAP-PHONE-EXT (2, 1) TO MAP-PHONE-EXT (1, 1) DTSCS13 -01951 MOVE 'Y' TO MAP-MEMO (1) DTSCS13 -01952 MAP-MISS (1) DTSCS13 -01953 MAP-ADDR (1) DTSCS13 -01954 MOVE SPACES TO MAP-ATTN (2) DTSCS13 -01955 MAP-DLV1 (2) DTSCS13 -01956 MAP-DLV2 (2) DTSCS13 -01957 MAP-CITY (2) DTSCS13 -01958 MAP-STAT (2) DTSCS13 -01959 MAP-ZIPC (2) DTSCS13 -01960 MAP-PHONE-A-CD (2, 1) DTSCS13 -01961 MAP-PHONE-PREF (2, 1) DTSCS13 -01962 MAP-PHONE-SUFF (2, 1) DTSCS13 -01963 MAP-PHONE-EXT (2, 1) DTSCS13 -01964 MAP-MEMO (2) DTSCS13 -01965 MAP-MISS (2) DTSCS13 -01966 MAP-ADDR (2) DTSCS13 -01967 ELSE DTSCS13 -01968 MOVE MSG-E134-AREA TO WRK-MSG-AREA DTSCS13 -01969 PERFORM S1422A-ERROR THRU S1422A-EXIT DTSCS13 -01970 END-IF DTSCS13 -01971 END-IF. DTSCS13 -01972 DTSCS13 -01973 SET WRK-TAD-MAIL-88 TO TRUE. DTSCS13 -01974 IF (MAP-ATTN (WRK-TAD) = FFIS-ATTN-LINE) DTSCS13 -01975 OR (MAP-DLV2 (WRK-TAD) = FFIS-DELIV-LINE-2 DTSCS13 -01976 AND MAP-CITY (WRK-TAD) = FFIS-CITY) DTSCS13 -01977 MOVE MSG-E134-AREA TO WRK-MSG-AREA DTSCS13 -01978 PERFORM S1422A-ERROR THRU S1422A-EXIT DTSCS13 -01979 GO TO S1422-EXIT DTSCS13 -01980 ELSE DTSCS13 -01981 IF (MAP-PHONE-A-CD (WRK-TAD, 1) = DTSCS13 -01982 FFIS-BUSINESS-VOICE-AREA-CD DTSCS13 -01983 AND MAP-PHONE-PREF (WRK-TAD, 1) = DTSCS13 -01984 FFIS-BUSINESS-VOICE-PREFIX DTSCS13 -01985 AND MAP-PHONE-SUFF (WRK-TAD, 1) = DTSCS13 -01986 FFIS-BUSINESS-VOICE-SUFFIX) DTSCS13 -01987 MOVE MSG-E135-AREA TO WRK-MSG-AREA DTSCS13 -01988 PERFORM S1422B-ERROR THRU S1422B-EXIT DTSCS13 -01989 GO TO S1422-EXIT DTSCS13 -01990 END-IF DTSCS13 -01991 END-IF. DTSCS13 -01992 DTSCS13 -01993 S1422-EXIT. DTSCS13 -01994 EXIT. DTSCS13 -01995 DTSCS13 -01996 S1422A-ERROR. DTSCS13 -01997 SET WRK-TAD-MAIL-88 TO TRUE. DTSCS13 -01998 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-DLV2-A (WRK-TAD). DTSCS13 -01999 IF LCCM-NO-MSG DTSCS13 -02000 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS13 -02001 MOVE CATB-CURSOR TO MAP-DLV2-L (WRK-TAD) DTSCS13 -02002 SET CURSOR-SET-YES TO TRUE. DTSCS13 -02003 S1422A-EXIT. DTSCS13 -02004 EXIT. DTSCS13 -02005 DTSCS13 -02006 S1422B-ERROR. DTSCS13 -02007 SET WRK-TAD-MAIL-88 TO TRUE. DTSCS13 -02008 MOVE CATB-UNPROT-NORM-NUM-MDTON DTSCS13 -02009 TO MAP-PHONE-A-CD-A (WRK-TAD, 1) DTSCS13 -02010 MAP-PHONE-PREF-A (WRK-TAD, 1) DTSCS13 -02011 MAP-PHONE-SUFF-A (WRK-TAD, 1) DTSCS13 -02012 MAP-PHONE-EXT-A (WRK-TAD, 1). DTSCS13 -02013 IF LCCM-NO-MSG DTSCS13 -02014 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS13 -02015 MOVE CATB-CURSOR TO MAP-PHONE-A-CD-L (WRK-TAD, 1) DTSCS13 -02016 SET CURSOR-SET-YES TO TRUE. DTSCS13 -02017 S1422B-EXIT. DTSCS13 -02018 EXIT. DTSCS13 -02019 DTSCS13 -02020 S1490-UPD-MAP-MAIL-ADDR. DTSCS13 -02021 SET WRK-TAD-MAIL-88 TO TRUE. DTSCS13 -02022 DTSCS13 -02023 MOVE FFIS-ATTN-LINE TO MAP-ATTN (WRK-TAD). DTSCS13 -02024 MOVE FFIS-DELIV-LINE-1 TO MAP-DLV1 (WRK-TAD). DTSCS13 -02025 MOVE FFIS-DELIV-LINE-2 TO MAP-DLV2 (WRK-TAD). DTSCS13 -02026 MOVE FFIS-CITY TO MAP-CITY (WRK-TAD). DTSCS13 -02027 MOVE FFIS-ST TO MAP-STAT (WRK-TAD). DTSCS13 -02028 MOVE FFIS-ZIP TO MAP-ZIPC (WRK-TAD). DTSCS13 -02029 DTSCS13 -02030 IF FFIS-BUSINESS-VOICE NOT = SPACES DTSCS13 -02031 MOVE FFIS-BUSINESS-VOICE-AREA-CD TO DTSCS13 -02032 MAP-PHONE-A-CD (WRK-TAD, 1) DTSCS13 -02033 MOVE FFIS-BUSINESS-VOICE-PREFIX TO DTSCS13 -02034 MAP-PHONE-PREF (WRK-TAD, 1) DTSCS13 -02035 MOVE FFIS-BUSINESS-VOICE-SUFFIX TO DTSCS13 -02036 MAP-PHONE-SUFF (WRK-TAD, 1) DTSCS13 -02037 MOVE FFIS-BUSINESS-VOICE-EXT TO DTSCS13 -02038 MAP-PHONE-EXT (WRK-TAD, 1) DTSCS13 -02039 END-IF. DTSCS13 -02040 DTSCS13 -02041 MOVE 'Y' TO MAP-MEMO (WRK-TAD) DTSCS13 -02042 MAP-MISS (WRK-TAD). DTSCS13 -02043 MOVE 'N' TO MAP-ADDR (WRK-TAD). DTSCS13 +01799 S1412-SAVE-PHYSICAL-ADDR. DTSCS13 +01800 SET WRK-TAD-PHYS-88 TO TRUE. DTSCS13 +01801 PERFORM S1510-IS-MAP-ADDR-BLANK THRU S1510-EXIT. DTSCS13 +01802 DTSCS13 +01803 IF WRK-MAP-ADDR-BLANK (WRK-TAD) DTSCS13 +01804 SET WRK-TAD-MAIL-88 TO TRUE DTSCS13 +01805 PERFORM S8200-READ-MTAD THRU S8200-EXIT DTSCS13 +01806 IF L810-OK-88 DTSCS13 +01807 MOVE MSKL-REC TO MTAD-REC DTSCS13 +01808 IF MTAD-ST = 'DC' DTSCS13 +01809 PERFORM S1413-MOVE-TO-MAP THRU S1413-EXIT DTSCS13 +01810 END-IF DTSCS13 +01811 END-IF DTSCS13 +01812 END-IF. DTSCS13 +01813 DTSCS13 +01814 S1412-EXIT. DTSCS13 +01815 EXIT. DTSCS13 +01816 DTSCS13 +01817 S1413-MOVE-TO-MAP. DTSCS13 +01818 SET WRK-TAD-PHYS-88 TO TRUE. DTSCS13 +01819 DTSCS13 +01820 MOVE MTAD-ATTN-LINE TO MAP-ATTN (WRK-TAD). DTSCS13 +01821 MOVE MTAD-DELIV-LINE-1 TO MAP-DLV1 (WRK-TAD). DTSCS13 +01822 MOVE MTAD-DELIV-LINE-2 TO MAP-DLV2 (WRK-TAD). DTSCS13 +01823 MOVE MTAD-CITY TO MAP-CITY (WRK-TAD). DTSCS13 +01824 MOVE MTAD-ST TO MAP-STAT (WRK-TAD). DTSCS13 +01825 MOVE MTAD-ZIP TO MAP-ZIPC (WRK-TAD). DTSCS13 +01826 IF MTAD-PHONE-NUMBERS NOT = SPACE DTSCS13 +01827 MOVE MTAD-VOICE-1-AREA-CD TO MAP-PHONE-A-CD (WRK-TAD, 1) DTSCS13 +01828 MOVE MTAD-VOICE-1-PREFIX TO MAP-PHONE-PREF (WRK-TAD, 1) DTSCS13 +01829 MOVE MTAD-VOICE-1-SUFFIX TO MAP-PHONE-SUFF (WRK-TAD, 1) DTSCS13 +01830 MOVE MTAD-VOICE-1-EXT TO MAP-PHONE-EXT (WRK-TAD, 1) DTSCS13 +01831 MOVE MTAD-VOICE-2-AREA-CD TO MAP-PHONE-A-CD (WRK-TAD, 2) DTSCS13 +01832 MOVE MTAD-VOICE-2-PREFIX TO MAP-PHONE-PREF (WRK-TAD, 2) DTSCS13 +01833 MOVE MTAD-VOICE-2-SUFFIX TO MAP-PHONE-SUFF (WRK-TAD, 2) DTSCS13 +01834 MOVE MTAD-VOICE-2-EXT TO MAP-PHONE-EXT (WRK-TAD, 2) DTSCS13 +01835 MOVE MTAD-FAX-AREA-CD TO MAP-PHONE-A-CD (WRK-TAD, 3) DTSCS13 +01836 MOVE MTAD-FAX-PREFIX TO MAP-PHONE-PREF (WRK-TAD, 3) DTSCS13 +01837 MOVE MTAD-FAX-SUFFIX TO MAP-PHONE-SUFF (WRK-TAD, 3) DTSCS13 +01838 MOVE MTAD-FAX-EXT TO MAP-PHONE-EXT (WRK-TAD, 3). DTSCS13 +01839 DTSCS13 +01840 MOVE MTAD-EMAIL-ADDRESS TO MAP-EMAIL(WRK-TAD). DTSCS13 +01841 MOVE 'N' TO MAP-MEMO(WRK-TAD) DTSCS13 +01842 MAP-MISS(WRK-TAD). DTSCS13 +01843 MOVE MTAD-PHYSICAL-ADDRESS-IND TO MAP-ADDR(WRK-TAD). DTSCS13 +01844 DTSCS13 +01845 S1413-EXIT. DTSCS13 +01846 EXIT. DTSCS13 +01847 DTSCS13 +01848 S1420-CHANGE-FISCAL-AGENT. DTSCS13 +01849 IF MFAE-FISCAL-AGENT-CD = MAP-FISC-AGNT-CD DTSCS13 +01850 PERFORM S1421-SAME-AGNT-EDITS THRU S1421-EXIT DTSCS13 +01851 ELSE DTSCS13 +01852 IF MAP-FISC-AGNT-CD = SPACES DTSCS13 +01853 PERFORM S1422-DELETED-AGNT-EDITS THRU S1422-EXIT DTSCS13 +01854 ELSE DTSCS13 +01855 PERFORM S1411-EDIT-FISC-AGNT-CD THRU S1411-EXIT DTSCS13 +01856 IF WRK-FFIS-NO-88 DTSCS13 +01857 GO TO S1420-EXIT DTSCS13 +01858 ELSE DTSCS13 +01859 PERFORM S1490-UPD-MAP-MAIL-ADDR THRU S1490-EXIT DTSCS13 +01860 END-IF DTSCS13 +01861 END-IF DTSCS13 +01862 END-IF. DTSCS13 +01863 DTSCS13 +01864 S1420-EXIT. DTSCS13 +01865 EXIT. DTSCS13 +01866 DTSCS13 +01867 S1421-SAME-AGNT-EDITS. DTSCS13 +01868 MOVE MFAE-FISCAL-AGENT-CD TO WRK-FISC-AGNT-CD DTSCS13 +01869 PERFORM S8400-READ-FFIS THRU S8400-EXIT DTSCS13 +01870 IF WRK-FFIS-NO-88 DTSCS13 +01871 GO TO S1421-EXIT. DTSCS13 +01872 DTSCS13 +01873 SET WRK-TAD-MAIL-88 TO TRUE. DTSCS13 +01874 DTSCS13 +01875 IF MAP-ATTN (WRK-TAD) = SPACES OR LOW-VALUES DTSCS13 +01876 MOVE SPACES TO MAP-ATTN (WRK-TAD). DTSCS13 +01877 DTSCS13 +01878 IF MAP-DLV1 (WRK-TAD) = SPACES OR LOW-VALUES DTSCS13 +01879 MOVE SPACES TO MAP-DLV1 (WRK-TAD). DTSCS13 +01880 DTSCS13 +01881 IF MAP-DLV2 (WRK-TAD) = SPACES OR LOW-VALUES DTSCS13 +01882 MOVE SPACES TO MAP-DLV2 (WRK-TAD). DTSCS13 +01883 DTSCS13 +01884 IF MAP-CITY (WRK-TAD) = SPACES OR LOW-VALUES DTSCS13 +01885 MOVE SPACES TO MAP-CITY (WRK-TAD). DTSCS13 +01886 DTSCS13 +01887 IF MAP-STAT (WRK-TAD) = SPACES OR LOW-VALUES DTSCS13 +01888 MOVE SPACES TO MAP-STAT (WRK-TAD). DTSCS13 +01889 DTSCS13 +01890 IF MAP-ATTN (WRK-TAD) NOT = FFIS-ATTN-LINE DTSCS13 +01891 OR MAP-DLV1 (WRK-TAD) NOT = FFIS-DELIV-LINE-1 DTSCS13 +01892 OR MAP-DLV2 (WRK-TAD) NOT = FFIS-DELIV-LINE-2 DTSCS13 +01893 OR MAP-CITY (WRK-TAD) NOT = FFIS-CITY DTSCS13 +01894 OR MAP-STAT (WRK-TAD) NOT = FFIS-ST DTSCS13 +01895 *** OR MAP-ZIPC (WRK-TAD) NOT = FFIS-ZIP DTSCS13 +01896 MOVE MSG-E133-AREA TO WRK-MSG-AREA DTSCS13 +01897 PERFORM S1421A-ERROR THRU S1421A-EXIT DTSCS13 +01898 END-IF. DTSCS13 +01899 DTSCS13 +01900 S1421-EXIT. DTSCS13 +01901 EXIT. DTSCS13 +01902 DTSCS13 +01903 S1421A-ERROR. DTSCS13 +01904 SET WRK-TAD-MAIL-88 TO TRUE. DTSCS13 +01905 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-DLV2-A (WRK-TAD). DTSCS13 +01906 IF LCCM-NO-MSG DTSCS13 +01907 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS13 +01908 MOVE CATB-CURSOR TO MAP-DLV2-L (WRK-TAD) DTSCS13 +01909 SET CURSOR-SET-YES TO TRUE. DTSCS13 +01910 S1421A-EXIT. DTSCS13 +01911 EXIT. DTSCS13 +01912 DTSCS13 +01913 S1422-DELETED-AGNT-EDITS. DTSCS13 +01914 MOVE MFAE-FISCAL-AGENT-CD TO WRK-FISC-AGNT-CD. DTSCS13 +01915 PERFORM S8400-READ-FFIS THRU S8400-EXIT. DTSCS13 +01916 IF WRK-FFIS-NO-88 DTSCS13 +01917 GO TO S1422-EXIT. DTSCS13 +01918 DTSCS13 +01919 SET WRK-TAD-MAIL-88 TO TRUE. DTSCS13 +01920 DTSCS13 +01921 IF MAP-ATTN (WRK-TAD) = SPACES OR LOW-VALUES DTSCS13 +01922 MOVE SPACES TO MAP-ATTN (WRK-TAD). DTSCS13 +01923 DTSCS13 +01924 IF MAP-DLV1 (WRK-TAD) = SPACES OR LOW-VALUES DTSCS13 +01925 MOVE SPACES TO MAP-DLV1 (WRK-TAD). DTSCS13 +01926 DTSCS13 +01927 IF MAP-DLV2 (WRK-TAD) = SPACES OR LOW-VALUES DTSCS13 +01928 MOVE SPACES TO MAP-DLV2 (WRK-TAD). DTSCS13 +01929 DTSCS13 +01930 IF MAP-CITY (WRK-TAD) = SPACES OR LOW-VALUES DTSCS13 +01931 MOVE SPACES TO MAP-CITY (WRK-TAD). DTSCS13 +01932 DTSCS13 +01933 IF MAP-STAT (WRK-TAD) = SPACES OR LOW-VALUES DTSCS13 +01934 MOVE SPACES TO MAP-STAT (WRK-TAD). DTSCS13 +01935 DTSCS13 +01936 IF MAP-ATTN (WRK-TAD) = FFIS-ATTN-LINE DTSCS13 +01937 AND MAP-DLV1 (WRK-TAD) = FFIS-DELIV-LINE-1 DTSCS13 +01938 AND MAP-DLV2 (WRK-TAD) = FFIS-DELIV-LINE-2 DTSCS13 +01939 AND MAP-CITY (WRK-TAD) = FFIS-CITY DTSCS13 +01940 AND MAP-STAT (WRK-TAD) = FFIS-ST DTSCS13 +01941 *** AND MAP-ZIPC (WRK-TAD) = FFIS-ZIP DTSCS13 +01942 SET WRK-TAD-PHYS-88 TO TRUE DTSCS13 +01943 PERFORM S1510-IS-MAP-ADDR-BLANK THRU S1510-EXIT DTSCS13 +01944 IF WRK-MAP-ADDR-HAS-DATA (WRK-TAD) DTSCS13 +01945 MOVE MAP-ATTN (2) TO MAP-ATTN (1) DTSCS13 +01946 MOVE MAP-DLV1 (2) TO MAP-DLV1 (1) DTSCS13 +01947 MOVE MAP-DLV2 (2) TO MAP-DLV2 (1) DTSCS13 +01948 MOVE MAP-CITY (2) TO MAP-CITY (1) DTSCS13 +01949 MOVE MAP-STAT (2) TO MAP-STAT (1) DTSCS13 +01950 MOVE MAP-ZIPC (2) TO MAP-ZIPC (1) DTSCS13 +01951 MOVE MAP-PHONE-A-CD (2, 1) TO MAP-PHONE-A-CD (1, 1) DTSCS13 +01952 MOVE MAP-PHONE-PREF (2, 1) TO MAP-PHONE-PREF (1, 1) DTSCS13 +01953 MOVE MAP-PHONE-SUFF (2, 1) TO MAP-PHONE-SUFF (1, 1) DTSCS13 +01954 MOVE MAP-PHONE-EXT (2, 1) TO MAP-PHONE-EXT (1, 1) DTSCS13 +01955 MOVE 'Y' TO MAP-MEMO (1) DTSCS13 +01956 MAP-MISS (1) DTSCS13 +01957 MAP-ADDR (1) DTSCS13 +01958 MOVE SPACES TO MAP-ATTN (2) DTSCS13 +01959 MAP-DLV1 (2) DTSCS13 +01960 MAP-DLV2 (2) DTSCS13 +01961 MAP-CITY (2) DTSCS13 +01962 MAP-STAT (2) DTSCS13 +01963 MAP-ZIPC (2) DTSCS13 +01964 MAP-PHONE-A-CD (2, 1) DTSCS13 +01965 MAP-PHONE-PREF (2, 1) DTSCS13 +01966 MAP-PHONE-SUFF (2, 1) DTSCS13 +01967 MAP-PHONE-EXT (2, 1) DTSCS13 +01968 MAP-MEMO (2) DTSCS13 +01969 MAP-MISS (2) DTSCS13 +01970 MAP-ADDR (2) DTSCS13 +01971 ELSE DTSCS13 +01972 MOVE MSG-E134-AREA TO WRK-MSG-AREA DTSCS13 +01973 PERFORM S1422A-ERROR THRU S1422A-EXIT DTSCS13 +01974 END-IF DTSCS13 +01975 END-IF. DTSCS13 +01976 DTSCS13 +01977 SET WRK-TAD-MAIL-88 TO TRUE. DTSCS13 +01978 IF (MAP-ATTN (WRK-TAD) = FFIS-ATTN-LINE) DTSCS13 +01979 OR (MAP-DLV2 (WRK-TAD) = FFIS-DELIV-LINE-2 DTSCS13 +01980 AND MAP-CITY (WRK-TAD) = FFIS-CITY) DTSCS13 +01981 MOVE MSG-E134-AREA TO WRK-MSG-AREA DTSCS13 +01982 PERFORM S1422A-ERROR THRU S1422A-EXIT DTSCS13 +01983 GO TO S1422-EXIT DTSCS13 +01984 ELSE DTSCS13 +01985 IF (MAP-PHONE-A-CD (WRK-TAD, 1) = DTSCS13 +01986 FFIS-BUSINESS-VOICE-AREA-CD DTSCS13 +01987 AND MAP-PHONE-PREF (WRK-TAD, 1) = DTSCS13 +01988 FFIS-BUSINESS-VOICE-PREFIX DTSCS13 +01989 AND MAP-PHONE-SUFF (WRK-TAD, 1) = DTSCS13 +01990 FFIS-BUSINESS-VOICE-SUFFIX) DTSCS13 +01991 MOVE MSG-E135-AREA TO WRK-MSG-AREA DTSCS13 +01992 PERFORM S1422B-ERROR THRU S1422B-EXIT DTSCS13 +01993 GO TO S1422-EXIT DTSCS13 +01994 END-IF DTSCS13 +01995 END-IF. DTSCS13 +01996 DTSCS13 +01997 S1422-EXIT. DTSCS13 +01998 EXIT. DTSCS13 +01999 DTSCS13 +02000 S1422A-ERROR. DTSCS13 +02001 SET WRK-TAD-MAIL-88 TO TRUE. DTSCS13 +02002 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-DLV2-A (WRK-TAD). DTSCS13 +02003 IF LCCM-NO-MSG DTSCS13 +02004 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS13 +02005 MOVE CATB-CURSOR TO MAP-DLV2-L (WRK-TAD) DTSCS13 +02006 SET CURSOR-SET-YES TO TRUE. DTSCS13 +02007 S1422A-EXIT. DTSCS13 +02008 EXIT. DTSCS13 +02009 DTSCS13 +02010 S1422B-ERROR. DTSCS13 +02011 SET WRK-TAD-MAIL-88 TO TRUE. DTSCS13 +02012 MOVE CATB-UNPROT-NORM-NUM-MDTON DTSCS13 +02013 TO MAP-PHONE-A-CD-A (WRK-TAD, 1) DTSCS13 +02014 MAP-PHONE-PREF-A (WRK-TAD, 1) DTSCS13 +02015 MAP-PHONE-SUFF-A (WRK-TAD, 1) DTSCS13 +02016 MAP-PHONE-EXT-A (WRK-TAD, 1). DTSCS13 +02017 IF LCCM-NO-MSG DTSCS13 +02018 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS13 +02019 MOVE CATB-CURSOR TO MAP-PHONE-A-CD-L (WRK-TAD, 1) DTSCS13 +02020 SET CURSOR-SET-YES TO TRUE. DTSCS13 +02021 S1422B-EXIT. DTSCS13 +02022 EXIT. DTSCS13 +02023 DTSCS13 +02024 S1490-UPD-MAP-MAIL-ADDR. DTSCS13 +02025 SET WRK-TAD-MAIL-88 TO TRUE. DTSCS13 +02026 DTSCS13 +02027 MOVE FFIS-ATTN-LINE TO MAP-ATTN (WRK-TAD). DTSCS13 +02028 MOVE FFIS-DELIV-LINE-1 TO MAP-DLV1 (WRK-TAD). DTSCS13 +02029 MOVE FFIS-DELIV-LINE-2 TO MAP-DLV2 (WRK-TAD). DTSCS13 +02030 MOVE FFIS-CITY TO MAP-CITY (WRK-TAD). DTSCS13 +02031 MOVE FFIS-ST TO MAP-STAT (WRK-TAD). DTSCS13 +02032 MOVE FFIS-ZIP TO MAP-ZIPC (WRK-TAD). DTSCS13 +02033 DTSCS13 +02034 IF FFIS-BUSINESS-VOICE NOT = SPACES DTSCS13 +02035 MOVE FFIS-BUSINESS-VOICE-AREA-CD TO DTSCS13 +02036 MAP-PHONE-A-CD (WRK-TAD, 1) DTSCS13 +02037 MOVE FFIS-BUSINESS-VOICE-PREFIX TO DTSCS13 +02038 MAP-PHONE-PREF (WRK-TAD, 1) DTSCS13 +02039 MOVE FFIS-BUSINESS-VOICE-SUFFIX TO DTSCS13 +02040 MAP-PHONE-SUFF (WRK-TAD, 1) DTSCS13 +02041 MOVE FFIS-BUSINESS-VOICE-EXT TO DTSCS13 +02042 MAP-PHONE-EXT (WRK-TAD, 1) DTSCS13 +02043 END-IF. DTSCS13 02044 DTSCS13 -02045 S1490-EXIT. DTSCS13 -02046 EXIT. DTSCS13 -02047 DTSCS13 -02048 /*****************************************************************DTSCS13 -02049 * STEP THROUGH TAX ADDRESSES 1, AND 2 *DTSCS13 -02050 ******************************************************************DTSCS13 -02051 S1500-MTAD. DTSCS13 -02052 SET WRK-DC-ADDR-NO-88 (WRK-TAD) TO TRUE. DTSCS13 -02053 SET WRK-PO-BOX-NO-88 (WRK-TAD) TO TRUE. DTSCS13 -02054 MOVE SPACES TO WRK-DELIV-LINE-1 DTSCS13 -02055 WRK-DELIV-LINE-2. DTSCS13 -02056 DTSCS13 -02057 PERFORM S8200-READ-MTAD THRU S8200-EXIT. DTSCS13 -02058 IF L810-OK-88 DTSCS13 -02059 MOVE MSKL-REC TO MTAD-REC DTSCS13 -02060 SET WRK-MTAD-YES-88 TO TRUE DTSCS13 -02061 ELSE DTSCS13 -02062 SET WRK-MTAD-NO-88 TO TRUE. DTSCS13 -02063 DTSCS13 -02064 IF MAP-ATTN (WRK-TAD) = SPACES OR LOW-VALUES DTSCS13 -02065 MOVE SPACES TO MAP-ATTN (WRK-TAD). DTSCS13 -02066 DTSCS13 -02067 IF MAP-CIND (WRK-TAD) = SPACES OR LOW-VALUES DTSCS13 -02068 MOVE SPACES TO MAP-CIND (WRK-TAD). DTSCS13 -02069 DTSCS13 -02070 IF MAP-DLV1 (WRK-TAD) = SPACES OR LOW-VALUES DTSCS13 -02071 MOVE SPACES TO MAP-DLV1 (WRK-TAD). DTSCS13 -02072 DTSCS13 -02073 IF MAP-DLV2 (WRK-TAD) = SPACES OR LOW-VALUES DTSCS13 -02074 MOVE SPACES TO MAP-DLV2 (WRK-TAD). DTSCS13 -02075 DTSCS13 -02076 IF MAP-CITY (WRK-TAD) = SPACES OR LOW-VALUES DTSCS13 -02077 MOVE SPACES TO MAP-CITY (WRK-TAD). DTSCS13 -02078 DTSCS13 -02079 IF MAP-STAT (WRK-TAD) = SPACES OR LOW-VALUES DTSCS13 -02080 MOVE SPACES TO MAP-STAT (WRK-TAD). DTSCS13 -02081 DTSCS13 -02082 IF MAP-ZIPC (WRK-TAD) = SPACES OR LOW-VALUES DTSCS13 -02083 MOVE SPACES TO MAP-ZIPC (WRK-TAD). DTSCS13 -02084 DTSCS13 -02085 IF MAP-MEMO (WRK-TAD) = SPACES OR LOW-VALUES DTSCS13 -02086 IF WRK-TAD = +1 DTSCS13 -02087 MOVE 'Y' TO MAP-MEMO (WRK-TAD) DTSCS13 -02088 ELSE DTSCS13 -02089 MOVE 'N' TO MAP-MEMO (WRK-TAD) DTSCS13 -02090 END-IF DTSCS13 -02091 ELSE DTSCS13 -02092 IF MAP-MEMO (WRK-TAD) = 'Y' OR 'N' DTSCS13 -02093 NEXT SENTENCE DTSCS13 -02094 ELSE DTSCS13 -02095 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS13 -02096 PERFORM S1541-ERROR THRU S1541-EXIT DTSCS13 -02097 GO TO S1500-EXIT. DTSCS13 -02098 DTSCS13 -02099 IF MAP-MISS (WRK-TAD) = SPACES OR LOW-VALUES DTSCS13 -02100 IF WRK-TAD = +1 DTSCS13 -02101 MOVE 'Y' TO MAP-MISS (WRK-TAD) DTSCS13 -02102 ELSE DTSCS13 -02103 MOVE 'N' TO MAP-MISS (WRK-TAD) DTSCS13 -02104 END-IF DTSCS13 -02105 ELSE DTSCS13 -02106 IF MAP-MISS (WRK-TAD) = 'Y' OR 'N' DTSCS13 -02107 NEXT SENTENCE DTSCS13 -02108 ELSE DTSCS13 -02109 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS13 -02110 PERFORM S1551-ERROR THRU S1551-EXIT DTSCS13 -02111 GO TO S1500-EXIT. DTSCS13 -02112 DTSCS13 -02113 IF MAP-ADDR (WRK-TAD) = SPACES OR LOW-VALUES DTSCS13 -02114 MOVE 'N' TO MAP-ADDR (WRK-TAD) DTSCS13 -02115 ELSE DTSCS13 -02116 IF MAP-ADDR (WRK-TAD) = 'Y' OR 'N' DTSCS13 -02117 NEXT SENTENCE DTSCS13 -02118 ELSE DTSCS13 -02119 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS13 -02120 PERFORM S1561-ERROR THRU S1561-EXIT DTSCS13 -02121 GO TO S1500-EXIT. DTSCS13 -02122 DTSCS13 -02123 DTSCS13 -02124 PERFORM S1510-IS-MAP-ADDR-BLANK THRU S1510-EXIT. DTSCS13 -02125 DTSCS13 +02045 MOVE 'Y' TO MAP-MEMO (WRK-TAD) DTSCS13 +02046 MAP-MISS (WRK-TAD). DTSCS13 +02047 MOVE 'N' TO MAP-ADDR (WRK-TAD). DTSCS13 +02048 DTSCS13 +02049 S1490-EXIT. DTSCS13 +02050 EXIT. DTSCS13 +02051 DTSCS13 +02052 /*****************************************************************DTSCS13 +02053 * STEP THROUGH TAX ADDRESSES 1, AND 2 *DTSCS13 +02054 ******************************************************************DTSCS13 +02055 S1500-MTAD. DTSCS13 +02056 SET WRK-DC-ADDR-NO-88 (WRK-TAD) TO TRUE. DTSCS13 +02057 SET WRK-PO-BOX-NO-88 (WRK-TAD) TO TRUE. DTSCS13 +02058 MOVE SPACES TO WRK-DELIV-LINE-1 DTSCS13 +02059 WRK-DELIV-LINE-2. DTSCS13 +02060 DTSCS13 +02061 PERFORM S8200-READ-MTAD THRU S8200-EXIT. DTSCS13 +02062 IF L810-OK-88 DTSCS13 +02063 MOVE MSKL-REC TO MTAD-REC DTSCS13 +02064 SET WRK-MTAD-YES-88 TO TRUE DTSCS13 +02065 ELSE DTSCS13 +02066 SET WRK-MTAD-NO-88 TO TRUE. DTSCS13 +02067 DTSCS13 +02068 IF MAP-ATTN (WRK-TAD) = SPACES OR LOW-VALUES DTSCS13 +02069 MOVE SPACES TO MAP-ATTN (WRK-TAD). DTSCS13 +02070 DTSCS13 +02071 IF MAP-CIND (WRK-TAD) = SPACES OR LOW-VALUES DTSCS13 +02072 MOVE SPACES TO MAP-CIND (WRK-TAD). DTSCS13 +02073 DTSCS13 +02074 IF MAP-DLV1 (WRK-TAD) = SPACES OR LOW-VALUES DTSCS13 +02075 MOVE SPACES TO MAP-DLV1 (WRK-TAD). DTSCS13 +02076 DTSCS13 +02077 IF MAP-DLV2 (WRK-TAD) = SPACES OR LOW-VALUES DTSCS13 +02078 MOVE SPACES TO MAP-DLV2 (WRK-TAD). DTSCS13 +02079 DTSCS13 +02080 IF MAP-CITY (WRK-TAD) = SPACES OR LOW-VALUES DTSCS13 +02081 MOVE SPACES TO MAP-CITY (WRK-TAD). DTSCS13 +02082 DTSCS13 +02083 IF MAP-STAT (WRK-TAD) = SPACES OR LOW-VALUES DTSCS13 +02084 MOVE SPACES TO MAP-STAT (WRK-TAD). DTSCS13 +02085 DTSCS13 +02086 IF MAP-ZIPC (WRK-TAD) = SPACES OR LOW-VALUES DTSCS13 +02087 MOVE SPACES TO MAP-ZIPC (WRK-TAD). DTSCS13 +02088 DTSCS13 +02089 IF MAP-MEMO (WRK-TAD) = SPACES OR LOW-VALUES DTSCS13 +02090 IF WRK-TAD = +1 DTSCS13 +02091 MOVE 'Y' TO MAP-MEMO (WRK-TAD) DTSCS13 +02092 ELSE DTSCS13 +02093 MOVE 'N' TO MAP-MEMO (WRK-TAD) DTSCS13 +02094 END-IF DTSCS13 +02095 ELSE DTSCS13 +02096 IF MAP-MEMO (WRK-TAD) = 'Y' OR 'N' DTSCS13 +02097 NEXT SENTENCE DTSCS13 +02098 ELSE DTSCS13 +02099 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS13 +02100 PERFORM S1541-ERROR THRU S1541-EXIT DTSCS13 +02101 GO TO S1500-EXIT. DTSCS13 +02102 DTSCS13 +02103 IF MAP-MISS (WRK-TAD) = SPACES OR LOW-VALUES DTSCS13 +02104 IF WRK-TAD = +1 DTSCS13 +02105 MOVE 'Y' TO MAP-MISS (WRK-TAD) DTSCS13 +02106 ELSE DTSCS13 +02107 MOVE 'N' TO MAP-MISS (WRK-TAD) DTSCS13 +02108 END-IF DTSCS13 +02109 ELSE DTSCS13 +02110 IF MAP-MISS (WRK-TAD) = 'Y' OR 'N' DTSCS13 +02111 NEXT SENTENCE DTSCS13 +02112 ELSE DTSCS13 +02113 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS13 +02114 PERFORM S1551-ERROR THRU S1551-EXIT DTSCS13 +02115 GO TO S1500-EXIT. DTSCS13 +02116 DTSCS13 +02117 IF MAP-ADDR (WRK-TAD) = SPACES OR LOW-VALUES DTSCS13 +02118 MOVE 'N' TO MAP-ADDR (WRK-TAD) DTSCS13 +02119 ELSE DTSCS13 +02120 IF MAP-ADDR (WRK-TAD) = 'Y' OR 'N' DTSCS13 +02121 NEXT SENTENCE DTSCS13 +02122 ELSE DTSCS13 +02123 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS13 +02124 PERFORM S1561-ERROR THRU S1561-EXIT DTSCS13 +02125 GO TO S1500-EXIT. DTSCS13 02126 DTSCS13 -02127 MOVE SPACE TO L072-ADDRESS. DTSCS13 -02128 DTSCS13 -02129 IF WRK-MAP-ADDR-HAS-DATA (WRK-TAD) DTSCS13 -02130 PERFORM S1520-ADDR THRU S1520-EXIT DTSCS13 -02131 ELSE DTSCS13 -02132 MOVE SPACE TO LCCM-HOLD-ADDRESS (WRK-TAD) DTSCS13 -02133 IF WRK-TAD = +1 DTSCS13 -02134 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS13 -02135 PERFORM S1501-ERROR THRU S1501-EXIT. DTSCS13 -02136 DTSCS13 -02137 PERFORM S1505-SET-ADDR-INDS THRU S1505-EXIT. DTSCS13 -02138 DTSCS13 -02139 MOVE MAP-STAT (WRK-TAD) TO L073-ST. DTSCS13 +02127 DTSCS13 +02128 PERFORM S1510-IS-MAP-ADDR-BLANK THRU S1510-EXIT. DTSCS13 +02129 DTSCS13 +02130 DTSCS13 +02131 MOVE SPACE TO L072-ADDRESS. DTSCS13 +02132 DTSCS13 +02133 IF WRK-MAP-ADDR-HAS-DATA (WRK-TAD) DTSCS13 +02134 PERFORM S1520-ADDR THRU S1520-EXIT DTSCS13 +02135 ELSE DTSCS13 +02136 MOVE SPACE TO LCCM-HOLD-ADDRESS (WRK-TAD) DTSCS13 +02137 IF WRK-TAD = +1 DTSCS13 +02138 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS13 +02139 PERFORM S1501-ERROR THRU S1501-EXIT. DTSCS13 02140 DTSCS13 -02141 MOVE MAP-ZIPC (WRK-TAD) TO L073-ZIP. DTSCS13 +02141 PERFORM S1505-SET-ADDR-INDS THRU S1505-EXIT. DTSCS13 02142 DTSCS13 -02143 PERFORM S1530-PHONE THRU S1530-EXIT DTSCS13 -02144 VARYING WRK-PHONE FROM 1 BY 1 DTSCS13 -02145 UNTIL WRK-PHONE GREATER THAN 3. DTSCS13 -02146 S1500-EXIT. DTSCS13 -02147 EXIT. DTSCS13 -02148 DTSCS13 -02149 DTSCS13 -02150 DTSCS13 -02151 S1501-ERROR. DTSCS13 -02152 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-DLV2-A (WRK-TAD). DTSCS13 -02153 IF LCCM-NO-MSG DTSCS13 -02154 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS13 -02155 MOVE CATB-CURSOR TO MAP-DLV2-L (WRK-TAD) DTSCS13 -02156 SET CURSOR-SET-YES TO TRUE. DTSCS13 -02157 S1501-EXIT. DTSCS13 -02158 EXIT. DTSCS13 -02159 DTSCS13 -02160 DTSCS13 -02161 DTSCS13 -02162 *S1501-ERROR. DTSCS13 -02163 *****MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-CIND-A (WRK-TAD). DTSCS13 -02164 *****IF LCCM-NO-MSG DTSCS13 -02165 *********MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS13 -02166 *********MOVE CATB-CURSOR TO MAP-CIND-L (WRK-TAD) DTSCS13 -02167 *********SET CURSOR-SET-YES TO TRUE. DTSCS13 -02168 *S1501-EXIT. EXIT. DTSCS13 -02169 DTSCS13 -02170 DTSCS13 -02171 DTSCS13 -02172 *S1502-ERROR. DTSCS13 -02173 *****MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ATTN-A (WRK-TAD). DTSCS13 -02174 *****IF LCCM-NO-MSG DTSCS13 -02175 *********MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS13 -02176 *********MOVE CATB-CURSOR TO MAP-ATTN-L (WRK-TAD) DTSCS13 -02177 *********SET CURSOR-SET-YES TO TRUE. DTSCS13 -02178 *S1502-EXIT. DTSCS13 -02179 *****EXIT. DTSCS13 -02180 DTSCS13 -02181 S1505-SET-ADDR-INDS. DTSCS13 -02182 MOVE MAP-DLV1 (WRK-TAD) TO WRK-DELIV-LINE-1. DTSCS13 -02183 MOVE MAP-DLV2(WRK-TAD) TO WRK-DELIV-LINE-2. DTSCS13 +02143 MOVE MAP-STAT (WRK-TAD) TO L073-ST. DTSCS13 +02144 DTSCS13 +02145 MOVE MAP-ZIPC (WRK-TAD) TO L073-ZIP. DTSCS13 +02146 DTSCS13 +02147 PERFORM S1530-PHONE THRU S1530-EXIT DTSCS13 +02148 VARYING WRK-PHONE FROM 1 BY 1 DTSCS13 +02149 UNTIL WRK-PHONE GREATER THAN 3. DTSCS13 +02150 S1500-EXIT. DTSCS13 +02151 EXIT. DTSCS13 +02152 DTSCS13 +02153 DTSCS13 +02154 DTSCS13 +02155 S1501-ERROR. DTSCS13 +02156 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-DLV2-A (WRK-TAD). DTSCS13 +02157 IF LCCM-NO-MSG DTSCS13 +02158 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS13 +02159 MOVE CATB-CURSOR TO MAP-DLV2-L (WRK-TAD) DTSCS13 +02160 SET CURSOR-SET-YES TO TRUE. DTSCS13 +02161 S1501-EXIT. DTSCS13 +02162 EXIT. DTSCS13 +02163 DTSCS13 +02164 DTSCS13 +02165 DTSCS13 +02166 *S1501-ERROR. DTSCS13 +02167 *****MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-CIND-A (WRK-TAD). DTSCS13 +02168 *****IF LCCM-NO-MSG DTSCS13 +02169 *********MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS13 +02170 *********MOVE CATB-CURSOR TO MAP-CIND-L (WRK-TAD) DTSCS13 +02171 *********SET CURSOR-SET-YES TO TRUE. DTSCS13 +02172 *S1501-EXIT. EXIT. DTSCS13 +02173 DTSCS13 +02174 DTSCS13 +02175 DTSCS13 +02176 *S1502-ERROR. DTSCS13 +02177 *****MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ATTN-A (WRK-TAD). DTSCS13 +02178 *****IF LCCM-NO-MSG DTSCS13 +02179 *********MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS13 +02180 *********MOVE CATB-CURSOR TO MAP-ATTN-L (WRK-TAD) DTSCS13 +02181 *********SET CURSOR-SET-YES TO TRUE. DTSCS13 +02182 *S1502-EXIT. DTSCS13 +02183 *****EXIT. DTSCS13 02184 DTSCS13 -02185 IF MAP-STAT (WRK-TAD) = 'DC' DTSCS13 -02186 SET WRK-DC-ADDR-YES-88 (WRK-TAD) TO TRUE DTSCS13 -02187 ELSE DTSCS13 -02188 IF WRK-MTAD-NO-88 DTSCS13 -02189 SET WRK-NON-DC-ADDED-88 TO TRUE DTSCS13 -02190 ELSE DTSCS13 -02191 IF MTAD-ST = 'DC' DTSCS13 -02192 SET WRK-CHANGE-FROM-DC-88 TO TRUE DTSCS13 -02193 END-IF DTSCS13 -02194 END-IF DTSCS13 -02195 END-IF. DTSCS13 -02196 DTSCS13 -02197 IF WRK-DELIV-LINE-1(1:6) = 'PO BOX' DTSCS13 -02198 OR WRK-DELIV-LINE-1(1:7) = 'P O BOX' DTSCS13 -02199 SET WRK-PO-BOX-YES-88 (WRK-TAD) TO TRUE DTSCS13 -02200 IF WRK-MTAD-YES-88 DTSCS13 -02201 IF WRK-DELIV-LINE-1 NOT = MTAD-DELIV-LINE-1 DTSCS13 -02202 SET WRK-CHANGE-TO-PO-BOX-88 TO TRUE DTSCS13 -02203 END-IF DTSCS13 -02204 ELSE DTSCS13 -02205 SET WRK-PO-BOX-ADDED-88 TO TRUE DTSCS13 -02206 END-IF DTSCS13 -02207 END-IF. DTSCS13 -02208 DTSCS13 -02209 IF WRK-DELIV-LINE-2(1:6) = 'PO BOX' DTSCS13 -02210 OR WRK-DELIV-LINE-2(1:7) = 'P O BOX' DTSCS13 -02211 SET WRK-PO-BOX-YES-88 (WRK-TAD) TO TRUE DTSCS13 -02212 IF WRK-MTAD-YES-88 DTSCS13 -02213 IF WRK-DELIV-LINE-2 NOT = MTAD-DELIV-LINE-2 DTSCS13 -02214 SET WRK-CHANGE-TO-PO-BOX-88 TO TRUE DTSCS13 -02215 END-IF DTSCS13 -02216 ELSE DTSCS13 -02217 SET WRK-PO-BOX-ADDED-88 TO TRUE DTSCS13 -02218 END-IF DTSCS13 -02219 END-IF. DTSCS13 -02220 DTSCS13 -02221 S1505-EXIT. DTSCS13 -02222 EXIT. DTSCS13 -02223 /*****************************************************************DTSCS13 -02224 * *DTSCS13 -02225 ******************************************************************DTSCS13 -02226 S1510-IS-MAP-ADDR-BLANK. DTSCS13 -02227 IF ( MAP-ATTN (WRK-TAD) = SPACE OR LOW-VALUE ) DTSCS13 -02228 AND ( MAP-DLV1 (WRK-TAD) = SPACE OR LOW-VALUE ) DTSCS13 -02229 AND ( MAP-DLV2 (WRK-TAD) = SPACE OR LOW-VALUE ) DTSCS13 -02230 AND ( MAP-CITY (WRK-TAD) = SPACE OR LOW-VALUE ) DTSCS13 -02231 AND ( MAP-STAT (WRK-TAD) = SPACE OR LOW-VALUE ) DTSCS13 -02232 AND ( MAP-ZIPC (WRK-TAD) = SPACE OR LOW-VALUE ) DTSCS13 -02233 MOVE SPACE TO MAP-CIND (WRK-TAD) DTSCS13 -02234 MAP-CASS (WRK-TAD) DTSCS13 -02235 MAP-EMAIL(WRK-TAD) DTSCS13 -02236 MAP-MEMO (WRK-TAD) DTSCS13 -02237 MAP-MISS (WRK-TAD) DTSCS13 -02238 MAP-ADDR (WRK-TAD) DTSCS13 -02239 MAP-PHONE-A-CD (WRK-TAD, 1) DTSCS13 -02240 MAP-PHONE-PREF (WRK-TAD, 1) DTSCS13 -02241 MAP-PHONE-SUFF (WRK-TAD, 1) DTSCS13 -02242 MAP-PHONE-EXT (WRK-TAD, 1) DTSCS13 -02243 MAP-PHONE-A-CD (WRK-TAD, 2) DTSCS13 -02244 MAP-PHONE-PREF (WRK-TAD, 2) DTSCS13 -02245 MAP-PHONE-SUFF (WRK-TAD, 2) DTSCS13 -02246 MAP-PHONE-EXT (WRK-TAD, 2) DTSCS13 -02247 MAP-PHONE-A-CD (WRK-TAD, 3) DTSCS13 -02248 MAP-PHONE-PREF (WRK-TAD, 3) DTSCS13 -02249 MAP-PHONE-SUFF (WRK-TAD, 3) DTSCS13 -02250 MAP-PHONE-EXT (WRK-TAD, 3) DTSCS13 -02251 SET WRK-MAP-ADDR-BLANK (WRK-TAD) TO TRUE DTSCS13 -02252 ELSE DTSCS13 -02253 SET WRK-MAP-ADDR-HAS-DATA (WRK-TAD) TO TRUE. DTSCS13 -02254 S1510-EXIT. EXIT. DTSCS13 -02255 /*****************************************************************DTSCS13 -02256 * *DTSCS13 -02257 ******************************************************************DTSCS13 -02258 S1520-ADDR. DTSCS13 -02259 MOVE MAP-CIND (WRK-TAD) TO L072-CASS-IND. DTSCS13 -02260 SET L072-MTAD-88 TO TRUE. DTSCS13 -02261 MOVE MAP-PRIMARY-NAME TO L072-NAME. DTSCS13 -02262 MOVE MAP-ATTN (WRK-TAD) TO L072-ATTN-LINE. DTSCS13 -02263 MOVE MAP-DLV1 (WRK-TAD) TO L072-DELIV-LINE-1. DTSCS13 -02264 MOVE MAP-DLV2 (WRK-TAD) TO L072-DELIV-LINE-2. DTSCS13 -02265 MOVE MAP-CITY (WRK-TAD) TO L072-CITY. DTSCS13 -02266 MOVE MAP-STAT (WRK-TAD) TO L072-ST. DTSCS13 -02267 MOVE MAP-ZIPC (WRK-TAD) TO L072-ZIP. DTSCS13 -02268 DTSCS13 -02269 DTSCS13 -02270 * DEFAULT L072-CASS-IND IS BLANK, SO 'Y' IS DELIBERATE. DTSCS13 -02271 IF L072-CASS-IND = 'Y' DTSCS13 -02272 OR DTSCS13 -02273 WRK-MTAD-NO-88 DTSCS13 -02274 NEXT SENTENCE DTSCS13 -02275 ELSE DTSCS13 -02276 IF L072-ATTN-LINE = MTAD-ATTN-LINE DTSCS13 -02277 AND DTSCS13 -02278 L072-DELIV-LINE-1 = MTAD-DELIV-LINE-1 DTSCS13 -02279 AND DTSCS13 -02280 L072-DELIV-LINE-2 = MTAD-DELIV-LINE-2 DTSCS13 +02185 S1505-SET-ADDR-INDS. DTSCS13 +02186 MOVE MAP-DLV1 (WRK-TAD) TO WRK-DELIV-LINE-1. DTSCS13 +02187 MOVE MAP-DLV2(WRK-TAD) TO WRK-DELIV-LINE-2. DTSCS13 +02188 DTSCS13 +02189 IF MAP-STAT (WRK-TAD) = 'DC' DTSCS13 +02190 SET WRK-DC-ADDR-YES-88 (WRK-TAD) TO TRUE DTSCS13 +02191 ELSE DTSCS13 +02192 IF WRK-MTAD-NO-88 DTSCS13 +02193 SET WRK-NON-DC-ADDED-88 TO TRUE DTSCS13 +02194 ELSE DTSCS13 +02195 IF MTAD-ST = 'DC' DTSCS13 +02196 SET WRK-CHANGE-FROM-DC-88 TO TRUE DTSCS13 +02197 END-IF DTSCS13 +02198 END-IF DTSCS13 +02199 END-IF. DTSCS13 +02200 DTSCS13 +02201 IF WRK-DELIV-LINE-1(1:6) = 'PO BOX' DTSCS13 +02202 OR WRK-DELIV-LINE-1(1:7) = 'P O BOX' DTSCS13 +02203 SET WRK-PO-BOX-YES-88 (WRK-TAD) TO TRUE DTSCS13 +02204 IF WRK-MTAD-YES-88 DTSCS13 +02205 IF WRK-DELIV-LINE-1 NOT = MTAD-DELIV-LINE-1 DTSCS13 +02206 SET WRK-CHANGE-TO-PO-BOX-88 TO TRUE DTSCS13 +02207 END-IF DTSCS13 +02208 ELSE DTSCS13 +02209 SET WRK-PO-BOX-ADDED-88 TO TRUE DTSCS13 +02210 END-IF DTSCS13 +02211 END-IF. DTSCS13 +02212 DTSCS13 +02213 IF WRK-DELIV-LINE-2(1:6) = 'PO BOX' DTSCS13 +02214 OR WRK-DELIV-LINE-2(1:7) = 'P O BOX' DTSCS13 +02215 SET WRK-PO-BOX-YES-88 (WRK-TAD) TO TRUE DTSCS13 +02216 IF WRK-MTAD-YES-88 DTSCS13 +02217 IF WRK-DELIV-LINE-2 NOT = MTAD-DELIV-LINE-2 DTSCS13 +02218 SET WRK-CHANGE-TO-PO-BOX-88 TO TRUE DTSCS13 +02219 END-IF DTSCS13 +02220 ELSE DTSCS13 +02221 SET WRK-PO-BOX-ADDED-88 TO TRUE DTSCS13 +02222 END-IF DTSCS13 +02223 END-IF. DTSCS13 +02224 DTSCS13 +02225 S1505-EXIT. DTSCS13 +02226 EXIT. DTSCS13 +02227 /*****************************************************************DTSCS13 +02228 * *DTSCS13 +02229 ******************************************************************DTSCS13 +02230 S1510-IS-MAP-ADDR-BLANK. DTSCS13 +02231 IF ( MAP-ATTN (WRK-TAD) = SPACE OR LOW-VALUE ) DTSCS13 +02232 AND ( MAP-DLV1 (WRK-TAD) = SPACE OR LOW-VALUE ) DTSCS13 +02233 AND ( MAP-DLV2 (WRK-TAD) = SPACE OR LOW-VALUE ) DTSCS13 +02234 AND ( MAP-CITY (WRK-TAD) = SPACE OR LOW-VALUE ) DTSCS13 +02235 AND ( MAP-STAT (WRK-TAD) = SPACE OR LOW-VALUE ) DTSCS13 +02236 AND ( MAP-ZIPC (WRK-TAD) = SPACE OR LOW-VALUE ) DTSCS13 +02237 MOVE SPACE TO MAP-CIND (WRK-TAD) DTSCS13 +02238 MAP-CASS (WRK-TAD) DTSCS13 +02239 MAP-EMAIL(WRK-TAD) DTSCS13 +02240 MAP-MEMO (WRK-TAD) DTSCS13 +02241 MAP-MISS (WRK-TAD) DTSCS13 +02242 MAP-ADDR (WRK-TAD) DTSCS13 +02243 MAP-PHONE-A-CD (WRK-TAD, 1) DTSCS13 +02244 MAP-PHONE-PREF (WRK-TAD, 1) DTSCS13 +02245 MAP-PHONE-SUFF (WRK-TAD, 1) DTSCS13 +02246 MAP-PHONE-EXT (WRK-TAD, 1) DTSCS13 +02247 MAP-PHONE-A-CD (WRK-TAD, 2) DTSCS13 +02248 MAP-PHONE-PREF (WRK-TAD, 2) DTSCS13 +02249 MAP-PHONE-SUFF (WRK-TAD, 2) DTSCS13 +02250 MAP-PHONE-EXT (WRK-TAD, 2) DTSCS13 +02251 MAP-PHONE-A-CD (WRK-TAD, 3) DTSCS13 +02252 MAP-PHONE-PREF (WRK-TAD, 3) DTSCS13 +02253 MAP-PHONE-SUFF (WRK-TAD, 3) DTSCS13 +02254 MAP-PHONE-EXT (WRK-TAD, 3) DTSCS13 +02255 SET WRK-MAP-ADDR-BLANK (WRK-TAD) TO TRUE DTSCS13 +02256 ELSE DTSCS13 +02257 SET WRK-MAP-ADDR-HAS-DATA (WRK-TAD) TO TRUE. DTSCS13 +02258 S1510-EXIT. EXIT. DTSCS13 +02259 /*****************************************************************DTSCS13 +02260 * *DTSCS13 +02261 ******************************************************************DTSCS13 +02262 S1520-ADDR. DTSCS13 +02263 MOVE MAP-CIND (WRK-TAD) TO L072-CASS-IND. DTSCS13 +02264 SET L072-MTAD-88 TO TRUE. DTSCS13 +02265 MOVE MAP-PRIMARY-NAME TO L072-NAME. DTSCS13 +02266 MOVE MAP-ATTN (WRK-TAD) TO L072-ATTN-LINE. DTSCS13 +02267 MOVE MAP-DLV1 (WRK-TAD) TO L072-DELIV-LINE-1. DTSCS13 +02268 MOVE MAP-DLV2 (WRK-TAD) TO L072-DELIV-LINE-2. DTSCS13 +02269 MOVE MAP-CITY (WRK-TAD) TO L072-CITY. DTSCS13 +02270 MOVE MAP-STAT (WRK-TAD) TO L072-ST. DTSCS13 +02271 MOVE MAP-ZIPC (WRK-TAD) TO L072-ZIP. DTSCS13 +02272 DTSCS13 +02273 DTSCS13 +02274 * DEFAULT L072-CASS-IND IS BLANK, SO 'Y' IS DELIBERATE. DTSCS13 +02275 IF L072-CASS-IND = 'N' CL**3 +02276 OR DTSCS13 +02277 WRK-MTAD-NO-88 DTSCS13 +02278 NEXT SENTENCE DTSCS13 +02279 ELSE DTSCS13 +02280 IF L072-ATTN-LINE = MTAD-ATTN-LINE DTSCS13 02281 AND DTSCS13 -02282 L072-CITY = MTAD-CITY DTSCS13 +02282 L072-DELIV-LINE-1 = MTAD-DELIV-LINE-1 DTSCS13 02283 AND DTSCS13 -02284 L072-ST = MTAD-ST DTSCS13 +02284 L072-DELIV-LINE-2 = MTAD-DELIV-LINE-2 DTSCS13 02285 AND DTSCS13 -02286 L072-ZIP = MTAD-ZIP DTSCS13 -02287 MOVE MTAD-ADVANCED-BARCODE TO L072-ADVANCED-BARCODE DTSCS13 -02288 MOVE L072-ADDRESS TO LCCM-HOLD-ADDRESS (WRK-TAD) DTSCS13 -02289 GO TO S1520-EXIT. DTSCS13 -02290 DTSCS13 -02291 DTSCS13 -02292 PERFORM S072-ADDRESS-EDIT THRU S072-EXIT. DTSCS13 -02293 DTSCS13 -02294 MOVE L072-ADDRESS TO LCCM-HOLD-ADDRESS (WRK-TAD). DTSCS13 +02286 L072-CITY = MTAD-CITY DTSCS13 +02287 AND DTSCS13 +02288 L072-ST = MTAD-ST DTSCS13 +02289 AND DTSCS13 +02290 L072-ZIP = MTAD-ZIP DTSCS13 +02291 MOVE MTAD-ADVANCED-BARCODE TO L072-ADVANCED-BARCODE DTSCS13 +02292 MOVE L072-ADDRESS TO LCCM-HOLD-ADDRESS (WRK-TAD) DTSCS13 +02293 GO TO S1520-EXIT. DTSCS13 +02294 DTSCS13 02295 DTSCS13 -02296 MOVE L072-CASS-IND TO MAP-CIND (WRK-TAD). DTSCS13 +02296 PERFORM S072-ADDRESS-EDIT THRU S072-EXIT. DTSCS13 02297 DTSCS13 -02298 MOVE L072-CASS-RETURN-CODES TO MAP-CASS (WRK-TAD). DTSCS13 +02298 MOVE L072-ADDRESS TO LCCM-HOLD-ADDRESS (WRK-TAD). DTSCS13 02299 DTSCS13 -02300 DTSCS13 -02301 IF L072-ATTN-LINE-NOT-VALID-88 DTSCS13 -02302 PERFORM S1521-ERROR THRU S1521-EXIT DTSCS13 -02303 ELSE DTSCS13 -02304 MOVE L072-ATTN-LINE TO MAP-ATTN (WRK-TAD) DTSCS13 -02305 IF L072-ATTN-LINE-CHANGED-88 DTSCS13 -02306 MOVE CATB-UNPROT-NORM-AN-MDTON DTSCS13 -02307 TO MAP-ATTN-A (WRK-TAD). DTSCS13 -02308 DTSCS13 -02309 DTSCS13 -02310 IF L072-DELIV-LINE-1-NOT-VALID-88 DTSCS13 -02311 PERFORM S1522-ERROR THRU S1522-EXIT DTSCS13 -02312 ELSE DTSCS13 -02313 MOVE L072-DELIV-LINE-1 TO MAP-DLV1 (WRK-TAD) DTSCS13 -02314 IF L072-DELIV-LINE-1-CHANGED-88 DTSCS13 -02315 MOVE CATB-UNPROT-NORM-AN-MDTON DTSCS13 -02316 TO MAP-DLV1-A (WRK-TAD). DTSCS13 -02317 DTSCS13 -02318 DTSCS13 -02319 IF L072-DELIV-LINE-2-NOT-VALID-88 DTSCS13 -02320 PERFORM S1523-ERROR THRU S1523-EXIT DTSCS13 -02321 ELSE DTSCS13 -02322 MOVE L072-DELIV-LINE-2 TO MAP-DLV2 (WRK-TAD) DTSCS13 -02323 IF L072-DELIV-LINE-2-CHANGED-88 DTSCS13 -02324 MOVE CATB-UNPROT-NORM-AN-MDTON DTSCS13 -02325 TO MAP-DLV2-A (WRK-TAD). DTSCS13 -02326 DTSCS13 -02327 DTSCS13 -02328 IF L072-CITY-NOT-VALID-88 DTSCS13 -02329 PERFORM S1524-ERROR THRU S1524-EXIT DTSCS13 -02330 ELSE DTSCS13 -02331 MOVE L072-CITY TO MAP-CITY (WRK-TAD) DTSCS13 -02332 IF L072-CITY-CHANGED-88 DTSCS13 -02333 MOVE CATB-UNPROT-NORM-AN-MDTON DTSCS13 -02334 TO MAP-CITY-A (WRK-TAD). DTSCS13 -02335 DTSCS13 -02336 DTSCS13 -02337 IF L072-ST-NOT-VALID-88 DTSCS13 -02338 PERFORM S1525-ERROR THRU S1525-EXIT DTSCS13 -02339 ELSE DTSCS13 -02340 MOVE L072-ST TO MAP-STAT (WRK-TAD) DTSCS13 -02341 IF L072-ST-CHANGED-88 DTSCS13 -02342 MOVE CATB-UNPROT-NORM-AN-MDTON DTSCS13 -02343 TO MAP-STAT-A (WRK-TAD). DTSCS13 -02344 DTSCS13 -02345 DTSCS13 -02346 IF L072-ZIP-NOT-VALID-88 DTSCS13 -02347 PERFORM S1526-ERROR THRU S1526-EXIT DTSCS13 -02348 ELSE DTSCS13 -02349 MOVE L072-ZIP TO MAP-ZIPC (WRK-TAD) DTSCS13 -02350 IF L072-ZIP-CHANGED-88 DTSCS13 -02351 MOVE CATB-UNPROT-NORM-AN-MDTON DTSCS13 -02352 TO MAP-ZIPC-A (WRK-TAD). DTSCS13 -02353 DTSCS13 -02354 DTSCS13 -02355 IF L072-ADDRESS-NOT-VALID-88 DTSCS13 -02356 IF LCCM-NO-MSG DTSCS13 -02357 PERFORM S1521-ERROR THRU S1521-EXIT. DTSCS13 +02300 MOVE L072-CASS-IND TO MAP-CIND (WRK-TAD). DTSCS13 +02301 DTSCS13 +02302 MOVE L072-CASS-RETURN-CODES TO MAP-CASS (WRK-TAD). DTSCS13 +02303 DTSCS13 +02304 DTSCS13 +02305 IF L072-ATTN-LINE-NOT-VALID-88 DTSCS13 +02306 PERFORM S1521-ERROR THRU S1521-EXIT DTSCS13 +02307 ELSE DTSCS13 +02308 MOVE L072-ATTN-LINE TO MAP-ATTN (WRK-TAD) DTSCS13 +02309 IF L072-ATTN-LINE-CHANGED-88 DTSCS13 +02310 MOVE CATB-UNPROT-NORM-AN-MDTON DTSCS13 +02311 TO MAP-ATTN-A (WRK-TAD). DTSCS13 +02312 DTSCS13 +02313 DTSCS13 +02314 IF L072-DELIV-LINE-1-NOT-VALID-88 DTSCS13 +02315 PERFORM S1522-ERROR THRU S1522-EXIT DTSCS13 +02316 ELSE DTSCS13 +02317 MOVE L072-DELIV-LINE-1 TO MAP-DLV1 (WRK-TAD) DTSCS13 +02318 IF L072-DELIV-LINE-1-CHANGED-88 DTSCS13 +02319 MOVE CATB-UNPROT-NORM-AN-MDTON DTSCS13 +02320 TO MAP-DLV1-A (WRK-TAD). DTSCS13 +02321 DTSCS13 +02322 DTSCS13 +02323 IF L072-DELIV-LINE-2-NOT-VALID-88 DTSCS13 +02324 PERFORM S1523-ERROR THRU S1523-EXIT DTSCS13 +02325 ELSE DTSCS13 +02326 MOVE L072-DELIV-LINE-2 TO MAP-DLV2 (WRK-TAD) DTSCS13 +02327 IF L072-DELIV-LINE-2-CHANGED-88 DTSCS13 +02328 MOVE CATB-UNPROT-NORM-AN-MDTON DTSCS13 +02329 TO MAP-DLV2-A (WRK-TAD). DTSCS13 +02330 DTSCS13 +02331 DTSCS13 +02332 IF L072-CITY-NOT-VALID-88 DTSCS13 +02333 PERFORM S1524-ERROR THRU S1524-EXIT DTSCS13 +02334 ELSE DTSCS13 +02335 MOVE L072-CITY TO MAP-CITY (WRK-TAD) DTSCS13 +02336 IF L072-CITY-CHANGED-88 DTSCS13 +02337 MOVE CATB-UNPROT-NORM-AN-MDTON DTSCS13 +02338 TO MAP-CITY-A (WRK-TAD). DTSCS13 +02339 DTSCS13 +02340 DTSCS13 +02341 IF L072-ST-NOT-VALID-88 DTSCS13 +02342 PERFORM S1525-ERROR THRU S1525-EXIT DTSCS13 +02343 ELSE DTSCS13 +02344 MOVE L072-ST TO MAP-STAT (WRK-TAD) DTSCS13 +02345 IF L072-ST-CHANGED-88 DTSCS13 +02346 MOVE CATB-UNPROT-NORM-AN-MDTON DTSCS13 +02347 TO MAP-STAT-A (WRK-TAD). DTSCS13 +02348 DTSCS13 +02349 DTSCS13 +02350 IF L072-ZIP-NOT-VALID-88 DTSCS13 +02351 PERFORM S1526-ERROR THRU S1526-EXIT DTSCS13 +02352 ELSE DTSCS13 +02353 MOVE L072-ZIP TO MAP-ZIPC (WRK-TAD) DTSCS13 +02354 IF L072-ZIP-CHANGED-88 DTSCS13 +02355 MOVE CATB-UNPROT-NORM-AN-MDTON DTSCS13 +02356 TO MAP-ZIPC-A (WRK-TAD). DTSCS13 +02357 DTSCS13 02358 DTSCS13 -02359 DTSCS13 -02360 S1520-EXIT. EXIT. DTSCS13 -02361 SKIP3 DTSCS13 -02362 S1521-ERROR. DTSCS13 -02363 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ATTN-A (WRK-TAD). DTSCS13 -02364 IF LCCM-NO-MSG DTSCS13 -02365 MOVE L072-MSG-AREA TO LCCM-MSG-AREA DTSCS13 -02366 MOVE CATB-CURSOR TO MAP-ATTN-L (WRK-TAD) DTSCS13 -02367 SET CURSOR-SET-YES TO TRUE. DTSCS13 -02368 S1521-EXIT. EXIT. DTSCS13 -02369 SKIP3 DTSCS13 -02370 S1522-ERROR. DTSCS13 -02371 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-DLV1-A (WRK-TAD). DTSCS13 -02372 IF LCCM-NO-MSG DTSCS13 -02373 MOVE L072-MSG-AREA TO LCCM-MSG-AREA DTSCS13 -02374 MOVE CATB-CURSOR TO MAP-DLV1-L (WRK-TAD) DTSCS13 -02375 SET CURSOR-SET-YES TO TRUE. DTSCS13 -02376 S1522-EXIT. EXIT. DTSCS13 -02377 SKIP3 DTSCS13 -02378 S1523-ERROR. DTSCS13 -02379 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-DLV2-A (WRK-TAD). DTSCS13 -02380 IF LCCM-NO-MSG DTSCS13 -02381 MOVE L072-MSG-AREA TO LCCM-MSG-AREA DTSCS13 -02382 MOVE CATB-CURSOR TO MAP-DLV2-L (WRK-TAD) DTSCS13 -02383 SET CURSOR-SET-YES TO TRUE. DTSCS13 -02384 S1523-EXIT. EXIT. DTSCS13 -02385 SKIP3 DTSCS13 -02386 S1524-ERROR. DTSCS13 -02387 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-CITY-A (WRK-TAD). DTSCS13 -02388 IF LCCM-NO-MSG DTSCS13 -02389 MOVE L072-MSG-AREA TO LCCM-MSG-AREA DTSCS13 -02390 MOVE CATB-CURSOR TO MAP-CITY-L (WRK-TAD) DTSCS13 -02391 SET CURSOR-SET-YES TO TRUE. DTSCS13 -02392 S1524-EXIT. EXIT. DTSCS13 -02393 SKIP3 DTSCS13 -02394 S1525-ERROR. DTSCS13 -02395 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-STAT-A (WRK-TAD). DTSCS13 -02396 IF LCCM-NO-MSG DTSCS13 -02397 MOVE L072-MSG-AREA TO LCCM-MSG-AREA DTSCS13 -02398 MOVE CATB-CURSOR TO MAP-STAT-L (WRK-TAD) DTSCS13 -02399 SET CURSOR-SET-YES TO TRUE. DTSCS13 -02400 S1525-EXIT. EXIT. DTSCS13 -02401 SKIP3 DTSCS13 -02402 S1526-ERROR. DTSCS13 -02403 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ZIPC-A (WRK-TAD). DTSCS13 -02404 IF LCCM-NO-MSG DTSCS13 -02405 MOVE L072-MSG-AREA TO LCCM-MSG-AREA DTSCS13 -02406 MOVE CATB-CURSOR TO MAP-ZIPC-L (WRK-TAD) DTSCS13 -02407 SET CURSOR-SET-YES TO TRUE. DTSCS13 -02408 S1526-EXIT. EXIT. DTSCS13 -02409 SKIP3 DTSCS13 -02410 ******************************************************************DTSCS13 -02411 * *DTSCS13 -02412 ******************************************************************DTSCS13 -02413 S1530-PHONE. DTSCS13 -02414 MOVE MAP-PHONE-AREA (WRK-TAD, WRK-PHONE) TO L021-S-TNO-AREA. DTSCS13 -02415 PERFORM S021-TELNO-FROM-SCREEN THRU S021-EXIT. DTSCS13 -02416 IF L021-NOT-VALID DTSCS13 -02417 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS13 -02418 PERFORM S1531-ERROR THRU S1531-EXIT DTSCS13 -02419 ELSE DTSCS13 -02420 IF L021-VALID DTSCS13 -02421 MOVE L021-TNO TO L073-TELEPHONE DTSCS13 -02422 PERFORM S073-TELNO-EDIT THRU S073-EXIT DTSCS13 -02423 IF L073-NOT-VALID DTSCS13 -02424 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS13 -02425 PERFORM S1531-ERROR THRU S1531-EXIT DTSCS13 -02426 ELSE DTSCS13 -02427 MOVE L073-AREA-CD DTSCS13 -02428 TO MAP-PHONE-A-CD (WRK-TAD, WRK-PHONE) DTSCS13 -02429 MOVE L073-PREFIX DTSCS13 -02430 TO MAP-PHONE-PREF (WRK-TAD, WRK-PHONE) DTSCS13 -02431 MOVE L073-SUFFIX DTSCS13 -02432 TO MAP-PHONE-SUFF (WRK-TAD, WRK-PHONE) DTSCS13 -02433 MOVE L073-EXT DTSCS13 -02434 TO MAP-PHONE-EXT (WRK-TAD, WRK-PHONE). DTSCS13 -02435 S1530-EXIT. EXIT. DTSCS13 -02436 SKIP3 DTSCS13 -02437 S1531-ERROR. DTSCS13 -02438 MOVE CATB-UNPROT-NORM-NUM-MDTON DTSCS13 -02439 TO MAP-PHONE-A-CD-A (WRK-TAD, WRK-PHONE) DTSCS13 -02440 MAP-PHONE-PREF-A (WRK-TAD, WRK-PHONE) DTSCS13 -02441 MAP-PHONE-SUFF-A (WRK-TAD, WRK-PHONE) DTSCS13 -02442 MAP-PHONE-EXT-A (WRK-TAD, WRK-PHONE).DTSCS13 -02443 IF LCCM-NO-MSG DTSCS13 -02444 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS13 -02445 MOVE CATB-CURSOR TO MAP-PHONE-A-CD-L (WRK-TAD, WRK-PHONE) DTSCS13 -02446 SET CURSOR-SET-YES TO TRUE. DTSCS13 -02447 S1531-EXIT. EXIT. DTSCS13 -02448 SKIP3 DTSCS13 -02449 S1541-ERROR. DTSCS13 -02450 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-MEMO-A (WRK-TAD). DTSCS13 -02451 IF LCCM-NO-MSG DTSCS13 -02452 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS13 -02453 MOVE CATB-CURSOR TO MAP-MEMO-L (WRK-TAD) DTSCS13 -02454 SET CURSOR-SET-YES TO TRUE. DTSCS13 -02455 S1541-EXIT. EXIT. DTSCS13 -02456 SKIP3 DTSCS13 -02457 S1551-ERROR. DTSCS13 -02458 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-MISS-A (WRK-TAD). DTSCS13 -02459 IF LCCM-NO-MSG DTSCS13 -02460 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS13 -02461 MOVE CATB-CURSOR TO MAP-MISS-L (WRK-TAD) DTSCS13 -02462 SET CURSOR-SET-YES TO TRUE. DTSCS13 -02463 S1551-EXIT. EXIT. DTSCS13 -02464 SKIP3 DTSCS13 -02465 S1561-ERROR. DTSCS13 -02466 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ADDR-A (WRK-TAD). DTSCS13 -02467 IF LCCM-NO-MSG DTSCS13 -02468 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS13 -02469 MOVE CATB-CURSOR TO MAP-ADDR-L (WRK-TAD) DTSCS13 -02470 SET CURSOR-SET-YES TO TRUE. DTSCS13 -02471 S1561-EXIT. EXIT. DTSCS13 -02472 /*****************************************************************DTSCS13 -02473 * VERIFY THAT THERE IS A DC ADDRESS ON FILE FOR SUBJECT EMPLOYERS*DTSCS13 -02474 ******************************************************************DTSCS13 -02475 S1600-CHECK-FOR-DC-ADDR. DTSCS13 -02476 IF MAP-VERIFY-YES-88 DTSCS13 -02477 GO TO S1600-EXIT DTSCS13 -02478 END-IF. DTSCS13 -02479 DTSCS13 -02480 IF WRK-DC-ADDR-YES-88 (1) DTSCS13 -02481 IF WRK-PO-BOX-NO-88 (1) DTSCS13 -02482 GO TO S1600-EXIT DTSCS13 -02483 END-IF DTSCS13 -02484 END-IF. DTSCS13 -02485 DTSCS13 -02486 IF WRK-DC-ADDR-YES-88 (2) DTSCS13 -02487 IF WRK-PO-BOX-NO-88 (2) DTSCS13 -02488 GO TO S1600-EXIT DTSCS13 -02489 END-IF DTSCS13 -02490 END-IF. DTSCS13 -02491 DTSCS13 -02492 IF WRK-DC-ADDR-NO-88 (1) DTSCS13 -02493 AND WRK-DC-ADDR-NO-88 (2) DTSCS13 -02494 IF WRK-STATE-CHANGE-NULL-88 DTSCS13 -02495 NEXT SENTENCE DTSCS13 -02496 ELSE DTSCS13 -02497 MOVE MSG-E136-AREA TO WRK-MSG-AREA DTSCS13 -02498 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS13 -02499 END-IF DTSCS13 -02500 END-IF. DTSCS13 -02501 DTSCS13 -02502 IF WRK-CHANGE-FROM-DC-88 DTSCS13 -02503 MOVE MSG-E137-AREA TO WRK-MSG-AREA DTSCS13 -02504 PERFORM S1602-ERROR THRU S1602-EXIT DTSCS13 -02505 ELSE DTSCS13 -02506 IF WRK-PO-BOX-CHANGE-NULL-88 DTSCS13 -02507 NEXT SENTENCE DTSCS13 -02508 ELSE DTSCS13 -02509 MOVE MSG-E137-AREA TO WRK-MSG-AREA DTSCS13 -02510 PERFORM S1602-ERROR THRU S1602-EXIT DTSCS13 -02511 END-IF DTSCS13 -02512 END-IF. DTSCS13 -02513 DTSCS13 -02514 S1600-EXIT. EXIT. DTSCS13 -02515 DTSCS13 -02516 S1601-ERROR. DTSCS13 -02517 *** >> MODIFIED TO ALLOW STAFF TO BYPASS EDIT WITHOUT DTSCS13 -02518 *** >> SUPERVISOR APPROVAL. DTSCS13 -02519 IF LCCM-NO-MSG DTSCS13 -02520 MOVE CATB-CURSOR TO MAP-VERIFY-L DTSCS13 -02521 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-VERIFY-A DTSCS13 -02522 MOVE CATB-ASKIP-BRT-MDTOFF TO MAP-VERIFY-LIT-A DTSCS13 -02523 MOVE 'VERIFY?' TO MAP-VERIFY-LIT DTSCS13 -02524 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS13 -02525 SET CURSOR-SET-YES TO TRUE DTSCS13 -02526 END-IF. DTSCS13 -02527 DTSCS13 -02528 *** MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-STAT-A (2). DTSCS13 -02529 * IF LCCM-NO-MSG DTSCS13 -02530 * MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS13 -02531 * SET CURSOR-SET-YES TO TRUE DTSCS13 -02532 * MOVE CATB-CURSOR TO MAP-STAT-L (2) DTSCS13 -02533 * IF LCCM-OP-IS-FLD-DESK-88 DTSCS13 -02534 * OR LCCM-OP-IS-ACCOUNTING-DESK-88 DTSCS13 -02535 * MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-VERIFY-A DTSCS13 -02536 * MOVE CATB-ASKIP-BRT-MDTOFF TO MAP-VERIFY-LIT-A DTSCS13 -02537 * MOVE 'VERIFY?' TO MAP-VERIFY-LIT DTSCS13 -02538 * END-IF DTSCS13 -02539 *** END-IF. DTSCS13 -02540 S1601-EXIT. EXIT. DTSCS13 -02541 SKIP3 DTSCS13 -02542 S1602-ERROR. DTSCS13 -02543 *** >> MODIFIED TO ALLOW STAFF TO BYPASS EDIT WITHOUT DTSCS13 -02544 *** >> SUPERVISOR APPROVAL. DTSCS13 -02545 IF LCCM-NO-MSG DTSCS13 -02546 MOVE CATB-CURSOR TO MAP-VERIFY-L DTSCS13 -02547 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-VERIFY-A DTSCS13 -02548 MOVE CATB-ASKIP-BRT-MDTOFF TO MAP-VERIFY-LIT-A DTSCS13 -02549 MOVE 'VERIFY?' TO MAP-VERIFY-LIT DTSCS13 -02550 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS13 -02551 SET CURSOR-SET-YES TO TRUE DTSCS13 -02552 END-IF. DTSCS13 -02553 DTSCS13 -02554 *** IF WRK-DC-ADDR-YES-88 (1) DTSCS13 -02555 * MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-DLV1-A (1) DTSCS13 -02556 * MAP-DLV2-A (1) DTSCS13 -02557 * ELSE DTSCS13 -02558 * MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-DLV1-A (2) DTSCS13 -02559 * MAP-DLV2-A (2) DTSCS13 -02560 * END-IF. DTSCS13 -02561 * DTSCS13 -02562 * IF LCCM-NO-MSG DTSCS13 -02563 * MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS13 -02564 * IF WRK-DC-ADDR-YES-88 (1) DTSCS13 -02565 * MOVE CATB-CURSOR TO MAP-DLV1-L (1) DTSCS13 -02566 * ELSE DTSCS13 -02567 * MOVE CATB-CURSOR TO MAP-DLV1-L (2) DTSCS13 -02568 * END-IF DTSCS13 -02569 * SET CURSOR-SET-YES TO TRUE DTSCS13 -02570 * IF LCCM-OP-IS-FLD-DESK-88 DTSCS13 -02571 * OR LCCM-OP-IS-ACCOUNTING-DESK-88 DTSCS13 -02572 * MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-VERIFY-A DTSCS13 -02573 * MOVE CATB-ASKIP-BRT-MDTOFF TO MAP-VERIFY-LIT-A DTSCS13 -02574 * MOVE 'VERIFY?' TO MAP-VERIFY-LIT DTSCS13 -02575 * END-IF DTSCS13 -02576 *** END-IF. DTSCS13 -02577 S1602-EXIT. EXIT. DTSCS13 -02578 SKIP3 DTSCS13 -02579 /*****************************************************************DTSCS13 -02580 * LOCK SCREEN FOR UPDATE CONFIRMATION *DTSCS13 -02581 ******************************************************************DTSCS13 -02582 S5100-SET-LOCK-ATTRB. DTSCS13 -02583 MOVE CATB-ASKIP-BRT-MDTON TO SCR-ATB-AN DTSCS13 -02584 SCR-ATB-NUM. DTSCS13 -02585 DTSCS13 -02586 PERFORM S5110-HOLD-ATTRB THRU S5110-EXIT DTSCS13 -02587 VARYING WRK-TAD FROM 1 BY 1 DTSCS13 -02588 UNTIL WRK-TAD GREATER THAN 2. DTSCS13 +02359 IF L072-ADDRESS-NOT-VALID-88 DTSCS13 +02360 IF LCCM-NO-MSG DTSCS13 +02361 PERFORM S1521-ERROR THRU S1521-EXIT. DTSCS13 +02362 DTSCS13 +02363 DTSCS13 +02364 S1520-EXIT. EXIT. DTSCS13 +02365 SKIP3 DTSCS13 +02366 S1521-ERROR. DTSCS13 +02367 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ATTN-A (WRK-TAD). DTSCS13 +02368 IF LCCM-NO-MSG DTSCS13 +02369 MOVE L072-MSG-AREA TO LCCM-MSG-AREA DTSCS13 +02370 MOVE CATB-CURSOR TO MAP-ATTN-L (WRK-TAD) DTSCS13 +02371 SET CURSOR-SET-YES TO TRUE. DTSCS13 +02372 S1521-EXIT. EXIT. DTSCS13 +02373 SKIP3 DTSCS13 +02374 S1522-ERROR. DTSCS13 +02375 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-DLV1-A (WRK-TAD). DTSCS13 +02376 IF LCCM-NO-MSG DTSCS13 +02377 MOVE L072-MSG-AREA TO LCCM-MSG-AREA DTSCS13 +02378 MOVE CATB-CURSOR TO MAP-DLV1-L (WRK-TAD) DTSCS13 +02379 SET CURSOR-SET-YES TO TRUE. DTSCS13 +02380 S1522-EXIT. EXIT. DTSCS13 +02381 SKIP3 DTSCS13 +02382 S1523-ERROR. DTSCS13 +02383 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-DLV2-A (WRK-TAD). DTSCS13 +02384 IF LCCM-NO-MSG DTSCS13 +02385 MOVE L072-MSG-AREA TO LCCM-MSG-AREA DTSCS13 +02386 MOVE CATB-CURSOR TO MAP-DLV2-L (WRK-TAD) DTSCS13 +02387 SET CURSOR-SET-YES TO TRUE. DTSCS13 +02388 S1523-EXIT. EXIT. DTSCS13 +02389 SKIP3 DTSCS13 +02390 S1524-ERROR. DTSCS13 +02391 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-CITY-A (WRK-TAD). DTSCS13 +02392 IF LCCM-NO-MSG DTSCS13 +02393 MOVE L072-MSG-AREA TO LCCM-MSG-AREA DTSCS13 +02394 MOVE CATB-CURSOR TO MAP-CITY-L (WRK-TAD) DTSCS13 +02395 SET CURSOR-SET-YES TO TRUE. DTSCS13 +02396 S1524-EXIT. EXIT. DTSCS13 +02397 SKIP3 DTSCS13 +02398 S1525-ERROR. DTSCS13 +02399 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-STAT-A (WRK-TAD). DTSCS13 +02400 IF LCCM-NO-MSG DTSCS13 +02401 MOVE L072-MSG-AREA TO LCCM-MSG-AREA DTSCS13 +02402 MOVE CATB-CURSOR TO MAP-STAT-L (WRK-TAD) DTSCS13 +02403 SET CURSOR-SET-YES TO TRUE. DTSCS13 +02404 S1525-EXIT. EXIT. DTSCS13 +02405 SKIP3 DTSCS13 +02406 S1526-ERROR. DTSCS13 +02407 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ZIPC-A (WRK-TAD). DTSCS13 +02408 IF LCCM-NO-MSG DTSCS13 +02409 MOVE L072-MSG-AREA TO LCCM-MSG-AREA DTSCS13 +02410 MOVE CATB-CURSOR TO MAP-ZIPC-L (WRK-TAD) DTSCS13 +02411 SET CURSOR-SET-YES TO TRUE. DTSCS13 +02412 S1526-EXIT. EXIT. DTSCS13 +02413 SKIP3 DTSCS13 +02414 ******************************************************************DTSCS13 +02415 * *DTSCS13 +02416 ******************************************************************DTSCS13 +02417 S1530-PHONE. DTSCS13 +02418 MOVE MAP-PHONE-AREA (WRK-TAD, WRK-PHONE) TO L021-S-TNO-AREA. DTSCS13 +02419 PERFORM S021-TELNO-FROM-SCREEN THRU S021-EXIT. DTSCS13 +02420 IF L021-NOT-VALID DTSCS13 +02421 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS13 +02422 PERFORM S1531-ERROR THRU S1531-EXIT DTSCS13 +02423 ELSE DTSCS13 +02424 IF L021-VALID DTSCS13 +02425 MOVE L021-TNO TO L073-TELEPHONE DTSCS13 +02426 PERFORM S073-TELNO-EDIT THRU S073-EXIT DTSCS13 +02427 IF L073-NOT-VALID DTSCS13 +02428 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS13 +02429 PERFORM S1531-ERROR THRU S1531-EXIT DTSCS13 +02430 ELSE DTSCS13 +02431 MOVE L073-AREA-CD DTSCS13 +02432 TO MAP-PHONE-A-CD (WRK-TAD, WRK-PHONE) DTSCS13 +02433 MOVE L073-PREFIX DTSCS13 +02434 TO MAP-PHONE-PREF (WRK-TAD, WRK-PHONE) DTSCS13 +02435 MOVE L073-SUFFIX DTSCS13 +02436 TO MAP-PHONE-SUFF (WRK-TAD, WRK-PHONE) DTSCS13 +02437 MOVE L073-EXT DTSCS13 +02438 TO MAP-PHONE-EXT (WRK-TAD, WRK-PHONE). DTSCS13 +02439 S1530-EXIT. EXIT. DTSCS13 +02440 SKIP3 DTSCS13 +02441 S1531-ERROR. DTSCS13 +02442 MOVE CATB-UNPROT-NORM-NUM-MDTON DTSCS13 +02443 TO MAP-PHONE-A-CD-A (WRK-TAD, WRK-PHONE) DTSCS13 +02444 MAP-PHONE-PREF-A (WRK-TAD, WRK-PHONE) DTSCS13 +02445 MAP-PHONE-SUFF-A (WRK-TAD, WRK-PHONE) DTSCS13 +02446 MAP-PHONE-EXT-A (WRK-TAD, WRK-PHONE).DTSCS13 +02447 IF LCCM-NO-MSG DTSCS13 +02448 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS13 +02449 MOVE CATB-CURSOR TO MAP-PHONE-A-CD-L (WRK-TAD, WRK-PHONE) DTSCS13 +02450 SET CURSOR-SET-YES TO TRUE. DTSCS13 +02451 S1531-EXIT. EXIT. DTSCS13 +02452 SKIP3 DTSCS13 +02453 S1541-ERROR. DTSCS13 +02454 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-MEMO-A (WRK-TAD). DTSCS13 +02455 IF LCCM-NO-MSG DTSCS13 +02456 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS13 +02457 MOVE CATB-CURSOR TO MAP-MEMO-L (WRK-TAD) DTSCS13 +02458 SET CURSOR-SET-YES TO TRUE. DTSCS13 +02459 S1541-EXIT. EXIT. DTSCS13 +02460 SKIP3 DTSCS13 +02461 S1551-ERROR. DTSCS13 +02462 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-MISS-A (WRK-TAD). DTSCS13 +02463 IF LCCM-NO-MSG DTSCS13 +02464 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS13 +02465 MOVE CATB-CURSOR TO MAP-MISS-L (WRK-TAD) DTSCS13 +02466 SET CURSOR-SET-YES TO TRUE. DTSCS13 +02467 S1551-EXIT. EXIT. DTSCS13 +02468 SKIP3 DTSCS13 +02469 S1561-ERROR. DTSCS13 +02470 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ADDR-A (WRK-TAD). DTSCS13 +02471 IF LCCM-NO-MSG DTSCS13 +02472 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS13 +02473 MOVE CATB-CURSOR TO MAP-ADDR-L (WRK-TAD) DTSCS13 +02474 SET CURSOR-SET-YES TO TRUE. DTSCS13 +02475 S1561-EXIT. EXIT. DTSCS13 +02476 /*****************************************************************DTSCS13 +02477 * VERIFY THAT THERE IS A DC ADDRESS ON FILE FOR SUBJECT EMPLOYERS*DTSCS13 +02478 ******************************************************************DTSCS13 +02479 S1600-CHECK-FOR-DC-ADDR. DTSCS13 +02480 IF MAP-VERIFY-YES-88 DTSCS13 +02481 GO TO S1600-EXIT DTSCS13 +02482 END-IF. DTSCS13 +02483 DTSCS13 +02484 IF WRK-DC-ADDR-YES-88 (1) DTSCS13 +02485 IF WRK-PO-BOX-NO-88 (1) DTSCS13 +02486 GO TO S1600-EXIT DTSCS13 +02487 END-IF DTSCS13 +02488 END-IF. DTSCS13 +02489 DTSCS13 +02490 IF WRK-DC-ADDR-YES-88 (2) DTSCS13 +02491 IF WRK-PO-BOX-NO-88 (2) DTSCS13 +02492 GO TO S1600-EXIT DTSCS13 +02493 END-IF DTSCS13 +02494 END-IF. DTSCS13 +02495 DTSCS13 +02496 IF WRK-DC-ADDR-NO-88 (1) DTSCS13 +02497 AND WRK-DC-ADDR-NO-88 (2) DTSCS13 +02498 IF WRK-STATE-CHANGE-NULL-88 DTSCS13 +02499 NEXT SENTENCE DTSCS13 +02500 ELSE DTSCS13 +02501 MOVE MSG-E136-AREA TO WRK-MSG-AREA DTSCS13 +02502 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS13 +02503 END-IF DTSCS13 +02504 END-IF. DTSCS13 +02505 DTSCS13 +02506 IF WRK-CHANGE-FROM-DC-88 DTSCS13 +02507 MOVE MSG-E137-AREA TO WRK-MSG-AREA DTSCS13 +02508 PERFORM S1602-ERROR THRU S1602-EXIT DTSCS13 +02509 ELSE DTSCS13 +02510 IF WRK-PO-BOX-CHANGE-NULL-88 DTSCS13 +02511 NEXT SENTENCE DTSCS13 +02512 ELSE DTSCS13 +02513 MOVE MSG-E137-AREA TO WRK-MSG-AREA DTSCS13 +02514 PERFORM S1602-ERROR THRU S1602-EXIT DTSCS13 +02515 END-IF DTSCS13 +02516 END-IF. DTSCS13 +02517 DTSCS13 +02518 S1600-EXIT. EXIT. DTSCS13 +02519 DTSCS13 +02520 S1601-ERROR. DTSCS13 +02521 *** >> MODIFIED TO ALLOW STAFF TO BYPASS EDIT WITHOUT DTSCS13 +02522 *** >> SUPERVISOR APPROVAL. DTSCS13 +02523 IF LCCM-NO-MSG DTSCS13 +02524 MOVE CATB-CURSOR TO MAP-VERIFY-L DTSCS13 +02525 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-VERIFY-A DTSCS13 +02526 MOVE CATB-ASKIP-BRT-MDTOFF TO MAP-VERIFY-LIT-A DTSCS13 +02527 MOVE 'VERIFY?' TO MAP-VERIFY-LIT DTSCS13 +02528 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS13 +02529 SET CURSOR-SET-YES TO TRUE DTSCS13 +02530 END-IF. DTSCS13 +02531 DTSCS13 +02532 *** MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-STAT-A (2). DTSCS13 +02533 * IF LCCM-NO-MSG DTSCS13 +02534 * MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS13 +02535 * SET CURSOR-SET-YES TO TRUE DTSCS13 +02536 * MOVE CATB-CURSOR TO MAP-STAT-L (2) DTSCS13 +02537 * IF LCCM-OP-IS-FLD-DESK-88 DTSCS13 +02538 * OR LCCM-OP-IS-ACCOUNTING-DESK-88 DTSCS13 +02539 * MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-VERIFY-A DTSCS13 +02540 * MOVE CATB-ASKIP-BRT-MDTOFF TO MAP-VERIFY-LIT-A DTSCS13 +02541 * MOVE 'VERIFY?' TO MAP-VERIFY-LIT DTSCS13 +02542 * END-IF DTSCS13 +02543 *** END-IF. DTSCS13 +02544 S1601-EXIT. EXIT. DTSCS13 +02545 SKIP3 DTSCS13 +02546 S1602-ERROR. DTSCS13 +02547 *** >> MODIFIED TO ALLOW STAFF TO BYPASS EDIT WITHOUT DTSCS13 +02548 *** >> SUPERVISOR APPROVAL. DTSCS13 +02549 IF LCCM-NO-MSG DTSCS13 +02550 MOVE CATB-CURSOR TO MAP-VERIFY-L DTSCS13 +02551 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-VERIFY-A DTSCS13 +02552 MOVE CATB-ASKIP-BRT-MDTOFF TO MAP-VERIFY-LIT-A DTSCS13 +02553 MOVE 'VERIFY?' TO MAP-VERIFY-LIT DTSCS13 +02554 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS13 +02555 SET CURSOR-SET-YES TO TRUE DTSCS13 +02556 END-IF. DTSCS13 +02557 DTSCS13 +02558 *** IF WRK-DC-ADDR-YES-88 (1) DTSCS13 +02559 * MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-DLV1-A (1) DTSCS13 +02560 * MAP-DLV2-A (1) DTSCS13 +02561 * ELSE DTSCS13 +02562 * MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-DLV1-A (2) DTSCS13 +02563 * MAP-DLV2-A (2) DTSCS13 +02564 * END-IF. DTSCS13 +02565 * DTSCS13 +02566 * IF LCCM-NO-MSG DTSCS13 +02567 * MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS13 +02568 * IF WRK-DC-ADDR-YES-88 (1) DTSCS13 +02569 * MOVE CATB-CURSOR TO MAP-DLV1-L (1) DTSCS13 +02570 * ELSE DTSCS13 +02571 * MOVE CATB-CURSOR TO MAP-DLV1-L (2) DTSCS13 +02572 * END-IF DTSCS13 +02573 * SET CURSOR-SET-YES TO TRUE DTSCS13 +02574 * IF LCCM-OP-IS-FLD-DESK-88 DTSCS13 +02575 * OR LCCM-OP-IS-ACCOUNTING-DESK-88 DTSCS13 +02576 * MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-VERIFY-A DTSCS13 +02577 * MOVE CATB-ASKIP-BRT-MDTOFF TO MAP-VERIFY-LIT-A DTSCS13 +02578 * MOVE 'VERIFY?' TO MAP-VERIFY-LIT DTSCS13 +02579 * END-IF DTSCS13 +02580 *** END-IF. DTSCS13 +02581 S1602-EXIT. EXIT. DTSCS13 +02582 SKIP3 DTSCS13 +02583 /*****************************************************************DTSCS13 +02584 * LOCK SCREEN FOR UPDATE CONFIRMATION *DTSCS13 +02585 ******************************************************************DTSCS13 +02586 S5100-SET-LOCK-ATTRB. DTSCS13 +02587 MOVE CATB-ASKIP-BRT-MDTON TO SCR-ATB-AN DTSCS13 +02588 SCR-ATB-NUM. DTSCS13 02589 DTSCS13 -02590 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS13 -02591 DTSCS13 -02592 PERFORM S5120-RESTORE-ATTRB THRU S5120-EXIT DTSCS13 -02593 VARYING WRK-TAD FROM 1 BY 1 DTSCS13 -02594 UNTIL WRK-TAD GREATER THAN 2. DTSCS13 +02590 PERFORM S5110-HOLD-ATTRB THRU S5110-EXIT DTSCS13 +02591 VARYING WRK-TAD FROM 1 BY 1 DTSCS13 +02592 UNTIL WRK-TAD GREATER THAN 2. DTSCS13 +02593 DTSCS13 +02594 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS13 02595 DTSCS13 -02596 MOVE CATB-ASKIP-BRT-MDTON TO MAP-EMP-NO-1-A DTSCS13 -02597 MAP-EMP-NO-2-A DTSCS13 -02598 MAP-GOTO-A. DTSCS13 -02599 S5100-EXIT. EXIT. DTSCS13 -02600 SKIP3 DTSCS13 -02601 S5110-HOLD-ATTRB. DTSCS13 -02602 MOVE MAP-ATTN-A (WRK-TAD) TO HOLD-ATTN-A (WRK-TAD). DTSCS13 -02603 MOVE MAP-DLV1-A (WRK-TAD) TO HOLD-DLV1-A (WRK-TAD). DTSCS13 -02604 MOVE MAP-DLV2-A (WRK-TAD) TO HOLD-DLV2-A (WRK-TAD). DTSCS13 -02605 MOVE MAP-CITY-A (WRK-TAD) TO HOLD-CITY-A (WRK-TAD). DTSCS13 -02606 MOVE MAP-STAT-A (WRK-TAD) TO HOLD-STAT-A (WRK-TAD). DTSCS13 -02607 MOVE MAP-ZIPC-A (WRK-TAD) TO HOLD-ZIPC-A (WRK-TAD). DTSCS13 -02608 S5110-EXIT. EXIT. DTSCS13 -02609 SKIP3 DTSCS13 -02610 S5120-RESTORE-ATTRB. DTSCS13 -02611 IF HOLD-ATTN-A (WRK-TAD) = CATB-UNPROT-NORM-AN-MDTON DTSCS13 -02612 MOVE CATB-ASKIP-NORM-MDTON TO MAP-ATTN-A (WRK-TAD). DTSCS13 -02613 IF HOLD-DLV1-A (WRK-TAD) = CATB-UNPROT-NORM-AN-MDTON DTSCS13 -02614 MOVE CATB-ASKIP-NORM-MDTON TO MAP-DLV1-A (WRK-TAD). DTSCS13 -02615 IF HOLD-DLV2-A (WRK-TAD) = CATB-UNPROT-NORM-AN-MDTON DTSCS13 -02616 MOVE CATB-ASKIP-NORM-MDTON TO MAP-DLV2-A (WRK-TAD). DTSCS13 -02617 IF HOLD-CITY-A (WRK-TAD) = CATB-UNPROT-NORM-AN-MDTON DTSCS13 -02618 MOVE CATB-ASKIP-NORM-MDTON TO MAP-CITY-A (WRK-TAD). DTSCS13 -02619 IF HOLD-STAT-A (WRK-TAD) = CATB-UNPROT-NORM-AN-MDTON DTSCS13 -02620 MOVE CATB-ASKIP-NORM-MDTON TO MAP-STAT-A (WRK-TAD). DTSCS13 -02621 IF HOLD-ZIPC-A (WRK-TAD) = CATB-UNPROT-NORM-AN-MDTON DTSCS13 -02622 MOVE CATB-ASKIP-NORM-MDTON TO MAP-ZIPC-A (WRK-TAD). DTSCS13 -02623 S5120-EXIT. EXIT. DTSCS13 -02624 SKIP3 DTSCS13 -02625 ******************************************************************DTSCS13 -02626 * SET ATTIBUTE BYTES FOR UPDATE ACCESS *DTSCS13 -02627 ******************************************************************DTSCS13 -02628 S5200-SET-UPDATE-ATTRB. DTSCS13 -02629 MOVE CATB-UNPROT-BRT-AN-MDTON TO SCR-ATB-AN. DTSCS13 -02630 MOVE CATB-UNPROT-BRT-NUM-MDTON TO SCR-ATB-NUM. DTSCS13 -02631 DTSCS13 -02632 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS13 -02633 S5200-EXIT. EXIT. DTSCS13 -02634 SKIP3 DTSCS13 -02635 ******************************************************************DTSCS13 -02636 * SET ATTRIBUTE BYTES FOR INQUIRY STATUS *DTSCS13 -02637 ******************************************************************DTSCS13 -02638 S5300-SET-INQ-ATTRB. DTSCS13 -02639 MOVE CATB-ASKIP-BRT-MDTOFF TO SCR-ATB-AN DTSCS13 -02640 SCR-ATB-NUM. DTSCS13 -02641 DTSCS13 -02642 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS13 -02643 S5300-EXIT. EXIT. DTSCS13 -02644 /*****************************************************************DTSCS13 -02645 * DO IT *DTSCS13 -02646 ******************************************************************DTSCS13 -02647 S5900-SET-ATTRB. DTSCS13 -02648 DTSCS13 -02649 MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-EMP-NO-1-A DTSCS13 -02650 MAP-EMP-NO-2-A. DTSCS13 -02651 SKIP3 DTSCS13 -02652 MOVE SCR-ATB-AN TO MAP-PRIMARY-NAME-A DTSCS13 -02653 MAP-ENTITY-NAME-IND-A DTSCS13 -02654 MAP-FISC-AGNT-CD-A DTSCS13 -02655 MAP-ENTITY-NAME-A. DTSCS13 -02656 DTSCS13 -02657 PERFORM S5910-ADDRESS-A THRU S5910-EXIT DTSCS13 -02658 VARYING WRK-TAD FROM 1 BY 1 DTSCS13 -02659 UNTIL WRK-TAD GREATER THAN 2. DTSCS13 -02660 SKIP3 DTSCS13 -02661 MOVE CATB-ASKIP-DRK-MDTOFF TO MAP-VERIFY-A. DTSCS13 -02662 MOVE CATB-ASKIP-DRK-MDTOFF TO MAP-VERIFY-LIT-A. DTSCS13 -02663 DTSCS13 -02664 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-GOTO-A. DTSCS13 -02665 DTSCS13 -02666 S5900-EXIT. EXIT. DTSCS13 -02667 SKIP3 DTSCS13 -02668 S5910-ADDRESS-A. DTSCS13 -02669 MOVE SCR-ATB-AN TO MAP-ATTN-A (WRK-TAD) DTSCS13 -02670 MAP-DLV1-A (WRK-TAD) DTSCS13 -02671 MAP-DLV2-A (WRK-TAD) DTSCS13 -02672 MAP-CIND-A (WRK-TAD) DTSCS13 -02673 MAP-CITY-A (WRK-TAD) DTSCS13 -02674 MAP-STAT-A (WRK-TAD) DTSCS13 -02675 MAP-ZIPC-A (WRK-TAD) DTSCS13 -02676 MAP-EMAIL-A(WRK-TAD) DTSCS13 -02677 MAP-MEMO-A (WRK-TAD) DTSCS13 -02678 MAP-MISS-A (WRK-TAD) DTSCS13 -02679 MAP-ADDR-A (WRK-TAD) DTSCS13 -02680 PERFORM S5911-PHONE-A THRU S5911-EXIT DTSCS13 -02681 VARYING WRK-PHONE FROM 1 BY 1 DTSCS13 -02682 UNTIL WRK-PHONE GREATER THAN 3. DTSCS13 -02683 S5910-EXIT. EXIT. DTSCS13 -02684 SKIP3 DTSCS13 -02685 S5911-PHONE-A. DTSCS13 -02686 MOVE SCR-ATB-NUM TO MAP-PHONE-A-CD-A (WRK-TAD, WRK-PHONE) DTSCS13 -02687 MAP-PHONE-PREF-A (WRK-TAD, WRK-PHONE) DTSCS13 -02688 MAP-PHONE-SUFF-A (WRK-TAD, WRK-PHONE) DTSCS13 -02689 MAP-PHONE-EXT-A (WRK-TAD, WRK-PHONE). DTSCS13 -02690 S5911-EXIT. EXIT. DTSCS13 -02691 /*****************************************************************DTSCS13 -02692 * FILE READ COMMON PREPARATION ROUTINES *DTSCS13 -02693 ******************************************************************DTSCS13 -02694 S8100-READ-MPRF. DTSCS13 -02695 MOVE LOW-VALUES TO MPRF-KEY-AREA. DTSCS13 -02696 MOVE WRK-EMP-NO TO MPRF-EMP-NO. DTSCS13 -02697 SET MPRF-PRF-88 TO TRUE. DTSCS13 -02698 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSCS13 -02699 PERFORM S810-READ THRU S810-EXIT. DTSCS13 -02700 S8100-EXIT. EXIT. DTSCS13 -02701 SKIP3 DTSCS13 -02702 S8200-READ-MTAD. DTSCS13 -02703 MOVE LOW-VALUES TO MTAD-KEY-AREA. DTSCS13 -02704 MOVE WRK-EMP-NO TO MTAD-EMP-NO. DTSCS13 -02705 SET MTAD-TAD-88 TO TRUE. DTSCS13 -02706 MOVE WRK-TAD TO MTAD-ID-NO. DTSCS13 -02707 MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA. DTSCS13 -02708 PERFORM S810-READ THRU S810-EXIT. DTSCS13 -02709 S8200-EXIT. EXIT. DTSCS13 -02710 S8300-READ-MFAE. DTSCS13 -02711 SET WRK-MFAE-NO-88 TO TRUE. DTSCS13 -02712 DTSCS13 -02713 MOVE LOW-VALUES TO MFAE-KEY-AREA. DTSCS13 -02714 DTSCS13 -02715 MOVE WRK-EMP-NO TO MFAE-EMP-NO. DTSCS13 +02596 PERFORM S5120-RESTORE-ATTRB THRU S5120-EXIT DTSCS13 +02597 VARYING WRK-TAD FROM 1 BY 1 DTSCS13 +02598 UNTIL WRK-TAD GREATER THAN 2. DTSCS13 +02599 DTSCS13 +02600 MOVE CATB-ASKIP-BRT-MDTON TO MAP-EMP-NO-1-A DTSCS13 +02601 MAP-EMP-NO-2-A DTSCS13 +02602 MAP-GOTO-A. DTSCS13 +02603 S5100-EXIT. EXIT. DTSCS13 +02604 SKIP3 DTSCS13 +02605 S5110-HOLD-ATTRB. DTSCS13 +02606 MOVE MAP-ATTN-A (WRK-TAD) TO HOLD-ATTN-A (WRK-TAD). DTSCS13 +02607 MOVE MAP-DLV1-A (WRK-TAD) TO HOLD-DLV1-A (WRK-TAD). DTSCS13 +02608 MOVE MAP-DLV2-A (WRK-TAD) TO HOLD-DLV2-A (WRK-TAD). DTSCS13 +02609 MOVE MAP-CITY-A (WRK-TAD) TO HOLD-CITY-A (WRK-TAD). DTSCS13 +02610 MOVE MAP-STAT-A (WRK-TAD) TO HOLD-STAT-A (WRK-TAD). DTSCS13 +02611 MOVE MAP-ZIPC-A (WRK-TAD) TO HOLD-ZIPC-A (WRK-TAD). DTSCS13 +02612 S5110-EXIT. EXIT. DTSCS13 +02613 SKIP3 DTSCS13 +02614 S5120-RESTORE-ATTRB. DTSCS13 +02615 IF HOLD-ATTN-A (WRK-TAD) = CATB-UNPROT-NORM-AN-MDTON DTSCS13 +02616 MOVE CATB-ASKIP-NORM-MDTON TO MAP-ATTN-A (WRK-TAD). DTSCS13 +02617 IF HOLD-DLV1-A (WRK-TAD) = CATB-UNPROT-NORM-AN-MDTON DTSCS13 +02618 MOVE CATB-ASKIP-NORM-MDTON TO MAP-DLV1-A (WRK-TAD). DTSCS13 +02619 IF HOLD-DLV2-A (WRK-TAD) = CATB-UNPROT-NORM-AN-MDTON DTSCS13 +02620 MOVE CATB-ASKIP-NORM-MDTON TO MAP-DLV2-A (WRK-TAD). DTSCS13 +02621 IF HOLD-CITY-A (WRK-TAD) = CATB-UNPROT-NORM-AN-MDTON DTSCS13 +02622 MOVE CATB-ASKIP-NORM-MDTON TO MAP-CITY-A (WRK-TAD). DTSCS13 +02623 IF HOLD-STAT-A (WRK-TAD) = CATB-UNPROT-NORM-AN-MDTON DTSCS13 +02624 MOVE CATB-ASKIP-NORM-MDTON TO MAP-STAT-A (WRK-TAD). DTSCS13 +02625 IF HOLD-ZIPC-A (WRK-TAD) = CATB-UNPROT-NORM-AN-MDTON DTSCS13 +02626 MOVE CATB-ASKIP-NORM-MDTON TO MAP-ZIPC-A (WRK-TAD). DTSCS13 +02627 S5120-EXIT. EXIT. DTSCS13 +02628 SKIP3 DTSCS13 +02629 ******************************************************************DTSCS13 +02630 * SET ATTIBUTE BYTES FOR UPDATE ACCESS *DTSCS13 +02631 ******************************************************************DTSCS13 +02632 S5200-SET-UPDATE-ATTRB. DTSCS13 +02633 MOVE CATB-UNPROT-BRT-AN-MDTON TO SCR-ATB-AN. DTSCS13 +02634 MOVE CATB-UNPROT-BRT-NUM-MDTON TO SCR-ATB-NUM. DTSCS13 +02635 DTSCS13 +02636 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS13 +02637 S5200-EXIT. EXIT. DTSCS13 +02638 SKIP3 DTSCS13 +02639 ******************************************************************DTSCS13 +02640 * SET ATTRIBUTE BYTES FOR INQUIRY STATUS *DTSCS13 +02641 ******************************************************************DTSCS13 +02642 S5300-SET-INQ-ATTRB. DTSCS13 +02643 MOVE CATB-ASKIP-BRT-MDTOFF TO SCR-ATB-AN DTSCS13 +02644 SCR-ATB-NUM. DTSCS13 +02645 DTSCS13 +02646 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS13 +02647 S5300-EXIT. EXIT. DTSCS13 +02648 /*****************************************************************DTSCS13 +02649 * DO IT *DTSCS13 +02650 ******************************************************************DTSCS13 +02651 S5900-SET-ATTRB. DTSCS13 +02652 DTSCS13 +02653 MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-EMP-NO-1-A DTSCS13 +02654 MAP-EMP-NO-2-A. DTSCS13 +02655 SKIP3 DTSCS13 +02656 MOVE SCR-ATB-AN TO MAP-PRIMARY-NAME-A DTSCS13 +02657 MAP-ENTITY-NAME-IND-A DTSCS13 +02658 MAP-FISC-AGNT-CD-A DTSCS13 +02659 MAP-ENTITY-NAME-A. DTSCS13 +02660 DTSCS13 +02661 PERFORM S5910-ADDRESS-A THRU S5910-EXIT DTSCS13 +02662 VARYING WRK-TAD FROM 1 BY 1 DTSCS13 +02663 UNTIL WRK-TAD GREATER THAN 2. DTSCS13 +02664 SKIP3 DTSCS13 +02665 MOVE CATB-ASKIP-DRK-MDTOFF TO MAP-VERIFY-A. DTSCS13 +02666 MOVE CATB-ASKIP-DRK-MDTOFF TO MAP-VERIFY-LIT-A. DTSCS13 +02667 DTSCS13 +02668 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-GOTO-A. DTSCS13 +02669 DTSCS13 +02670 S5900-EXIT. EXIT. DTSCS13 +02671 SKIP3 DTSCS13 +02672 S5910-ADDRESS-A. DTSCS13 +02673 MOVE SCR-ATB-AN TO MAP-ATTN-A (WRK-TAD) DTSCS13 +02674 MAP-DLV1-A (WRK-TAD) DTSCS13 +02675 MAP-DLV2-A (WRK-TAD) DTSCS13 +02676 MAP-CIND-A (WRK-TAD) DTSCS13 +02677 MAP-CITY-A (WRK-TAD) DTSCS13 +02678 MAP-STAT-A (WRK-TAD) DTSCS13 +02679 MAP-ZIPC-A (WRK-TAD) DTSCS13 +02680 MAP-EMAIL-A(WRK-TAD) DTSCS13 +02681 MAP-MEMO-A (WRK-TAD) DTSCS13 +02682 MAP-MISS-A (WRK-TAD) DTSCS13 +02683 MAP-ADDR-A (WRK-TAD) DTSCS13 +02684 PERFORM S5911-PHONE-A THRU S5911-EXIT DTSCS13 +02685 VARYING WRK-PHONE FROM 1 BY 1 DTSCS13 +02686 UNTIL WRK-PHONE GREATER THAN 3. DTSCS13 +02687 S5910-EXIT. EXIT. DTSCS13 +02688 SKIP3 DTSCS13 +02689 S5911-PHONE-A. DTSCS13 +02690 MOVE SCR-ATB-NUM TO MAP-PHONE-A-CD-A (WRK-TAD, WRK-PHONE) DTSCS13 +02691 MAP-PHONE-PREF-A (WRK-TAD, WRK-PHONE) DTSCS13 +02692 MAP-PHONE-SUFF-A (WRK-TAD, WRK-PHONE) DTSCS13 +02693 MAP-PHONE-EXT-A (WRK-TAD, WRK-PHONE). DTSCS13 +02694 S5911-EXIT. EXIT. DTSCS13 +02695 /*****************************************************************DTSCS13 +02696 * FILE READ COMMON PREPARATION ROUTINES *DTSCS13 +02697 ******************************************************************DTSCS13 +02698 S8100-READ-MPRF. DTSCS13 +02699 MOVE LOW-VALUES TO MPRF-KEY-AREA. DTSCS13 +02700 MOVE WRK-EMP-NO TO MPRF-EMP-NO. DTSCS13 +02701 SET MPRF-PRF-88 TO TRUE. DTSCS13 +02702 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSCS13 +02703 PERFORM S810-READ THRU S810-EXIT. DTSCS13 +02704 S8100-EXIT. EXIT. DTSCS13 +02705 SKIP3 DTSCS13 +02706 S8200-READ-MTAD. DTSCS13 +02707 MOVE LOW-VALUES TO MTAD-KEY-AREA. DTSCS13 +02708 MOVE WRK-EMP-NO TO MTAD-EMP-NO. DTSCS13 +02709 SET MTAD-TAD-88 TO TRUE. DTSCS13 +02710 MOVE WRK-TAD TO MTAD-ID-NO. DTSCS13 +02711 MOVE MTAD-KEY-AREA TO MSKL-KEY-AREA. DTSCS13 +02712 PERFORM S810-READ THRU S810-EXIT. DTSCS13 +02713 S8200-EXIT. EXIT. DTSCS13 +02714 S8300-READ-MFAE. DTSCS13 +02715 SET WRK-MFAE-NO-88 TO TRUE. DTSCS13 02716 DTSCS13 -02717 SET MFAE-FAE-88 TO TRUE. DTSCS13 +02717 MOVE LOW-VALUES TO MFAE-KEY-AREA. DTSCS13 02718 DTSCS13 -02719 SET MFAE-SERVICE-CORRESPOND-88 TO TRUE. DTSCS13 +02719 MOVE WRK-EMP-NO TO MFAE-EMP-NO. DTSCS13 02720 DTSCS13 -02721 MOVE MFAE-KEY-AREA TO MSKL-KEY-AREA. DTSCS13 +02721 SET MFAE-FAE-88 TO TRUE. DTSCS13 02722 DTSCS13 -02723 PERFORM S810-READ THRU S810-EXIT. DTSCS13 +02723 SET MFAE-SERVICE-CORRESPOND-88 TO TRUE. DTSCS13 02724 DTSCS13 -02725 IF L810-OK-88 DTSCS13 -02726 MOVE MSKL-REC TO MFAE-REC DTSCS13 -02727 SET WRK-MFAE-YES-88 TO TRUE DTSCS13 -02728 END-IF. DTSCS13 -02729 DTSCS13 -02730 S8300-EXIT. DTSCS13 -02731 EXIT. DTSCS13 -02732 S8400-READ-FFIS. DTSCS13 -02733 SET WRK-FFIS-NO-88 TO TRUE. DTSCS13 -02734 DTSCS13 -02735 MOVE LOW-VALUES TO FFIS-KEY-AREA. DTSCS13 -02736 MOVE WRK-FISC-AGNT-CD TO FFIS-FISCAL-AGENT-CD. DTSCS13 -02737 SET FFIS-SERVICE-CORRESPOND-88 TO TRUE. DTSCS13 -02738 SET FFIS-FIS-88 TO TRUE. DTSCS13 -02739 MOVE FFIS-KEY-AREA TO FSKL-KEY-AREA. DTSCS13 -02740 DTSCS13 -02741 PERFORM S831-READ THRU S831-EXIT. DTSCS13 -02742 DTSCS13 -02743 IF L831-OK-88 DTSCS13 -02744 MOVE FSKL-REC TO FFIS-REC DTSCS13 -02745 SET WRK-FFIS-YES-88 TO TRUE DTSCS13 -02746 END-IF. DTSCS13 -02747 DTSCS13 -02748 S8400-EXIT. DTSCS13 -02749 EXIT. DTSCS13 -02750 /*****************************************************************DTSCS13 -02751 * MAP ROUTINES *DTSCS13 -02752 ******************************************************************DTSCS13 -02753 S9100-RECEIVE. DTSCS13 -02754 SET L851-RECEIVE-88 TO TRUE. DTSCS13 -02755 DTSCS13 -02756 MOVE WRK-SCR-ID TO L851-SCR-ID. DTSCS13 -02757 DTSCS13 -02758 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS13 +02725 MOVE MFAE-KEY-AREA TO MSKL-KEY-AREA. DTSCS13 +02726 DTSCS13 +02727 PERFORM S810-READ THRU S810-EXIT. DTSCS13 +02728 DTSCS13 +02729 IF L810-OK-88 DTSCS13 +02730 MOVE MSKL-REC TO MFAE-REC DTSCS13 +02731 SET WRK-MFAE-YES-88 TO TRUE DTSCS13 +02732 END-IF. DTSCS13 +02733 DTSCS13 +02734 S8300-EXIT. DTSCS13 +02735 EXIT. DTSCS13 +02736 S8400-READ-FFIS. DTSCS13 +02737 SET WRK-FFIS-NO-88 TO TRUE. DTSCS13 +02738 DTSCS13 +02739 MOVE LOW-VALUES TO FFIS-KEY-AREA. DTSCS13 +02740 MOVE WRK-FISC-AGNT-CD TO FFIS-FISCAL-AGENT-CD. DTSCS13 +02741 SET FFIS-SERVICE-CORRESPOND-88 TO TRUE. DTSCS13 +02742 SET FFIS-FIS-88 TO TRUE. DTSCS13 +02743 MOVE FFIS-KEY-AREA TO FSKL-KEY-AREA. DTSCS13 +02744 DTSCS13 +02745 PERFORM S831-READ THRU S831-EXIT. DTSCS13 +02746 DTSCS13 +02747 IF L831-OK-88 DTSCS13 +02748 MOVE FSKL-REC TO FFIS-REC DTSCS13 +02749 SET WRK-FFIS-YES-88 TO TRUE DTSCS13 +02750 END-IF. DTSCS13 +02751 DTSCS13 +02752 S8400-EXIT. DTSCS13 +02753 EXIT. DTSCS13 +02754 /*****************************************************************DTSCS13 +02755 * MAP ROUTINES *DTSCS13 +02756 ******************************************************************DTSCS13 +02757 S9100-RECEIVE. DTSCS13 +02758 SET L851-RECEIVE-88 TO TRUE. DTSCS13 02759 DTSCS13 -02760 MOVE L851-AID TO LCCM-AID. DTSCS13 -02761 MOVE L851-CURSOR TO LCCM-CURSOR. DTSCS13 -02762 S9100-EXIT. EXIT. DTSCS13 -02763 SKIP3 DTSCS13 -02764 ******************************************************************DTSCS13 -02765 * *DTSCS13 -02766 ******************************************************************DTSCS13 -02767 S9200-SEND-DATAONLY. DTSCS13 -02768 MOVE LOW-VALUES TO MAP-AREA. DTSCS13 -02769 DTSCS13 -02770 IF LCCM-NO-MSG DTSCS13 -02771 NEXT SENTENCE DTSCS13 -02772 ELSE DTSCS13 -02773 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS13 -02774 DTSCS13 -02775 IF CURSOR-SET-GOTO DTSCS13 -02776 MOVE CATB-CURSOR TO MAP-GOTO-L DTSCS13 -02777 ELSE DTSCS13 -02778 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L. DTSCS13 -02779 DTSCS13 -02780 SET L851-SEND-DATAONLY-88 TO TRUE. DTSCS13 -02781 DTSCS13 -02782 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS13 +02760 MOVE WRK-SCR-ID TO L851-SCR-ID. DTSCS13 +02761 DTSCS13 +02762 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS13 +02763 DTSCS13 +02764 MOVE L851-AID TO LCCM-AID. DTSCS13 +02765 MOVE L851-CURSOR TO LCCM-CURSOR. DTSCS13 +02766 S9100-EXIT. EXIT. DTSCS13 +02767 SKIP3 DTSCS13 +02768 ******************************************************************DTSCS13 +02769 * *DTSCS13 +02770 ******************************************************************DTSCS13 +02771 S9200-SEND-DATAONLY. DTSCS13 +02772 MOVE LOW-VALUES TO MAP-AREA. DTSCS13 +02773 DTSCS13 +02774 IF LCCM-NO-MSG DTSCS13 +02775 NEXT SENTENCE DTSCS13 +02776 ELSE DTSCS13 +02777 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS13 +02778 DTSCS13 +02779 IF CURSOR-SET-GOTO DTSCS13 +02780 MOVE CATB-CURSOR TO MAP-GOTO-L DTSCS13 +02781 ELSE DTSCS13 +02782 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L. DTSCS13 02783 DTSCS13 -02784 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS13 -02785 S9200-EXIT. EXIT. DTSCS13 -02786 SKIP3 DTSCS13 -02787 ******************************************************************DTSCS13 -02788 * *DTSCS13 -02789 ******************************************************************DTSCS13 -02790 S9300-SEND-MAP. DTSCS13 -02791 MOVE LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE. DTSCS13 -02792 MOVE LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME. DTSCS13 -02793 MOVE LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME. DTSCS13 -02794 DTSCS13 -02795 IF SCR-ACCESS-UPDATE DTSCS13 -02796 PERFORM S9310-UPDATE-FKEYS THRU S9310-EXIT DTSCS13 -02797 ELSE DTSCS13 -02798 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS13 -02799 DTSCS13 -02800 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS13 -02801 DTSCS13 -02802 IF CURSOR-SET-NO DTSCS13 -02803 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L. DTSCS13 -02804 DTSCS13 -02805 SET L851-SEND-88 TO TRUE. DTSCS13 -02806 DTSCS13 -02807 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS13 +02784 SET L851-SEND-DATAONLY-88 TO TRUE. DTSCS13 +02785 DTSCS13 +02786 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS13 +02787 DTSCS13 +02788 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS13 +02789 S9200-EXIT. EXIT. DTSCS13 +02790 SKIP3 DTSCS13 +02791 ******************************************************************DTSCS13 +02792 * *DTSCS13 +02793 ******************************************************************DTSCS13 +02794 S9300-SEND-MAP. DTSCS13 +02795 MOVE LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE. DTSCS13 +02796 MOVE LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME. DTSCS13 +02797 MOVE LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME. DTSCS13 +02798 DTSCS13 +02799 IF SCR-ACCESS-UPDATE DTSCS13 +02800 PERFORM S9310-UPDATE-FKEYS THRU S9310-EXIT DTSCS13 +02801 ELSE DTSCS13 +02802 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS13 +02803 DTSCS13 +02804 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS13 +02805 DTSCS13 +02806 IF CURSOR-SET-NO DTSCS13 +02807 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L. DTSCS13 02808 DTSCS13 -02809 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS13 -02810 S9300-EXIT. EXIT. DTSCS13 -02811 SKIP3 DTSCS13 -02812 S9310-UPDATE-FKEYS. DTSCS13 -02813 MOVE CFKD-MOD TO MAP-KEY-MOD. DTSCS13 -02814 * PERFORM S9321-JUMP-KEYS THRU S9321-EXIT. DTSCS13 -02815 DTSCS13 -02816 IF LCCM-SCR-CLEAR DTSCS13 -02817 MOVE LOW-VALUES TO MAP-KEY-MOD DTSCS13 -02818 ELSE DTSCS13 -02819 IF LCCM-SCR-UPDATE-LOCKED DTSCS13 -02820 MOVE LOW-VALUES TO MAP-KEY-MOD. DTSCS13 -02821 S9310-EXIT. EXIT. DTSCS13 -02822 SKIP3 DTSCS13 -02823 S9320-INQUIRY-FKEYS. DTSCS13 -02824 MOVE LOW-VALUES TO MAP-KEY-MOD. DTSCS13 -02825 * PERFORM S9321-JUMP-KEYS THRU S9321-EXIT. DTSCS13 -02826 S9320-EXIT. EXIT. DTSCS13 -02827 SKIP3 DTSCS13 -02828 *S9321-JUMP-KEYS. DTSCS13 -02829 * MOVE CFKD-REG-INQ TO MAP-KEY-REG-INQ. DTSCS13 -02830 * MOVE CFKD-REG-SEARCH TO MAP-KEY-SEARCH. DTSCS13 -02831 * MOVE 'F21=OPO' TO MAP-KEY-OPO. DTSCS13 -02832 *S9321-EXIT. EXIT. DTSCS13 -02833 SKIP3 DTSCS13 -02834 /*****************************************************************DTSCS13 -02835 * *DTSCS13 -02836 ******************************************************************DTSCS13 -02837 S9900-PREPARE-SEND. DTSCS13 -02838 MOVE WRK-SCR-ID TO L851-SCR-ID DTSCS13 -02839 LCCM-SCR-ID. DTSCS13 -02840 MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND. DTSCS13 -02841 MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE. DTSCS13 -02842 S9900-EXIT. EXIT. DTSCS13 +02809 SET L851-SEND-88 TO TRUE. DTSCS13 +02810 DTSCS13 +02811 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS13 +02812 DTSCS13 +02813 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS13 +02814 S9300-EXIT. EXIT. DTSCS13 +02815 SKIP3 DTSCS13 +02816 S9310-UPDATE-FKEYS. DTSCS13 +02817 MOVE CFKD-MOD TO MAP-KEY-MOD. DTSCS13 +02818 * PERFORM S9321-JUMP-KEYS THRU S9321-EXIT. DTSCS13 +02819 DTSCS13 +02820 IF LCCM-SCR-CLEAR DTSCS13 +02821 MOVE LOW-VALUES TO MAP-KEY-MOD DTSCS13 +02822 ELSE DTSCS13 +02823 IF LCCM-SCR-UPDATE-LOCKED DTSCS13 +02824 MOVE LOW-VALUES TO MAP-KEY-MOD. DTSCS13 +02825 S9310-EXIT. EXIT. DTSCS13 +02826 SKIP3 DTSCS13 +02827 S9320-INQUIRY-FKEYS. DTSCS13 +02828 MOVE LOW-VALUES TO MAP-KEY-MOD. DTSCS13 +02829 * PERFORM S9321-JUMP-KEYS THRU S9321-EXIT. DTSCS13 +02830 S9320-EXIT. EXIT. DTSCS13 +02831 SKIP3 DTSCS13 +02832 *S9321-JUMP-KEYS. DTSCS13 +02833 * MOVE CFKD-REG-INQ TO MAP-KEY-REG-INQ. DTSCS13 +02834 * MOVE CFKD-REG-SEARCH TO MAP-KEY-SEARCH. DTSCS13 +02835 * MOVE 'F21=OPO' TO MAP-KEY-OPO. DTSCS13 +02836 *S9321-EXIT. EXIT. DTSCS13 +02837 SKIP3 DTSCS13 +02838 /*****************************************************************DTSCS13 +02839 * *DTSCS13 +02840 ******************************************************************DTSCS13 +02841 S9900-PREPARE-SEND. DTSCS13 +02842 MOVE WRK-SCR-ID TO L851-SCR-ID DTSCS13 +02843 LCCM-SCR-ID. DTSCS13 +02844 MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND. DTSCS13 +02845 MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE. DTSCS13 +02846 S9900-EXIT. EXIT. DTSCS13 diff --git a/CICS/DTSCS26.cob b/CICS/DTSCS26.cob index 5094669..285f34e 100644 --- a/CICS/DTSCS26.cob +++ b/CICS/DTSCS26.cob @@ -1,6 +1,6 @@ -00001 IDENTIFICATION DIVISION. 06/20/12 +00001 IDENTIFICATION DIVISION. 11/18/24 00002 PROGRAM-ID. DTSCS26. DTSCS26 -00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV052 +00003 AUTHOR. TRICOASTAL CONSULTING LTD. LV010 00004 DATE-WRITTEN. NOVEMBER 1991. DTSCS26 00005 DATE-COMPILED. DTSCS26 00006 SKIP3 DTSCS26 @@ -80,5150 +80,5187 @@ 00080 * CHANGE ABOVE. DTSCS26 00081 * REFERENCE: PROGRAMMER: GD1 DTSCS26 00082 * DTSCS26 -00083 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS26 -00084 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS26 -00085 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSCS26 -00086 * DTSCS26 -00087 * DTSCS26 -00088 * DESCRIPTION: DTSCS26 -00089 * DTSCS26 -00090 * DTSCS26 -00091 * CLEAR: DTSCS26 -00092 * DTSCS26 -00093 * FIELD DISPLAYED: DTSCS26 +00083 * CL**6 +00084 * 10/25/2012 MODIFIED CODE TO CHECK FOR SUPERVISORS APPROVAL CL**6 +00085 * BEFORE A WRITE OFF TRANSACTION CAN BE UPDATED. CL**6 +00086 * MOVE PARA S1400-EMP-NO TO S1150-EMP-NO BECAUSE CL**6 +00087 * NEEDED TO PASS EMP-NO TO CU084 MODULE TO VERIFY CL**6 +00088 * APPROVAL CL**6 +00089 * REFERENCE: PROGRAMMER: ZL1 CL**6 +00090 * CL**6 +00091 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS26 +00092 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS26 +00093 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSCS26 00094 * DTSCS26 -00095 * MAP-BATCH-NO DTSCS26 -00096 * (FROM LCCM-BATCH-NO; MOVE +0 TO LCCM-BATCH-NO; DTSCS26 -00097 * MOVE +0 TO LCCM-ITEM-NO) DTSCS26 +00095 * DTSCS26 +00096 * DESCRIPTION: DTSCS26 +00097 * DTSCS26 00098 * DTSCS26 -00099 * MAP-ENTRY-MODE DTSCS26 -00100 * (FROM LCCM-ENTRY-MODE) DTSCS26 -00101 * DTSCS26 +00099 * CLEAR: DTSCS26 +00100 * DTSCS26 +00101 * FIELD DISPLAYED: DTSCS26 00102 * DTSCS26 -00103 * JUMP: DTSCS26 -00104 * DTSCS26 -00105 * STANDARD DTSCS26 +00103 * MAP-BATCH-NO DTSCS26 +00104 * (FROM LCCM-BATCH-NO; MOVE +0 TO LCCM-BATCH-NO; DTSCS26 +00105 * MOVE +0 TO LCCM-ITEM-NO) DTSCS26 00106 * DTSCS26 -00107 * DTSCS26 -00108 * INQUIRY: DTSCS26 +00107 * MAP-ENTRY-MODE DTSCS26 +00108 * (FROM LCCM-ENTRY-MODE) DTSCS26 00109 * DTSCS26 00110 * DTSCS26 -00111 * CONTROL FIELDS: MAP-DOC-NO (MAP-BATCH-NO AND MAP-ITEM-NO) DTSCS26 +00111 * JUMP: DTSCS26 00112 * DTSCS26 -00113 * DTSCS26 -00114 * JUMP IN: DTSCS26 +00113 * STANDARD DTSCS26 +00114 * DTSCS26 00115 * DTSCS26 -00116 * IF LCCM-BATCH-NO = 0 DTSCS26 -00117 * CLEAR DTSCS26 -00118 * ELSE DTSCS26 -00119 * IF LCCM-ITEM-NO = 0 DTSCS26 -00120 * CLEAR DTSCS26 -00121 * ELSE DTSCS26 -00122 * IF LCCM-DOC-NO EXISTS ON ACCT TRAN FILE DTSCS26 -00123 * IF LCCM-DOC-NO IS AN AADJ RECORD DTSCS26 -00124 * DISPLAY THE AADJ RECORD DTSCS26 -00125 * ELSE DTSCS26 -00126 * JUMP TO APPROPRIATE SCREEN TO DISPLAY DTSCS26 -00127 * A* RECORD TYPE DTSCS26 -00128 * ELSE DTSCS26 -00129 * CLEAR; DISPLAY 'NO RECORD' MESSAGE. DTSCS26 -00130 * DTSCS26 -00131 * DTSCS26 -00132 * F9 DTSCS26 -00133 * DTSCS26 -00134 * IF MAP-BATCH-NO ENTERED DTSCS26 -00135 * IF MAP-ITEM-NO ENTERED DTSCS26 -00136 * IF MAP-DOC-NO EXISTS ON THE ACCT TRAN FILE DTSCS26 -00137 * IF MAP-DOC-NO ON ACT FILE IS AN AADJ RECORD DTSCS26 -00138 * DISPLAY MAP-DOC-NO RECORD FROM ACT FILE DTSCS26 -00139 * ELSE DTSCS26 -00140 * JUMP TO APPROPRIATE SCREEN TO DISPLAY DTSCS26 -00141 * A* RECORD TYPE DTSCS26 -00142 * ELSE DTSCS26 -00143 * CLEAR; DISPLAY 'NO RECORD' MESSAGE DTSCS26 -00144 * ELSE DTSCS26 -00145 * CLEAR; DISPLAY 'PLEASE ENTER' MESSAGE DTSCS26 -00146 * ELSE DTSCS26 -00147 * IF LCCM-BATCH-NO = 0 DTSCS26 -00148 * CLEAR; DISPLAY 'PLEASE ENTER' MESSAGE DTSCS26 -00149 * ELSE DTSCS26 -00150 * IF LCCM-ITEM-NO = 0 DTSCS26 -00151 * CLEAR; DISPLAY 'PLEASE ENTER' MESSAGE DTSCS26 +00116 * INQUIRY: DTSCS26 +00117 * DTSCS26 +00118 * DTSCS26 +00119 * CONTROL FIELDS: MAP-DOC-NO (MAP-BATCH-NO AND MAP-ITEM-NO) DTSCS26 +00120 * DTSCS26 +00121 * DTSCS26 +00122 * JUMP IN: DTSCS26 +00123 * DTSCS26 +00124 * IF LCCM-BATCH-NO = 0 DTSCS26 +00125 * CLEAR DTSCS26 +00126 * ELSE DTSCS26 +00127 * IF LCCM-ITEM-NO = 0 DTSCS26 +00128 * CLEAR DTSCS26 +00129 * ELSE DTSCS26 +00130 * IF LCCM-DOC-NO EXISTS ON ACCT TRAN FILE DTSCS26 +00131 * IF LCCM-DOC-NO IS AN AADJ RECORD DTSCS26 +00132 * DISPLAY THE AADJ RECORD DTSCS26 +00133 * ELSE DTSCS26 +00134 * JUMP TO APPROPRIATE SCREEN TO DISPLAY DTSCS26 +00135 * A* RECORD TYPE DTSCS26 +00136 * ELSE DTSCS26 +00137 * CLEAR; DISPLAY 'NO RECORD' MESSAGE. DTSCS26 +00138 * DTSCS26 +00139 * DTSCS26 +00140 * F9 DTSCS26 +00141 * DTSCS26 +00142 * IF MAP-BATCH-NO ENTERED DTSCS26 +00143 * IF MAP-ITEM-NO ENTERED DTSCS26 +00144 * IF MAP-DOC-NO EXISTS ON THE ACCT TRAN FILE DTSCS26 +00145 * IF MAP-DOC-NO ON ACT FILE IS AN AADJ RECORD DTSCS26 +00146 * DISPLAY MAP-DOC-NO RECORD FROM ACT FILE DTSCS26 +00147 * ELSE DTSCS26 +00148 * JUMP TO APPROPRIATE SCREEN TO DISPLAY DTSCS26 +00149 * A* RECORD TYPE DTSCS26 +00150 * ELSE DTSCS26 +00151 * CLEAR; DISPLAY 'NO RECORD' MESSAGE DTSCS26 00152 * ELSE DTSCS26 -00153 * IF LCCM-DOC-NO EXISTS ON THE ACCT TRAN FILE DTSCS26 -00154 * IF LCCM-DOC-NO ON ACT FILE IS AN AADJ RECORD DTSCS26 -00155 * DISPLAY LCCM-DOC-NO RECORD FROM ACT FILE DTSCS26 -00156 * ELSE DTSCS26 -00157 * JUMP TO TRANSACTION ENTRY SCREEN FOR DTSCS26 -00158 * A* RECORD TYPE DTSCS26 -00159 * ELSE DTSCS26 -00160 * CLEAR; DISPLAY 'NO RECORD MESSAGE. DTSCS26 -00161 * DTSCS26 -00162 * DTSCS26 -00163 * F7, F8: DISPLAY PRIOR/NEXT A* RECORD. BREAK ON DTSCS26 -00164 * A*-BATCH-NO. IF THE PRIOR/NEXT RECORD ENCOUNTERED DTSCS26 -00165 * IS NOT AN AADJ RECORD (BUT IS IN MAP-BATCH-NO), DTSCS26 -00166 * AUTOMATICALLY JUMP TO THE APPROPRIATE SCREEN AND DTSCS26 -00167 * DISPLAY THE RECORD. DTSCS26 -00168 * DTSCS26 +00153 * CLEAR; DISPLAY 'PLEASE ENTER' MESSAGE DTSCS26 +00154 * ELSE DTSCS26 +00155 * IF LCCM-BATCH-NO = 0 DTSCS26 +00156 * CLEAR; DISPLAY 'PLEASE ENTER' MESSAGE DTSCS26 +00157 * ELSE DTSCS26 +00158 * IF LCCM-ITEM-NO = 0 DTSCS26 +00159 * CLEAR; DISPLAY 'PLEASE ENTER' MESSAGE DTSCS26 +00160 * ELSE DTSCS26 +00161 * IF LCCM-DOC-NO EXISTS ON THE ACCT TRAN FILE DTSCS26 +00162 * IF LCCM-DOC-NO ON ACT FILE IS AN AADJ RECORD DTSCS26 +00163 * DISPLAY LCCM-DOC-NO RECORD FROM ACT FILE DTSCS26 +00164 * ELSE DTSCS26 +00165 * JUMP TO TRANSACTION ENTRY SCREEN FOR DTSCS26 +00166 * A* RECORD TYPE DTSCS26 +00167 * ELSE DTSCS26 +00168 * CLEAR; DISPLAY 'NO RECORD MESSAGE. DTSCS26 00169 * DTSCS26 -00170 * LCCM-CURRENT-VALUES-AREA MAINTENANCE: DTSCS26 -00171 * DTSCS26 -00172 * LCCM-DOC-NO MAINTENANCE. DTSCS26 -00173 * DTSCS26 -00174 * LCCM-EMP-NO MAINTENANCE. DTSCS26 -00175 * DTSCS26 -00176 * LCCM-ENTRY-MODE MAINTENANCE. DTSCS26 +00170 * DTSCS26 +00171 * F7, F8: DISPLAY PRIOR/NEXT A* RECORD. BREAK ON DTSCS26 +00172 * A*-BATCH-NO. IF THE PRIOR/NEXT RECORD ENCOUNTERED DTSCS26 +00173 * IS NOT AN AADJ RECORD (BUT IS IN MAP-BATCH-NO), DTSCS26 +00174 * AUTOMATICALLY JUMP TO THE APPROPRIATE SCREEN AND DTSCS26 +00175 * DISPLAY THE RECORD. DTSCS26 +00176 * DTSCS26 00177 * DTSCS26 -00178 * DTSCS26 -00179 * UPDATE: DTSCS26 -00180 * DTSCS26 -00181 * IF THE TRANSACTION HAS BEEN "PROCESSED" (AADJ-PROCESSED DTSCS26 -00182 * -DATE > +0, THEN THE TRANSACTION RECORD MAY NOT BE DTSCS26 -00183 * UPDATED. DTSCS26 -00184 * DTSCS26 +00178 * LCCM-CURRENT-VALUES-AREA MAINTENANCE: DTSCS26 +00179 * DTSCS26 +00180 * LCCM-DOC-NO MAINTENANCE. DTSCS26 +00181 * DTSCS26 +00182 * LCCM-EMP-NO MAINTENANCE. DTSCS26 +00183 * DTSCS26 +00184 * LCCM-ENTRY-MODE MAINTENANCE. DTSCS26 00185 * DTSCS26 -00186 * ADD DTSCS26 -00187 * DTSCS26 -00188 * THE 'ENTER' KEY INDICATES THE "ADD" FUNCTION. THE "ADD" DTSCS26 -00189 * VERIFICATION FUNCTION IS DISABLED. DTSCS26 -00190 * DTSCS26 -00191 * MAP-ITEM-NO IS OPTIONAL (IF NO ENTRY, THE SYSTEM WILL DTSCS26 -00192 * ASSIGN THE NEXT AVAIABLE ITEM NUMBER TO THE ACCOUNTING DTSCS26 -00193 * TRANSACTION). DTSCS26 -00194 * DTSCS26 +00186 * DTSCS26 +00187 * UPDATE: DTSCS26 +00188 * DTSCS26 +00189 * IF THE TRANSACTION HAS BEEN "PROCESSED" (AADJ-PROCESSED DTSCS26 +00190 * -DATE > +0, THEN THE TRANSACTION RECORD MAY NOT BE DTSCS26 +00191 * UPDATED. DTSCS26 +00192 * DTSCS26 +00193 * DTSCS26 +00194 * ADD DTSCS26 00195 * DTSCS26 -00196 * MOD DTSCS26 -00197 * DTSCS26 -00198 * CALL DTSCU372 (WITH L372-UPDATE) TO UPDATE THE BATCH DTSCS26 -00199 * HEADER RECORD. DTSCS26 -00200 * DTSCS26 -00201 * DTSCS26 -00202 * DEL DTSCS26 +00196 * THE 'ENTER' KEY INDICATES THE "ADD" FUNCTION. THE "ADD" DTSCS26 +00197 * VERIFICATION FUNCTION IS DISABLED. DTSCS26 +00198 * DTSCS26 +00199 * MAP-ITEM-NO IS OPTIONAL (IF NO ENTRY, THE SYSTEM WILL DTSCS26 +00200 * ASSIGN THE NEXT AVAIABLE ITEM NUMBER TO THE ACCOUNTING DTSCS26 +00201 * TRANSACTION). DTSCS26 +00202 * DTSCS26 00203 * DTSCS26 -00204 * CALL DTSCU373 TO DELETE THE TRANSACTION RECORD. DTSCU373DTSCS26 -00205 * WILL UPDATE THE BATCH HEADER RECORD. DTSCS26 -00206 * DTSCS26 -00207 * DTSCS26 -00208 * RECORDS READ: DTSCS26 +00204 * MOD DTSCS26 +00205 * DTSCS26 +00206 * CALL DTSCU372 (WITH L372-UPDATE) TO UPDATE THE BATCH DTSCS26 +00207 * HEADER RECORD. DTSCS26 +00208 * DTSCS26 00209 * DTSCS26 -00210 * MASTER: DTSCS26 +00210 * DEL DTSCS26 00211 * DTSCS26 -00212 * MPRF DTSCS26 -00213 * MQTR DTSCS26 -00214 * MADJ DTSCS26 -00215 * MPAY DTSCS26 -00216 * MDST DTSCS26 +00212 * CALL DTSCU373 TO DELETE THE TRANSACTION RECORD. DTSCU373DTSCS26 +00213 * WILL UPDATE THE BATCH HEADER RECORD. DTSCS26 +00214 * DTSCS26 +00215 * DTSCS26 +00216 * RECORDS READ: DTSCS26 00217 * DTSCS26 -00218 * DTSCS26 -00219 * ALTERNATE INDEX: DTSCS26 -00220 * DTSCS26 -00221 * NONE. DTSCS26 -00222 * DTSCS26 -00223 * DTSCS26 -00224 * REFERENCE: DTSCS26 +00218 * MASTER: DTSCS26 +00219 * DTSCS26 +00220 * MPRF DTSCS26 +00221 * MQTR DTSCS26 +00222 * MADJ DTSCS26 +00223 * MPAY DTSCS26 +00224 * MDST DTSCS26 00225 * DTSCS26 -00226 * NONE. DTSCS26 -00227 * DTSCS26 +00226 * DTSCS26 +00227 * ALTERNATE INDEX: DTSCS26 00228 * DTSCS26 -00229 * ACCOUNTING TRANSACTION COLLECTION: DTSCS26 +00229 * NONE. DTSCS26 00230 * DTSCS26 -00231 * MADJ DTSCS26 -00232 * DTSCS26 +00231 * DTSCS26 +00232 * REFERENCE: DTSCS26 00233 * DTSCS26 -00234 * RECORDS UPDATED: DTSCS26 +00234 * NONE. DTSCS26 00235 * DTSCS26 -00236 * MASTER: DTSCS26 -00237 * DTSCS26 -00238 * NONE. DTSCS26 -00239 * DTSCS26 +00236 * DTSCS26 +00237 * ACCOUNTING TRANSACTION COLLECTION: DTSCS26 +00238 * DTSCS26 +00239 * MADJ DTSCS26 00240 * DTSCS26 -00241 * REFERENCE: DTSCS26 -00242 * DTSCS26 -00243 * NONE. DTSCS26 -00244 * DTSCS26 +00241 * DTSCS26 +00242 * RECORDS UPDATED: DTSCS26 +00243 * DTSCS26 +00244 * MASTER: DTSCS26 00245 * DTSCS26 -00246 * ACCOUNTING TRANSACTION COLLECTION: DTSCS26 +00246 * NONE. DTSCS26 00247 * DTSCS26 -00248 * AADJ (WRITE, REWRITE) DTSCS26 -00249 * DTSCS26 +00248 * DTSCS26 +00249 * REFERENCE: DTSCS26 00250 * DTSCS26 -00251 * ON-LINE ACTIVITY FILE RECORDS WRITTEN: DTSCS26 +00251 * NONE. DTSCS26 00252 * DTSCS26 -00253 * NONE. DTSCS26 -00254 * DTSCS26 +00253 * DTSCS26 +00254 * ACCOUNTING TRANSACTION COLLECTION: DTSCS26 00255 * DTSCS26 -00256 * TEMPORARY STORAGE USAGE: DTSCS26 +00256 * AADJ (WRITE, REWRITE) DTSCS26 00257 * DTSCS26 -00258 * NONE. DTSCS26 -00259 * DTSCS26 +00258 * DTSCS26 +00259 * ON-LINE ACTIVITY FILE RECORDS WRITTEN: DTSCS26 00260 * DTSCS26 -00261 * MODULES LINKED TO: DTSCS26 +00261 * NONE. DTSCS26 00262 * DTSCS26 -00263 * DTSCU001 DATE EDIT/CONVERSION. DTSCS26 -00264 * DTSCU004 QUARTER EDIT/CONVERSION. DTSCS26 -00265 * DTSCU011 MONEY AMOUNT FROM SCREEN FORMAT/EDIT. DTSCS26 -00266 * DTSCU015 DATE FROM SCREEN FORMAT/EDIT. DTSCS26 -00267 * DTSCU016 QUARTER/YEAR FROM SCREEN FORMAT/EDIT. DTSCS26 -00268 * DTSCU018 EMP NO FROM SCREEN FORMAT/EDIT. DTSCS26 -00269 * DTSCU019 DOCUMENT NO FROM SCREEN FORMAT/EDIT. DTSCS26 -00270 * DTSCU032 ACCOUNTING CODES EDIT/DESCRIPTION. DTSCS26 -00271 * DTSCU082 OPERATOR ID EDIT/LOOK UP. DTSCS26 -00272 * DTSCU371 ACCOUNTING TRANSACTION FILE TRANSACTION RECORD DTSCS26 -00273 * DELETION. DTSCS26 -00274 * DTSCU372 ACCOUNTING TRANSACTION FILE BATCH HEADER DTSCS26 -00275 * RECORD INQUIRY/UPDATE. DTSCS26 -00276 * DTSCU381 DETERMINE LIABILITY, DEFAULT DUE DATE, AND UI DTSCS26 -00277 * RATE FOR A GIVEN QUARTER. DTSCS26 -00278 * DTSCU810 MASTER FILE INPUT/OUTPUT. DTSCS26 -00279 * DTSCU823 ACCOUNTING TRANSACTION FILE INPUT/OUTPUT. DTSCS26 -00280 * DTSCS26 -00281 ***** DTSCS26 -00282 ENVIRONMENT DIVISION. DTSCS26 -00283 DTSCS26 -00284 DTSCS26 -00285 DATA DIVISION. DTSCS26 -00286 DTSCS26 -00287 DTSCS26 -00288 WORKING-STORAGE SECTION. DTSCS26 -002885 77 PAN-VALET PICTURE X(24) VALUE '052DTSCS26 06/20/12'. DTSCS26 -00289 DTSCS26 -00290 01 WRK-AREA. DTSCS26 -00291 05 WRK-ABEND-CD PIC X(04) VALUE 'S26 '. DTSCS26 +00263 * DTSCS26 +00264 * TEMPORARY STORAGE USAGE: DTSCS26 +00265 * DTSCS26 +00266 * NONE. DTSCS26 +00267 * DTSCS26 +00268 * DTSCS26 +00269 * MODULES LINKED TO: DTSCS26 +00270 * DTSCS26 +00271 * DTSCU001 DATE EDIT/CONVERSION. DTSCS26 +00272 * DTSCU004 QUARTER EDIT/CONVERSION. DTSCS26 +00273 * DTSCU011 MONEY AMOUNT FROM SCREEN FORMAT/EDIT. DTSCS26 +00274 * DTSCU015 DATE FROM SCREEN FORMAT/EDIT. DTSCS26 +00275 * DTSCU016 QUARTER/YEAR FROM SCREEN FORMAT/EDIT. DTSCS26 +00276 * DTSCU018 EMP NO FROM SCREEN FORMAT/EDIT. DTSCS26 +00277 * DTSCU019 DOCUMENT NO FROM SCREEN FORMAT/EDIT. DTSCS26 +00278 * DTSCU032 ACCOUNTING CODES EDIT/DESCRIPTION. DTSCS26 +00279 * DTSCU082 OPERATOR ID EDIT/LOOK UP. DTSCS26 +00280 * DTSCU371 ACCOUNTING TRANSACTION FILE TRANSACTION RECORD DTSCS26 +00281 * DELETION. DTSCS26 +00282 * DTSCU372 ACCOUNTING TRANSACTION FILE BATCH HEADER DTSCS26 +00283 * RECORD INQUIRY/UPDATE. DTSCS26 +00284 * DTSCU381 DETERMINE LIABILITY, DEFAULT DUE DATE, AND UI DTSCS26 +00285 * RATE FOR A GIVEN QUARTER. DTSCS26 +00286 * DTSCU810 MASTER FILE INPUT/OUTPUT. DTSCS26 +00287 * DTSCU823 ACCOUNTING TRANSACTION FILE INPUT/OUTPUT. DTSCS26 +00288 * DTSCS26 +00289 ***** DTSCS26 +00290 ENVIRONMENT DIVISION. DTSCS26 +00291 DTSCS26 00292 DTSCS26 -00293 05 WRK-SCR-ID. DTSCS26 -00294 10 WRK-SCR-ID-N PIC 9(02) VALUE 26. DTSCS26 +00293 DATA DIVISION. DTSCS26 +00294 DTSCS26 00295 DTSCS26 -00296 05 WRK-F03-SCR-ID PIC X(02) VALUE '20'. DTSCS26 -00297 DTSCS26 -00298 05 ALL-NINES-DATE PIC S9(09) COMP-3 DTSCS26 -00299 VALUE +999999999. DTSCS26 -00300 DTSCS26 -00301 05 NULL-DOC-NO. DTSCS26 -00302 10 NULL-BATCH-NO PIC S9(05) COMP-3 VALUE +0.DTSCS26 -00303 10 NULL-ITEM-NO PIC S9(03) COMP-3 VALUE +0.DTSCS26 +00296 WORKING-STORAGE SECTION. DTSCS26 +002965 77 PAN-VALET PICTURE X(24) VALUE '010DTSCS26 11/18/24'. DTSCS26 +00297 77 PAN-VALET PICTURE X(24) VALUE '052DTSCS26 06/20/12'. DTSCS26 +00298 DTSCS26 +00299 01 WRK-AREA. DTSCS26 +00300 05 WRK-ABEND-CD PIC X(04) VALUE 'S26 '. DTSCS26 +00301 DTSCS26 +00302 05 WRK-SCR-ID. DTSCS26 +00303 10 WRK-SCR-ID-N PIC 9(02) VALUE 26. DTSCS26 00304 DTSCS26 -00305 DTSCS26 -00306 05 SCR-ACCESS-IND PIC X(01). DTSCS26 -00307 88 SCR-ACCESS-INQ VALUE '1'. DTSCS26 -00308 88 SCR-ACCESS-UPDATE VALUE '2' '3'. DTSCS26 -00309 88 SCR-ACCESS-SUPERVISOR VALUE '3'. DTSCS26 -00310 DTSCS26 -00311 05 CURSOR-SET-IND PIC X(01). DTSCS26 -00312 88 CURSOR-SET-YES VALUE 'Y'. DTSCS26 -00313 88 CURSOR-SET-NO VALUE 'N'. DTSCS26 -00314 88 CURSOR-SET-GOTO VALUE 'G'. DTSCS26 -00315 DTSCS26 -00316 05 REQ-IND PIC X(01). DTSCS26 -00317 88 REQ-CURSOR-TO-GOTO VALUE 'G'. DTSCS26 -00318 88 REQ-ERROR VALUE 'O'. DTSCS26 -00319 88 REQ-JUMP VALUE 'J'. DTSCS26 -00320 88 REQ-UPDATE VALUE 'U'. DTSCS26 -00321 88 REQ-INQUIRE VALUE 'I'. DTSCS26 -00322 88 REQ-CLEAR VALUE 'C'. DTSCS26 -00323 88 REQ-EDIT VALUE 'E'. DTSCS26 +00305 05 WRK-F03-SCR-ID PIC X(02) VALUE '20'. DTSCS26 +00306 DTSCS26 +00307 05 ALL-NINES-DATE PIC S9(09) COMP-3 DTSCS26 +00308 VALUE +999999999. DTSCS26 +00309 DTSCS26 +00310 05 NULL-DOC-NO. DTSCS26 +00311 10 NULL-BATCH-NO PIC S9(05) COMP-3 VALUE +0.DTSCS26 +00312 10 NULL-ITEM-NO PIC S9(03) COMP-3 VALUE +0.DTSCS26 +00313 DTSCS26 +00314 DTSCS26 +00315 05 SCR-ACCESS-IND PIC X(01). DTSCS26 +00316 88 SCR-ACCESS-INQ VALUE '1'. DTSCS26 +00317 88 SCR-ACCESS-UPDATE VALUE '2' '3'. DTSCS26 +00318 88 SCR-ACCESS-SUPERVISOR VALUE '3'. DTSCS26 +00319 DTSCS26 +00320 05 CURSOR-SET-IND PIC X(01). DTSCS26 +00321 88 CURSOR-SET-YES VALUE 'Y'. DTSCS26 +00322 88 CURSOR-SET-NO VALUE 'N'. DTSCS26 +00323 88 CURSOR-SET-GOTO VALUE 'G'. DTSCS26 00324 DTSCS26 -00325 05 RESP-IND PIC X(01). DTSCS26 -00326 88 RESP-SEND-MSGONLY VALUE 'O'. DTSCS26 -00327 88 RESP-SEND-MAP VALUE 'M'. DTSCS26 -00328 88 RESP-JUMP VALUE 'J'. DTSCS26 -00329 88 RESP-CURSOR-TO-GOTO VALUE 'G'. DTSCS26 -00330 DTSCS26 -00331 DTSCS26 -00332 05 WRK-MSG-AREA. DTSCS26 -00333 10 WRK-MSG-NUMBER PIC X(04). DTSCS26 -00334 10 WRK-MSG-TEXT PIC X(60). DTSCS26 -00335 DTSCS26 -00336 DTSCS26 -00337 05 WRK-EMP-NO PIC 9(07) COMP-3. DTSCS26 -00338 DTSCS26 -00339 05 WRK-BATCH-NO PIC 9(05) COMP-3. DTSCS26 +00325 05 REQ-IND PIC X(01). DTSCS26 +00326 88 REQ-CURSOR-TO-GOTO VALUE 'G'. DTSCS26 +00327 88 REQ-ERROR VALUE 'O'. DTSCS26 +00328 88 REQ-JUMP VALUE 'J'. DTSCS26 +00329 88 REQ-UPDATE VALUE 'U'. DTSCS26 +00330 88 REQ-INQUIRE VALUE 'I'. DTSCS26 +00331 88 REQ-CLEAR VALUE 'C'. DTSCS26 +00332 88 REQ-EDIT VALUE 'E'. DTSCS26 +00333 DTSCS26 +00334 05 RESP-IND PIC X(01). DTSCS26 +00335 88 RESP-SEND-MSGONLY VALUE 'O'. DTSCS26 +00336 88 RESP-SEND-MAP VALUE 'M'. DTSCS26 +00337 88 RESP-JUMP VALUE 'J'. DTSCS26 +00338 88 RESP-CURSOR-TO-GOTO VALUE 'G'. DTSCS26 +00339 DTSCS26 00340 DTSCS26 -00341 05 WRK-ITEM-NO PIC 9(03) COMP-3. DTSCS26 -00342 DTSCS26 -00343 05 WRK-ATB-AN PIC X(01). DTSCS26 +00341 05 WRK-MSG-AREA. DTSCS26 +00342 10 WRK-MSG-NUMBER PIC X(04). DTSCS26 +00343 10 WRK-MSG-TEXT PIC X(60). DTSCS26 00344 DTSCS26 -00345 05 WRK-ATB-NUM PIC X(01). DTSCS26 -00346 DTSCS26 +00345 DTSCS26 +00346 05 WRK-EMP-NO PIC 9(07) COMP-3. DTSCS26 00347 DTSCS26 -00348 05 WRK-DISPLAY PIC 9(11). DTSCS26 +00348 05 WRK-BATCH-NO PIC 9(05) COMP-3. DTSCS26 00349 DTSCS26 -00350 05 FILLER REDEFINES WRK-DISPLAY. DTSCS26 -00351 10 FILLER PIC X(05). DTSCS26 -00352 10 WRK-DISPLAY-YR PIC X(02). DTSCS26 -00353 10 WRK-DISPLAY-MO PIC X(02). DTSCS26 -00354 10 WRK-DISPLAY-DA PIC X(02). DTSCS26 +00350 05 WRK-ITEM-NO PIC 9(03) COMP-3. DTSCS26 +00351 DTSCS26 +00352 05 WRK-ATB-AN PIC X(01). DTSCS26 +00353 DTSCS26 +00354 05 WRK-ATB-NUM PIC X(01). DTSCS26 00355 DTSCS26 -00356 05 FILLER REDEFINES WRK-DISPLAY. DTSCS26 -00357 10 FILLER PIC X(08). DTSCS26 -00358 10 WRK-DISPLAY-YRQ-YR PIC X(02). DTSCS26 -00359 10 WRK-DISPLAY-YRQ-Q PIC X(01). DTSCS26 -00360 DTSCS26 -00361 05 FILLER REDEFINES WRK-DISPLAY. DTSCS26 -00362 10 FILLER PIC X(05). DTSCS26 -00363 10 WRK-EMP-NO-1 PIC X(03). DTSCS26 -00364 10 WRK-EMP-NO-2 PIC X(03). DTSCS26 -00365 DTSCS26 -00366 DTSCS26 -00367 05 HOLD-KEY-AREA PIC X(05). DTSCS26 -00368 DTSCS26 -00369 05 PAGE-TYPE-IND PIC X(01). DTSCS26 -00370 88 PAGE-FIRST-88 VALUE 'F'. DTSCS26 -00371 88 PAGE-LAST-88 VALUE 'L'. DTSCS26 -00372 DTSCS26 -00373 DTSCS26 -00374 05 WRK-CREDIT-AMT PIC S9(09)V9(02) COMP-3. DTSCS26 +00356 DTSCS26 +00357 05 WRK-DISPLAY PIC 9(11). DTSCS26 +00358 DTSCS26 +00359 05 FILLER REDEFINES WRK-DISPLAY. DTSCS26 +00360 10 FILLER PIC X(05). DTSCS26 +00361 10 WRK-DISPLAY-YR PIC X(02). DTSCS26 +00362 10 WRK-DISPLAY-MO PIC X(02). DTSCS26 +00363 10 WRK-DISPLAY-DA PIC X(02). DTSCS26 +00364 DTSCS26 +00365 05 FILLER REDEFINES WRK-DISPLAY. DTSCS26 +00366 10 FILLER PIC X(08). DTSCS26 +00367 10 WRK-DISPLAY-YRQ-YR PIC X(02). DTSCS26 +00368 10 WRK-DISPLAY-YRQ-Q PIC X(01). DTSCS26 +00369 DTSCS26 +00370 05 FILLER REDEFINES WRK-DISPLAY. DTSCS26 +00371 10 FILLER PIC X(05). DTSCS26 +00372 10 WRK-EMP-NO-1 PIC X(03). DTSCS26 +00373 10 WRK-EMP-NO-2 PIC X(03). DTSCS26 +00374 DTSCS26 00375 DTSCS26 -00376 05 WRK-CHARGED-AMT PIC S9(09)V9(02) COMP-3. DTSCS26 +00376 05 HOLD-KEY-AREA PIC X(05). DTSCS26 00377 DTSCS26 -00378 05 WRK-WAIVED-AMT PIC S9(09)V9(02) COMP-3. DTSCS26 -00379 DTSCS26 -00380 05 WRK-TOLER-AMT PIC S9(09)V9(02) COMP-3. DTSCS26 +00378 05 PAGE-TYPE-IND PIC X(01). DTSCS26 +00379 88 PAGE-FIRST-88 VALUE 'F'. DTSCS26 +00380 88 PAGE-LAST-88 VALUE 'L'. DTSCS26 00381 DTSCS26 -00382 * 05 WRK-AMT-REMAIN PIC S9(09)V9(02) COMP-3. DTSCS26 -00383 DTSCS26 -00384 * 05 WRK-LARGEST-AMT PIC S9(09)V9(02) COMP-3. DTSCS26 -00385 * 05 WRK-LARGEST-YRQ PIC S9(04) COMP. DTSCS26 -00386 * 05 WRK-QTR-AMT PIC S9(09)V9(02) COMP-3. DTSCS26 -00387 * 05 WRK-TOT-AMT PIC S9(11)V9(02) COMP-3. DTSCS26 +00382 DTSCS26 +00383 05 WRK-CREDIT-AMT PIC S9(09)V9(02) COMP-3. DTSCS26 +00384 DTSCS26 +00385 05 WRK-CHARGED-AMT PIC S9(09)V9(02) COMP-3. DTSCS26 +00386 DTSCS26 +00387 05 WRK-WAIVED-AMT PIC S9(09)V9(02) COMP-3. DTSCS26 00388 DTSCS26 -00389 * 05 SUM-FOUR-QTRS-IND PIC X(01). DTSCS26 -00390 * 88 SUM-FOUR-QTRS-YES-88 VALUE 'Y'. DTSCS26 -00391 * 88 SUM-FOUR-QTRS-NO-88 VALUE 'N'. DTSCS26 +00389 05 WRK-TOLER-AMT PIC S9(09)V9(02) COMP-3. DTSCS26 +00390 DTSCS26 +00391 * 05 WRK-AMT-REMAIN PIC S9(09)V9(02) COMP-3. DTSCS26 00392 DTSCS26 -00393 05 ADJ-FOUR-QTRS-IND PIC X(01). DTSCS26 -00394 88 ADJ-FOUR-QTRS-YES-88 VALUE 'Y'. DTSCS26 -00395 88 ADJ-FOUR-QTRS-NO-88 VALUE 'N'. DTSCS26 -00396 DTSCS26 -00397 *****05 WRK-BALANCE-AMT PIC S9(09)V9(02) COMP-3. DTSCS26 -00398 DTSCS26 -00399 05 WRK-MQTR-EXISTS-IND PIC X(01). DTSCS26 -00400 DTSCS26 -00401 05 WRK-MDST-EXISTS-IND PIC X(01). DTSCS26 -00402 DTSCS26 -00403 05 WRK-PENDING-MCMP-IND PIC X(01). DTSCS26 -00404 88 WRK-PENDING-MCMP-YES-88 VALUE 'Y'. DTSCS26 -00405 88 WRK-PENDING-MCMP-NO-88 VALUE 'N'. DTSCS26 -00406 DTSCS26 -00407 05 WRK-YRQ-IND PIC X(01). DTSCS26 -00408 88 WRK-YRQ-OK-88 VALUE 'Y'. DTSCS26 -00409 88 WRK-YRQ-NOT-FOUND-88 VALUE 'N'. DTSCS26 -00410 DTSCS26 -00411 *****05 WRK-ACCT-IND PIC X(02). DTSCS26 -00412 DTSCS26 -00413 05 ACCT-SUB PIC S9(04) COMP. DTSCS26 -00414 * 05 ACCT1-SUB PIC S9(04) COMP. DTSCS26 -00415 * 05 ACCT2-SUB PIC S9(04) COMP. DTSCS26 -00416 05 QTR-SUB PIC S9(04) COMP. DTSCS26 -00417 * 05 TOT-SUB PIC S9(04) COMP DTSCS26 -00418 * VALUE +5. DTSCS26 -00419 05 WRK-AATH-ACTION PIC X(01). DTSCS26 -00420 88 WRK-AATH-ACTION-ADD-88 VALUE 'A'. DTSCS26 -00421 88 WRK-AATH-ACTION-UPD-88 VALUE 'U'. DTSCS26 -00422 88 WRK-AATH-ACTION-DEL-88 VALUE 'D'. DTSCS26 -00423 DTSCS26 -00424 EJECT DTSCS26 -00425 01 WRK-EDITED-ELEMENTS. DTSCS26 -00426 05 WRK-AMT PIC S9(09)V9(02) COMP-3. DTSCS26 -00427 88 WRK-AMT-INVALID-88 VALUE -999999999.99. DTSCS26 -00428 DTSCS26 -00429 05 WRK-APPLIC-YRQ PIC S9(05) COMP-3. DTSCS26 -00430 DTSCS26 -00431 05 WRK-APPLIC-IND PIC X(02). DTSCS26 +00393 * 05 WRK-LARGEST-AMT PIC S9(09)V9(02) COMP-3. DTSCS26 +00394 * 05 WRK-LARGEST-YRQ PIC S9(04) COMP. DTSCS26 +00395 * 05 WRK-QTR-AMT PIC S9(09)V9(02) COMP-3. DTSCS26 +00396 * 05 WRK-TOT-AMT PIC S9(11)V9(02) COMP-3. DTSCS26 +00397 DTSCS26 +00398 * 05 SUM-FOUR-QTRS-IND PIC X(01). DTSCS26 +00399 * 88 SUM-FOUR-QTRS-YES-88 VALUE 'Y'. DTSCS26 +00400 * 88 SUM-FOUR-QTRS-NO-88 VALUE 'N'. DTSCS26 +00401 DTSCS26 +00402 05 ADJ-FOUR-QTRS-IND PIC X(01). DTSCS26 +00403 88 ADJ-FOUR-QTRS-YES-88 VALUE 'Y'. DTSCS26 +00404 88 ADJ-FOUR-QTRS-NO-88 VALUE 'N'. DTSCS26 +00405 DTSCS26 +00406 *****05 WRK-BALANCE-AMT PIC S9(09)V9(02) COMP-3. DTSCS26 +00407 DTSCS26 +00408 05 WRK-MQTR-EXISTS-IND PIC X(01). DTSCS26 +00409 DTSCS26 +00410 05 WRK-MDST-EXISTS-IND PIC X(01). DTSCS26 +00411 DTSCS26 +00412 05 WRK-PENDING-MCMP-IND PIC X(01). DTSCS26 +00413 88 WRK-PENDING-MCMP-YES-88 VALUE 'Y'. DTSCS26 +00414 88 WRK-PENDING-MCMP-NO-88 VALUE 'N'. DTSCS26 +00415 DTSCS26 +00416 05 WRK-YRQ-IND PIC X(01). DTSCS26 +00417 88 WRK-YRQ-OK-88 VALUE 'Y'. DTSCS26 +00418 88 WRK-YRQ-NOT-FOUND-88 VALUE 'N'. DTSCS26 +00419 DTSCS26 +00420 *****05 WRK-ACCT-IND PIC X(02). DTSCS26 +00421 DTSCS26 +00422 05 ACCT-SUB PIC S9(04) COMP. DTSCS26 +00423 * 05 ACCT1-SUB PIC S9(04) COMP. DTSCS26 +00424 * 05 ACCT2-SUB PIC S9(04) COMP. DTSCS26 +00425 05 QTR-SUB PIC S9(04) COMP. DTSCS26 +00426 * 05 TOT-SUB PIC S9(04) COMP DTSCS26 +00427 * VALUE +5. DTSCS26 +00428 05 WRK-AATH-ACTION PIC X(01). DTSCS26 +00429 88 WRK-AATH-ACTION-ADD-88 VALUE 'A'. DTSCS26 +00430 88 WRK-AATH-ACTION-UPD-88 VALUE 'U'. DTSCS26 +00431 88 WRK-AATH-ACTION-DEL-88 VALUE 'D'. DTSCS26 00432 DTSCS26 -00433 05 WRK-APPLIC-DOC-NO. DTSCS26 -00434 10 WRK-APPLIC-BATCH-NO PIC S9(05) COMP-3. DTSCS26 -00435 10 WRK-APPLIC-ITEM-NO PIC S9(03) COMP-3. DTSCS26 -00436 DTSCS26 -00437 05 WRK-DATE-1 PIC S9(09) COMP-3. DTSCS26 -00438 DTSCS26 -00439 05 WRK-DATE-2 PIC S9(09) COMP-3. DTSCS26 -00440 DTSCS26 -00441 05 WRK-INT-RATE PIC S9(01)V9(04) COMP-3. DTSCS26 -00442 88 WRK-INT-NO-ENTRY-88 VALUE -9.9999. DTSCS26 -00443 DTSCS26 -00444 05 WRK-RECEIVED-DATE PIC S9(09) COMP-3. DTSCS26 -00445 EJECT DTSCS26 -00446 01 WRK-ANN-QTR-AREA. DTSCS26 -00447 05 WRK-ANN-QTR-ENTRY OCCURS 4 TIMES. DTSCS26 -00448 10 WRK-MQTR-YRQ PIC S9(05) COMP-3. DTSCS26 -00449 10 WRK-MQTR-BYPASS-IND PIC X(01). DTSCS26 -00450 88 WRK-MQTR-BYPASS-YES-88 VALUE 'Y'. DTSCS26 -00451 88 WRK-MQTR-BYPASS-NO-88 VALUE 'N'. DTSCS26 +00433 EJECT DTSCS26 +00434 01 WRK-EDITED-ELEMENTS. DTSCS26 +00435 05 WRK-AMT PIC S9(09)V9(02) COMP-3. DTSCS26 +00436 88 WRK-AMT-INVALID-88 VALUE -999999999.99. DTSCS26 +00437 DTSCS26 +00438 05 WRK-APPLIC-YRQ PIC S9(05) COMP-3. DTSCS26 +00439 DTSCS26 +00440 05 WRK-APPLIC-IND PIC X(02). DTSCS26 +00441 DTSCS26 +00442 05 WRK-APPLIC-DOC-NO. DTSCS26 +00443 10 WRK-APPLIC-BATCH-NO PIC S9(05) COMP-3. DTSCS26 +00444 10 WRK-APPLIC-ITEM-NO PIC S9(03) COMP-3. DTSCS26 +00445 DTSCS26 +00446 05 WRK-DATE-1 PIC S9(09) COMP-3. DTSCS26 +00447 DTSCS26 +00448 05 WRK-DATE-2 PIC S9(09) COMP-3. DTSCS26 +00449 DTSCS26 +00450 05 WRK-INT-RATE PIC S9(01)V9(04) COMP-3. DTSCS26 +00451 88 WRK-INT-NO-ENTRY-88 VALUE -9.9999. DTSCS26 00452 DTSCS26 -00453 01 MSG-LITERALS. DTSCS26 -00454 05 MSG-E261-AREA. DTSCS26 -00455 10 FILLER PIC X(04) VALUE 'E261'. DTSCS26 -00456 10 FILLER PIC X(60) VALUE DTSCS26 -00457 'NEVER SUBJECT EMPLOYER NOT VALID'. DTSCS26 -00458 DTSCS26 -00459 05 MSG-E262-AREA. DTSCS26 -00460 10 FILLER PIC X(04) VALUE 'E262'. DTSCS26 -00461 10 FILLER PIC X(60) VALUE DTSCS26 -00462 'SPECIFIED APPLIC DOCUMENT DOES NOT EXIST'. DTSCS26 -00463 DTSCS26 -00464 05 MSG-E263-AREA. DTSCS26 -00465 10 FILLER PIC X(04) VALUE 'E263'. DTSCS26 -00466 10 FILLER PIC X(60) VALUE DTSCS26 -00467 'YIELDS INVALID CHARGED AMOUNT'. DTSCS26 -00468 DTSCS26 -00469 05 MSG-E264-AREA. DTSCS26 -00470 10 FILLER PIC X(04) VALUE 'E264'. DTSCS26 -00471 10 FILLER PIC X(60) VALUE DTSCS26 -00472 'CHARGING IS ALREADY AUTOMATIC'. DTSCS26 -00473 DTSCS26 -00474 05 MSG-E265-AREA. DTSCS26 -00475 10 FILLER PIC X(04) VALUE 'E265'. DTSCS26 -00476 10 FILLER PIC X(60) VALUE DTSCS26 -00477 'YIELDS INVALID TOLERANCE AMOUNT'. DTSCS26 -00478 DTSCS26 -00479 05 MSG-E266-AREA. DTSCS26 -00480 10 FILLER PIC X(04) VALUE 'E266'. DTSCS26 -00481 10 FILLER PIC X(60) VALUE DTSCS26 -00482 'CHARGING IS ALREADY MANUAL'. DTSCS26 -00483 DTSCS26 -00484 05 MSG-E267-AREA. DTSCS26 -00485 10 FILLER PIC X(04) VALUE 'E267'. DTSCS26 -00486 10 FILLER PIC X(60) VALUE DTSCS26 -00487 'NO BALANCES DUE, PURSUED REPORTS, OR CREDITS TO WRITE OFF'.DTSCS26 -00488 DTSCS26 -00489 05 MSG-E268-AREA. DTSCS26 -00490 10 FILLER PIC X(04) VALUE 'E268'. DTSCS26 -00491 10 FILLER PIC X(60) VALUE DTSCS26 -00492 'MUST BE FIRST DAY OF CALENDAR MONTH '.DTSCS26 -00493 DTSCS26 -00494 05 MSG-E269-AREA. DTSCS26 -00495 10 FILLER PIC X(04) VALUE 'E269'. DTSCS26 -00496 10 FILLER PIC X(60) VALUE DTSCS26 -00497 'MUST BE LAST DAY OF CALENDAR MONTH '.DTSCS26 -00498 DTSCS26 -00499 05 MSG-E26A-AREA. DTSCS26 -00500 10 FILLER PIC X(04) VALUE 'E26A'. DTSCS26 -00501 10 FILLER PIC X(60) VALUE DTSCS26 -00502 'INVALID FOR ANNUAL REPORTS '.DTSCS26 -00503 DTSCS26 -00504 05 MSG-P26D-AREA. DTSCS26 -00505 10 FILLER PIC X(04) VALUE 'P26D'. DTSCS26 -00506 10 FILLER PIC X(60) VALUE DTSCS26 -00507 'TRANSACTION PROCESSED - MODIFY OR DELETE NOT ALLOWED'. DTSCS26 -00508 DTSCS26 -00509 05 MSG-E26D-AREA. DTSCS26 -00510 10 FILLER PIC X(04) VALUE 'E26D'. DTSCS26 -00511 10 FILLER PIC X(60) VALUE DTSCS26 -00512 'TRANSACTION PROCESSED - MODIFY OR DELETE NOT ALLOWED'. DTSCS26 -00513 DTSCS26 -00514 05 MSG-E26E-AREA. DTSCS26 -00515 10 FILLER PIC X(04) VALUE 'E26E'. DTSCS26 -00516 10 FILLER PIC X(60) VALUE DTSCS26 -00517 'ENTER Y OR N FOR COMPROMISE '. DTSCS26 -00518 DTSCS26 -00519 05 MSG-E26F-AREA. DTSCS26 -00520 10 FILLER PIC X(04) VALUE 'E26F'. DTSCS26 -00521 10 FILLER PIC X(60) VALUE DTSCS26 -00522 'NO PENDING COMPROMISE SETTLEMENT FOUND '. DTSCS26 -00523 DTSCS26 -00524 05 MSG-E26G-AREA. DTSCS26 -00525 10 FILLER PIC X(04) VALUE 'E26G'. DTSCS26 -00526 10 FILLER PIC X(60) VALUE DTSCS26 -00527 'QUARTER NOT PART OF COMPROMISE SETTLEMENT '. DTSCS26 -00528 DTSCS26 -00529 05 MSG-E26H-AREA. DTSCS26 -00530 10 FILLER PIC X(04) VALUE 'E26H'. DTSCS26 -00531 10 FILLER PIC X(60) VALUE DTSCS26 -00532 'QUARTER PART OF COMPROMISE - CHANGE NOT ALLOWED '. DTSCS26 -00533 EJECT DTSCS26 -00534 01 L001-COMM-AREA. DTSCS26 -00535 ++INCLUDE DTSIL001 DTSCS26 -00536 EJECT DTSCS26 -00537 01 L004-COMM-AREA. DTSCS26 -00538 ++INCLUDE DTSIL004 DTSCS26 -00539 EJECT DTSCS26 -00540 01 L011-COMM-AREA. DTSCS26 -00541 ++INCLUDE DTSIL011 DTSCS26 +00453 05 WRK-RECEIVED-DATE PIC S9(09) COMP-3. DTSCS26 +00454 EJECT DTSCS26 +00455 01 WRK-ANN-QTR-AREA. DTSCS26 +00456 05 WRK-ANN-QTR-ENTRY OCCURS 4 TIMES. DTSCS26 +00457 10 WRK-MQTR-YRQ PIC S9(05) COMP-3. DTSCS26 +00458 10 WRK-MQTR-BYPASS-IND PIC X(01). DTSCS26 +00459 88 WRK-MQTR-BYPASS-YES-88 VALUE 'Y'. DTSCS26 +00460 88 WRK-MQTR-BYPASS-NO-88 VALUE 'N'. DTSCS26 +00461 DTSCS26 +00462 01 MSG-LITERALS. DTSCS26 +00463 05 MSG-E261-AREA. DTSCS26 +00464 10 FILLER PIC X(04) VALUE 'E261'. DTSCS26 +00465 10 FILLER PIC X(60) VALUE DTSCS26 +00466 'NEVER SUBJECT EMPLOYER NOT VALID'. DTSCS26 +00467 DTSCS26 +00468 05 MSG-E262-AREA. DTSCS26 +00469 10 FILLER PIC X(04) VALUE 'E262'. DTSCS26 +00470 10 FILLER PIC X(60) VALUE DTSCS26 +00471 'SPECIFIED APPLIC DOCUMENT DOES NOT EXIST'. DTSCS26 +00472 DTSCS26 +00473 05 MSG-E263-AREA. DTSCS26 +00474 10 FILLER PIC X(04) VALUE 'E263'. DTSCS26 +00475 10 FILLER PIC X(60) VALUE DTSCS26 +00476 'YIELDS INVALID CHARGED AMOUNT'. DTSCS26 +00477 DTSCS26 +00478 05 MSG-E264-AREA. DTSCS26 +00479 10 FILLER PIC X(04) VALUE 'E264'. DTSCS26 +00480 10 FILLER PIC X(60) VALUE DTSCS26 +00481 'CHARGING IS ALREADY AUTOMATIC'. DTSCS26 +00482 DTSCS26 +00483 05 MSG-E265-AREA. DTSCS26 +00484 10 FILLER PIC X(04) VALUE 'E265'. DTSCS26 +00485 10 FILLER PIC X(60) VALUE DTSCS26 +00486 'YIELDS INVALID TOLERANCE AMOUNT'. DTSCS26 +00487 DTSCS26 +00488 05 MSG-E266-AREA. DTSCS26 +00489 10 FILLER PIC X(04) VALUE 'E266'. DTSCS26 +00490 10 FILLER PIC X(60) VALUE DTSCS26 +00491 'CHARGING IS ALREADY MANUAL'. DTSCS26 +00492 DTSCS26 +00493 05 MSG-E267-AREA. DTSCS26 +00494 10 FILLER PIC X(04) VALUE 'E267'. DTSCS26 +00495 10 FILLER PIC X(60) VALUE DTSCS26 +00496 'NO BALANCES DUE, PURSUED REPORTS, OR CREDITS TO WRITE OFF'.DTSCS26 +00497 DTSCS26 +00498 05 MSG-E268-AREA. DTSCS26 +00499 10 FILLER PIC X(04) VALUE 'E268'. DTSCS26 +00500 10 FILLER PIC X(60) VALUE DTSCS26 +00501 'MUST BE FIRST DAY OF CALENDAR MONTH '.DTSCS26 +00502 DTSCS26 +00503 05 MSG-E269-AREA. DTSCS26 +00504 10 FILLER PIC X(04) VALUE 'E269'. DTSCS26 +00505 10 FILLER PIC X(60) VALUE DTSCS26 +00506 'MUST BE LAST DAY OF CALENDAR MONTH '.DTSCS26 +00507 DTSCS26 +00508 05 MSG-E26A-AREA. DTSCS26 +00509 10 FILLER PIC X(04) VALUE 'E26A'. DTSCS26 +00510 10 FILLER PIC X(60) VALUE DTSCS26 +00511 'INVALID FOR ANNUAL REPORTS '.DTSCS26 +00512 DTSCS26 +00513 05 MSG-P26D-AREA. DTSCS26 +00514 10 FILLER PIC X(04) VALUE 'P26D'. DTSCS26 +00515 10 FILLER PIC X(60) VALUE DTSCS26 +00516 'TRANSACTION PROCESSED - MODIFY OR DELETE NOT ALLOWED'. DTSCS26 +00517 DTSCS26 +00518 05 MSG-E26D-AREA. DTSCS26 +00519 10 FILLER PIC X(04) VALUE 'E26D'. DTSCS26 +00520 10 FILLER PIC X(60) VALUE DTSCS26 +00521 'TRANSACTION PROCESSED - MODIFY OR DELETE NOT ALLOWED'. DTSCS26 +00522 DTSCS26 +00523 05 MSG-E26E-AREA. DTSCS26 +00524 10 FILLER PIC X(04) VALUE 'E26E'. DTSCS26 +00525 10 FILLER PIC X(60) VALUE DTSCS26 +00526 'ENTER Y OR N FOR COMPROMISE '. DTSCS26 +00527 DTSCS26 +00528 05 MSG-E26F-AREA. DTSCS26 +00529 10 FILLER PIC X(04) VALUE 'E26F'. DTSCS26 +00530 10 FILLER PIC X(60) VALUE DTSCS26 +00531 'NO PENDING COMPROMISE SETTLEMENT FOUND '. DTSCS26 +00532 DTSCS26 +00533 05 MSG-E26G-AREA. DTSCS26 +00534 10 FILLER PIC X(04) VALUE 'E26G'. DTSCS26 +00535 10 FILLER PIC X(60) VALUE DTSCS26 +00536 'QUARTER NOT PART OF COMPROMISE SETTLEMENT '. DTSCS26 +00537 DTSCS26 +00538 05 MSG-E26H-AREA. DTSCS26 +00539 10 FILLER PIC X(04) VALUE 'E26H'. DTSCS26 +00540 10 FILLER PIC X(60) VALUE DTSCS26 +00541 'QUARTER PART OF COMPROMISE - CHANGE NOT ALLOWED '. DTSCS26 00542 EJECT DTSCS26 -00543 01 L012-COMM-AREA. DTSCS26 -00544 ++INCLUDE DTSIL012 DTSCS26 +00543 01 L001-COMM-AREA. DTSCS26 +00544 ++INCLUDE DTSIL001 DTSCS26 00545 EJECT DTSCS26 -00546 01 L015-COMM-AREA. DTSCS26 -00547 ++INCLUDE DTSIL015 DTSCS26 +00546 01 L004-COMM-AREA. DTSCS26 +00547 ++INCLUDE DTSIL004 DTSCS26 00548 EJECT DTSCS26 -00549 01 L029-COMM-AREA. DTSCS26 -00550 ++INCLUDE DTSIL029 DTSCS26 +00549 01 L011-COMM-AREA. DTSCS26 +00550 ++INCLUDE DTSIL011 DTSCS26 00551 EJECT DTSCS26 -00552 01 L018-COMM-AREA. DTSCS26 -00553 ++INCLUDE DTSIL018 DTSCS26 +00552 01 L012-COMM-AREA. DTSCS26 +00553 ++INCLUDE DTSIL012 DTSCS26 00554 EJECT DTSCS26 -00555 01 L019-COMM-AREA. DTSCS26 -00556 ++INCLUDE DTSIL019 DTSCS26 +00555 01 L015-COMM-AREA. DTSCS26 +00556 ++INCLUDE DTSIL015 DTSCS26 00557 EJECT DTSCS26 -00558 01 L032-COMM-AREA. DTSCS26 -00559 ++INCLUDE DTSIL032 DTSCS26 +00558 01 L029-COMM-AREA. DTSCS26 +00559 ++INCLUDE DTSIL029 DTSCS26 00560 EJECT DTSCS26 -00561 01 L056-COMM-AREA. DTSCS26 -00562 ++INCLUDE DTSIL056 DTSCS26 +00561 01 L018-COMM-AREA. DTSCS26 +00562 ++INCLUDE DTSIL018 DTSCS26 00563 EJECT DTSCS26 -00564 01 L082-COMM-AREA. DTSCS26 -00565 ++INCLUDE DTSIL082 DTSCS26 +00564 01 L019-COMM-AREA. DTSCS26 +00565 ++INCLUDE DTSIL019 DTSCS26 00566 EJECT DTSCS26 -00567 01 L221-COMM-AREA. DTSCS26 -00568 ++INCLUDE DTSIL221 DTSCS26 +00567 01 L032-COMM-AREA. DTSCS26 +00568 ++INCLUDE DTSIL032 DTSCS26 00569 EJECT DTSCS26 -00570 01 L371-COMM-AREA. DTSCS26 -00571 ++INCLUDE DTSIL371 DTSCS26 +00570 01 L056-COMM-AREA. DTSCS26 +00571 ++INCLUDE DTSIL056 DTSCS26 00572 EJECT DTSCS26 -00573 01 L372-COMM-AREA. DTSCS26 -00574 ++INCLUDE DTSIL372 DTSCS26 -00575 EJECT DTSCS26 -00576 01 L381-COMM-AREA. DTSCS26 -00577 ++INCLUDE DTSIL381 DTSCS26 +00573 01 L084-COMM-AREA. CL**3 +00574 ++INCLUDE DTSIL084 CL**3 +00575 EJECT CL**3 +00576 01 L082-COMM-AREA. DTSCS26 +00577 ++INCLUDE DTSIL082 DTSCS26 00578 EJECT DTSCS26 -00579 01 L410-COMM-AREA. DTSCS26 -00580 ++INCLUDE DTSIL410 DTSCS26 +00579 01 L221-COMM-AREA. DTSCS26 +00580 ++INCLUDE DTSIL221 DTSCS26 00581 EJECT DTSCS26 -00582 01 L805-COMM-AREA. DTSCS26 -00583 ++INCLUDE DTSIL805 DTSCS26 +00582 01 L371-COMM-AREA. DTSCS26 +00583 ++INCLUDE DTSIL371 DTSCS26 00584 EJECT DTSCS26 -00585 01 L810-COMM-AREA. DTSCS26 -00586 05 L810-CONTROL-BLOCK. DTSCS26 -00587 ++INCLUDE DTSIL810 DTSCS26 -00588 EJECT DTSCS26 -00589 05 MSKL-REC. DTSCS26 -00590 ++INCLUDE DTSIMSKL DTSCS26 -00591 EJECT DTSCS26 -00592 01 MPRF-REC. DTSCS26 -00593 ++INCLUDE DTSIMPRF DTSCS26 -00594 EJECT DTSCS26 -00595 01 MQTR-REC. DTSCS26 -00596 ++INCLUDE DTSIMQTR DTSCS26 -00597 EJECT DTSCS26 -00598 01 MADJ-REC. DTSCS26 -00599 ++INCLUDE DTSIMADJ DTSCS26 +00585 01 L372-COMM-AREA. DTSCS26 +00586 ++INCLUDE DTSIL372 DTSCS26 +00587 EJECT DTSCS26 +00588 01 L381-COMM-AREA. DTSCS26 +00589 ++INCLUDE DTSIL381 DTSCS26 +00590 EJECT DTSCS26 +00591 01 L410-COMM-AREA. DTSCS26 +00592 ++INCLUDE DTSIL410 DTSCS26 +00593 EJECT DTSCS26 +00594 01 L805-COMM-AREA. DTSCS26 +00595 ++INCLUDE DTSIL805 DTSCS26 +00596 EJECT DTSCS26 +00597 01 L810-COMM-AREA. DTSCS26 +00598 05 L810-CONTROL-BLOCK. DTSCS26 +00599 ++INCLUDE DTSIL810 DTSCS26 00600 EJECT DTSCS26 -00601 01 MDST-REC. DTSCS26 -00602 ++INCLUDE DTSIMDST DTSCS26 +00601 05 MSKL-REC. DTSCS26 +00602 ++INCLUDE DTSIMSKL DTSCS26 00603 EJECT DTSCS26 -00604 01 MCMP-REC. DTSCS26 -00605 ++INCLUDE DTSIMCMP DTSCS26 +00604 01 MPRF-REC. DTSCS26 +00605 ++INCLUDE DTSIMPRF DTSCS26 00606 EJECT DTSCS26 -00607 01 L823-COMM-AREA. DTSCS26 -00608 05 L823-CONTROL-BLOCK. DTSCS26 -00609 ++INCLUDE DTSIL823 DTSCS26 -00610 EJECT DTSCS26 -00611 05 ASKL-REC. DTSCS26 -00612 ++INCLUDE DTSIASKL DTSCS26 -00613 EJECT DTSCS26 -00614 01 AADJ-REC. DTSCS26 -00615 ++INCLUDE DTSIAADJ DTSCS26 -00616 EJECT DTSCS26 -00617 01 L826-COMM-AREA. DTSCS26 -00618 05 L826-CONTROL-BLOCK. DTSCS26 -00619 ++INCLUDE DTSIL826 DTSCS26 -00620 DTSCS26 -00621 05 AATH-REC. DTSCS26 -00622 ++INCLUDE DTSIAATH DTSCS26 -00623 DTSCS26 -00624 01 L851-COMM-AREA. DTSCS26 -00625 ++INCLUDE DTSIL851 DTSCS26 -00626 DTSCS26 -00627 05 MAP-AREA REDEFINES L851-MAP-AREA. DTSCS26 -00628 ++INCLUDE DTSIS26 DTSCS26 -00629 EJECT DTSCS26 -00630 01 CATB-LITERALS. DTSCS26 -00631 ++INCLUDE DTSICATB DTSCS26 +00607 01 MQTR-REC. DTSCS26 +00608 ++INCLUDE DTSIMQTR DTSCS26 +00609 EJECT DTSCS26 +00610 01 MADJ-REC. DTSCS26 +00611 ++INCLUDE DTSIMADJ DTSCS26 +00612 EJECT DTSCS26 +00613 01 MDST-REC. DTSCS26 +00614 ++INCLUDE DTSIMDST DTSCS26 +00615 EJECT DTSCS26 +00616 01 MCMP-REC. DTSCS26 +00617 ++INCLUDE DTSIMCMP DTSCS26 +00618 EJECT DTSCS26 +00619 01 L823-COMM-AREA. DTSCS26 +00620 05 L823-CONTROL-BLOCK. DTSCS26 +00621 ++INCLUDE DTSIL823 DTSCS26 +00622 EJECT DTSCS26 +00623 05 ASKL-REC. DTSCS26 +00624 ++INCLUDE DTSIASKL DTSCS26 +00625 EJECT DTSCS26 +00626 01 AADJ-REC. DTSCS26 +00627 ++INCLUDE DTSIAADJ DTSCS26 +00628 EJECT DTSCS26 +00629 01 L826-COMM-AREA. DTSCS26 +00630 05 L826-CONTROL-BLOCK. DTSCS26 +00631 ++INCLUDE DTSIL826 DTSCS26 00632 DTSCS26 -00633 DTSCS26 -00634 DTSCS26 -00635 01 CFKD-LITERALS. DTSCS26 -00636 ++INCLUDE DTSICFKD DTSCS26 -00637 DTSCS26 +00633 05 AATH-REC. DTSCS26 +00634 ++INCLUDE DTSIAATH DTSCS26 +00635 DTSCS26 +00636 01 L851-COMM-AREA. DTSCS26 +00637 ++INCLUDE DTSIL851 DTSCS26 00638 DTSCS26 -00639 DTSCS26 -00640 01 CECD-LITERALS. DTSCS26 -00641 ++INCLUDE DTSICECD DTSCS26 -00642 DTSCS26 -00643 DTSCS26 +00639 05 MAP-AREA REDEFINES L851-MAP-AREA. DTSCS26 +00640 ++INCLUDE DTSIS26 DTSCS26 +00641 EJECT DTSCS26 +00642 01 CATB-LITERALS. DTSCS26 +00643 ++INCLUDE DTSICATB DTSCS26 00644 DTSCS26 -00645 01 CPCD-LITERALS. DTSCS26 -00646 ++INCLUDE DTSICPCD DTSCS26 -00647 EJECT DTSCS26 -00648 LINKAGE SECTION. DTSCS26 +00645 DTSCS26 +00646 DTSCS26 +00647 01 CFKD-LITERALS. DTSCS26 +00648 ++INCLUDE DTSICFKD DTSCS26 00649 DTSCS26 -00650 01 DFHCOMMAREA. DTSCS26 -00651 ++INCLUDE DTSILCCM DTSCS26 -00652 EJECT DTSCS26 -00653 ******************************************************************DTSCS26 -00654 * *DTSCS26 -00655 ******************************************************************DTSCS26 +00650 DTSCS26 +00651 DTSCS26 +00652 01 CECD-LITERALS. DTSCS26 +00653 ++INCLUDE DTSICECD DTSCS26 +00654 DTSCS26 +00655 DTSCS26 00656 DTSCS26 -00657 PROCEDURE DIVISION. DTSCS26 -00658 DTSCS26 -00659 MOVE +0 TO WRK-EMP-NO DTSCS26 -00660 WRK-BATCH-NO DTSCS26 -00661 WRK-ITEM-NO. DTSCS26 -00662 DTSCS26 -00663 MOVE LOW-VALUES TO MAP-AREA. DTSCS26 -00664 DTSCS26 -00665 SET CURSOR-SET-NO TO TRUE. DTSCS26 -00666 DTSCS26 -00667 DTSCS26 -00668 MOVE LCCM-SCR-NUM-ACCESS-IND (WRK-SCR-ID-N) DTSCS26 -00669 TO SCR-ACCESS-IND. DTSCS26 +00657 01 CPCD-LITERALS. DTSCS26 +00658 ++INCLUDE DTSICPCD DTSCS26 +00659 EJECT DTSCS26 +00660 LINKAGE SECTION. DTSCS26 +00661 DTSCS26 +00662 01 DFHCOMMAREA. DTSCS26 +00663 ++INCLUDE DTSILCCM DTSCS26 +00664 EJECT DTSCS26 +00665 ******************************************************************DTSCS26 +00666 * *DTSCS26 +00667 ******************************************************************DTSCS26 +00668 DTSCS26 +00669 PROCEDURE DIVISION. DTSCS26 00670 DTSCS26 -00671 DTSCS26 -00672 MOVE SPACE TO REQ-IND. DTSCS26 -00673 DTSCS26 -00674 PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT. DTSCS26 -00675 DTSCS26 +00671 MOVE +0 TO WRK-EMP-NO DTSCS26 +00672 WRK-BATCH-NO DTSCS26 +00673 WRK-ITEM-NO. DTSCS26 +00674 DTSCS26 +00675 MOVE LOW-VALUES TO MAP-AREA. DTSCS26 00676 DTSCS26 -00677 *----------------------------------------------------- DTSCS26 -00678 * P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE DTSCS26 -00679 * "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT DTSCS26 -00680 * REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE DTSCS26 -00681 * OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED. DTSCS26 -00682 * DTSCS26 -00683 * THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE DTSCS26 -00684 * PROCESSED. DTSCS26 -00685 * DTSCS26 -00686 * THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND, DTSCS26 -00687 * INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE DTSCS26 -00688 * WORK STATION OPERATOR. DTSCS26 +00677 SET CURSOR-SET-NO TO TRUE. DTSCS26 +00678 DTSCS26 +00679 DTSCS26 +00680 MOVE LCCM-SCR-NUM-ACCESS-IND (WRK-SCR-ID-N) DTSCS26 +00681 TO SCR-ACCESS-IND. DTSCS26 +00682 DTSCS26 +00683 DTSCS26 +00684 MOVE SPACE TO REQ-IND. DTSCS26 +00685 DTSCS26 +00686 PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT. DTSCS26 +00687 DTSCS26 +00688 DTSCS26 00689 *----------------------------------------------------- DTSCS26 -00690 DTSCS26 -00691 MOVE SPACE TO RESP-IND. DTSCS26 -00692 DTSCS26 -00693 IF REQ-ERROR DTSCS26 -00694 PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT DTSCS26 -00695 ELSE DTSCS26 -00696 IF REQ-JUMP DTSCS26 -00697 PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT DTSCS26 -00698 ELSE DTSCS26 -00699 IF REQ-CLEAR DTSCS26 -00700 PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT DTSCS26 -00701 ELSE DTSCS26 -00702 IF REQ-CURSOR-TO-GOTO DTSCS26 -00703 PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT DTSCS26 -00704 ELSE DTSCS26 -00705 IF REQ-INQUIRE DTSCS26 -00706 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT DTSCS26 +00690 * P1000-ANALYZE-REQUEST HAS DETERMINED, BASED ON THE DTSCS26 +00691 * "AID" KEY PRESSED AND THE CONTEXT OF THE CURRENT DTSCS26 +00692 * REQUEST WITHIN THE PSEUDO CONVERSATION, THE TYPE DTSCS26 +00693 * OF ACTIVITY THE WORK STATION OPERATOR HAS REQUESTED. DTSCS26 +00694 * DTSCS26 +00695 * THE REQUEST, REFLECTED IN REQ-IND WILL NOW BE DTSCS26 +00696 * PROCESSED. DTSCS26 +00697 * DTSCS26 +00698 * THE REQUEST PROCESSING PARAGRAPHS WILL SET RESP-IND, DTSCS26 +00699 * INDICATING THE TYPE OF RESPONSE TO BE SENT TO THE DTSCS26 +00700 * WORK STATION OPERATOR. DTSCS26 +00701 *----------------------------------------------------- DTSCS26 +00702 DTSCS26 +00703 MOVE SPACE TO RESP-IND. DTSCS26 +00704 DTSCS26 +00705 IF REQ-ERROR DTSCS26 +00706 PERFORM P2000-REQUEST-ERROR THRU P2000-EXIT DTSCS26 00707 ELSE DTSCS26 -00708 IF REQ-EDIT DTSCS26 -00709 PERFORM P7000-REQUEST-EDIT THRU P7000-EXIT DTSCS26 +00708 IF REQ-JUMP DTSCS26 +00709 PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT DTSCS26 00710 ELSE DTSCS26 -00711 IF REQ-UPDATE DTSCS26 -00712 PERFORM P8000-REQUEST-UPDATE THRU P8000-EXIT DTSCS26 +00711 IF REQ-CLEAR DTSCS26 +00712 PERFORM P4000-REQUEST-CLEAR THRU P4000-EXIT DTSCS26 00713 ELSE DTSCS26 -00714 GO TO S899-ABEND. DTSCS26 -00715 DTSCS26 -00716 DTSCS26 -00717 *----------------------------------------------------- DTSCS26 -00718 * THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED DTSCS26 -00719 * IN RESP-IND THE TYPE OF RESPONSE TO BE MADE. DTSCS26 -00720 *----------------------------------------------------- DTSCS26 -00721 DTSCS26 -00722 IF RESP-SEND-MAP DTSCS26 -00723 PERFORM S9300-SEND-MAP THRU S9300-EXIT DTSCS26 -00724 SET LCCM-END-TASK-88 TO TRUE DTSCS26 +00714 IF REQ-CURSOR-TO-GOTO DTSCS26 +00715 PERFORM P5000-CURSOR-TO-GOTO THRU P5000-EXIT DTSCS26 +00716 ELSE DTSCS26 +00717 IF REQ-INQUIRE DTSCS26 +00718 PERFORM P6000-REQUEST-INQUIRE THRU P6000-EXIT DTSCS26 +00719 ELSE DTSCS26 +00720 IF REQ-EDIT DTSCS26 +00721 PERFORM P7000-REQUEST-EDIT THRU P7000-EXIT DTSCS26 +00722 ELSE DTSCS26 +00723 IF REQ-UPDATE DTSCS26 +00724 PERFORM P8000-REQUEST-UPDATE THRU P8000-EXIT DTSCS26 00725 ELSE DTSCS26 -00726 IF RESP-SEND-MSGONLY DTSCS26 -00727 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS26 -00728 SET LCCM-END-TASK-88 TO TRUE DTSCS26 -00729 ELSE DTSCS26 -00730 IF RESP-JUMP DTSCS26 -00731 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS26 -00732 ELSE DTSCS26 -00733 IF RESP-CURSOR-TO-GOTO DTSCS26 -00734 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS26 -00735 SET LCCM-END-TASK-88 TO TRUE DTSCS26 -00736 ELSE DTSCS26 -00737 GO TO S899-ABEND. DTSCS26 -00738 DTSCS26 -00739 DTSCS26 -00740 MAINLINE-EXIT. DTSCS26 -00741 DTSCS26 -00742 EXEC CICS DTSCS26 -00743 RETURN DTSCS26 -00744 END-EXEC. DTSCS26 -00745 DTSCS26 -00746 DTSCS26 -00747 GOBACK. DTSCS26 -00748 /*****************************************************************DTSCS26 -00749 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION *DTSCS26 -00750 ******************************************************************DTSCS26 -00751 P1000-ANALYZE-REQUEST. DTSCS26 -00752 DTSCS26 -00753 *----------------------------------------------------- DTSCS26 -00754 * IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE) DTSCS26 -00755 * THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE DTSCS26 -00756 * REPLACED WITH F09) DTSCS26 -00757 *----------------------------------------------------- DTSCS26 +00726 GO TO S899-ABEND. DTSCS26 +00727 DTSCS26 +00728 DTSCS26 +00729 *----------------------------------------------------- DTSCS26 +00730 * THE REQUEST PROCESSING PARAGRAPHS HAVE INDICATED DTSCS26 +00731 * IN RESP-IND THE TYPE OF RESPONSE TO BE MADE. DTSCS26 +00732 *----------------------------------------------------- DTSCS26 +00733 DTSCS26 +00734 IF RESP-SEND-MAP DTSCS26 +00735 PERFORM S9300-SEND-MAP THRU S9300-EXIT DTSCS26 +00736 SET LCCM-END-TASK-88 TO TRUE DTSCS26 +00737 ELSE DTSCS26 +00738 IF RESP-SEND-MSGONLY DTSCS26 +00739 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS26 +00740 SET LCCM-END-TASK-88 TO TRUE DTSCS26 +00741 ELSE DTSCS26 +00742 IF RESP-JUMP DTSCS26 +00743 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS26 +00744 ELSE DTSCS26 +00745 IF RESP-CURSOR-TO-GOTO DTSCS26 +00746 PERFORM S9200-SEND-DATAONLY THRU S9200-EXIT DTSCS26 +00747 SET LCCM-END-TASK-88 TO TRUE DTSCS26 +00748 ELSE DTSCS26 +00749 GO TO S899-ABEND. DTSCS26 +00750 DTSCS26 +00751 DTSCS26 +00752 MAINLINE-EXIT. DTSCS26 +00753 DTSCS26 +00754 EXEC CICS DTSCS26 +00755 RETURN DTSCS26 +00756 END-EXEC. DTSCS26 +00757 DTSCS26 00758 DTSCS26 -00759 IF LCCM-SCR-ID NOT = WRK-SCR-ID DTSCS26 -00760 PERFORM P1200-JUMP-IN THRU P1200-EXIT DTSCS26 -00761 GO TO P1000-EXIT. DTSCS26 -00762 DTSCS26 -00763 DTSCS26 -00764 *----------------------------------------------------- DTSCS26 -00765 * RECEIVE THE MAP DTSCS26 -00766 *----------------------------------------------------- DTSCS26 -00767 DTSCS26 -00768 PERFORM S9100-RECEIVE THRU S9100-EXIT. DTSCS26 -00769 DTSCS26 +00759 GOBACK. DTSCS26 +00760 /*****************************************************************DTSCS26 +00761 * DETERMINE CURRENT SCREEN STATE AND REQUEST COMBINATION *DTSCS26 +00762 ******************************************************************DTSCS26 +00763 P1000-ANALYZE-REQUEST. DTSCS26 +00764 DTSCS26 +00765 *----------------------------------------------------- DTSCS26 +00766 * IF SCREEN IS NOT CURRENTLY DISPLAYED (JUMP TO HERE) DTSCS26 +00767 * THEN ANY KEY PRESSED WILL BE IGNORED (WILL BE DTSCS26 +00768 * REPLACED WITH F09) DTSCS26 +00769 *----------------------------------------------------- DTSCS26 00770 DTSCS26 -00771 *----------------------------------------------------- DTSCS26 -00772 * CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE DTSCS26 -00773 * WORK STATION DTSCS26 -00774 *----------------------------------------------------- DTSCS26 +00771 IF LCCM-SCR-ID NOT = WRK-SCR-ID DTSCS26 +00772 PERFORM P1200-JUMP-IN THRU P1200-EXIT DTSCS26 +00773 GO TO P1000-EXIT. DTSCS26 +00774 DTSCS26 00775 DTSCS26 -00776 IF LCCM-CLEAR-88 DTSCS26 -00777 SET REQ-CLEAR TO TRUE DTSCS26 -00778 GO TO P1000-EXIT. DTSCS26 +00776 *----------------------------------------------------- DTSCS26 +00777 * RECEIVE THE MAP DTSCS26 +00778 *----------------------------------------------------- DTSCS26 00779 DTSCS26 -00780 DTSCS26 -00781 *----------------------------------------------------- DTSCS26 -00782 * IF IN UPDATE MODE, SPECIFIC KEYS MUST BE CHECKED DTSCS26 +00780 PERFORM S9100-RECEIVE THRU S9100-EXIT. DTSCS26 +00781 DTSCS26 +00782 DTSCS26 00783 *----------------------------------------------------- DTSCS26 -00784 DTSCS26 -00785 IF LCCM-SCR-UPDATE-LOCKED DTSCS26 -00786 PERFORM P1100-UPDATE-LOCKED THRU P1100-EXIT DTSCS26 -00787 GO TO P1000-EXIT. DTSCS26 -00788 DTSCS26 -00789 DTSCS26 -00790 *----------------------------------------------------- DTSCS26 -00791 * PA2 IS A REQUEST TO POSITION CURSOR AT GO TO: DTSCS26 -00792 *----------------------------------------------------- DTSCS26 -00793 DTSCS26 -00794 IF LCCM-PA2-88 DTSCS26 -00795 SET REQ-CURSOR-TO-GOTO TO TRUE DTSCS26 -00796 GO TO P1000-EXIT. DTSCS26 -00797 DTSCS26 -00798 DTSCS26 -00799 *----------------------------------------------------- DTSCS26 -00800 * ALL OTHER PA KEYS ARE NOT ACTIVE DTSCS26 -00801 *----------------------------------------------------- DTSCS26 -00802 DTSCS26 -00803 IF LCCM-PA-88 DTSCS26 -00804 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS26 -00805 SET REQ-ERROR TO TRUE DTSCS26 -00806 GO TO P1000-EXIT. DTSCS26 -00807 DTSCS26 -00808 DTSCS26 -00809 *----------------------------------------------------- DTSCS26 -00810 * F12 PRESSED WHEN UPDATE NOT IN PROGRESS IS A DTSCS26 -00811 * REQUEST TO CLEAR THE SCREEN. DTSCS26 -00812 *----------------------------------------------------- DTSCS26 -00813 DTSCS26 -00814 IF LCCM-F12-88 DTSCS26 -00815 MOVE LOW-VALUES TO MAP-AREA DTSCS26 -00816 SET REQ-CLEAR TO TRUE DTSCS26 -00817 GO TO P1000-EXIT. DTSCS26 -00818 DTSCS26 +00784 * CHECK FOR AID KEYS THAT DO NOT SEND DATA FROM THE DTSCS26 +00785 * WORK STATION DTSCS26 +00786 *----------------------------------------------------- DTSCS26 +00787 DTSCS26 +00788 IF LCCM-CLEAR-88 DTSCS26 +00789 SET REQ-CLEAR TO TRUE DTSCS26 +00790 GO TO P1000-EXIT. DTSCS26 +00791 DTSCS26 +00792 DTSCS26 +00793 *----------------------------------------------------- DTSCS26 +00794 * IF IN UPDATE MODE, SPECIFIC KEYS MUST BE CHECKED DTSCS26 +00795 *----------------------------------------------------- DTSCS26 +00796 DTSCS26 +00797 IF LCCM-SCR-UPDATE-LOCKED DTSCS26 +00798 PERFORM P1100-UPDATE-LOCKED THRU P1100-EXIT DTSCS26 +00799 GO TO P1000-EXIT. DTSCS26 +00800 DTSCS26 +00801 DTSCS26 +00802 *----------------------------------------------------- DTSCS26 +00803 * PA2 IS A REQUEST TO POSITION CURSOR AT GO TO: DTSCS26 +00804 *----------------------------------------------------- DTSCS26 +00805 DTSCS26 +00806 IF LCCM-PA2-88 DTSCS26 +00807 SET REQ-CURSOR-TO-GOTO TO TRUE DTSCS26 +00808 GO TO P1000-EXIT. DTSCS26 +00809 DTSCS26 +00810 DTSCS26 +00811 *----------------------------------------------------- DTSCS26 +00812 * ALL OTHER PA KEYS ARE NOT ACTIVE DTSCS26 +00813 *----------------------------------------------------- DTSCS26 +00814 DTSCS26 +00815 IF LCCM-PA-88 DTSCS26 +00816 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS26 +00817 SET REQ-ERROR TO TRUE DTSCS26 +00818 GO TO P1000-EXIT. DTSCS26 00819 DTSCS26 -00820 *----------------------------------------------------- DTSCS26 -00821 * IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION DTSCS26 -00822 *----------------------------------------------------- DTSCS26 -00823 DTSCS26 -00824 IF LCCM-F03-88 DTSCS26 -00825 MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID DTSCS26 -00826 SET REQ-JUMP TO TRUE DTSCS26 -00827 GO TO P1000-EXIT. DTSCS26 -00828 DTSCS26 -00829 DTSCS26 -00830 *----------------------------------------------------- DTSCS26 -00831 * IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN DTSCS26 +00820 DTSCS26 +00821 *----------------------------------------------------- DTSCS26 +00822 * F12 PRESSED WHEN UPDATE NOT IN PROGRESS IS A DTSCS26 +00823 * REQUEST TO CLEAR THE SCREEN. DTSCS26 +00824 *----------------------------------------------------- DTSCS26 +00825 DTSCS26 +00826 IF LCCM-F12-88 DTSCS26 +00827 MOVE LOW-VALUES TO MAP-AREA DTSCS26 +00828 SET REQ-CLEAR TO TRUE DTSCS26 +00829 GO TO P1000-EXIT. DTSCS26 +00830 DTSCS26 +00831 DTSCS26 00832 *----------------------------------------------------- DTSCS26 -00833 DTSCS26 -00834 IF LCCM-F04-88 DTSCS26 -00835 MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS26 -00836 SET REQ-JUMP TO TRUE DTSCS26 -00837 GO TO P1000-EXIT. DTSCS26 -00838 DTSCS26 -00839 DTSCS26 -00840 *--------------------------------------------------------- DTSCS26 -00841 * IF CORRESPONDENCE SCREEN KEY PRESSED, JUMP TO DTSCS26 -00842 * CORRESPONDENCE SCREEN. DTSCS26 -00843 *--------------------------------------------------------- DTSCS26 -00844 DTSCS26 -00845 IF LCCM-F14-88 DTSCS26 -00846 MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS26 -00847 SET REQ-JUMP TO TRUE DTSCS26 -00848 GO TO P1000-EXIT. DTSCS26 -00849 DTSCS26 +00833 * IF EXIT KEY PRESSED, JUMP TO NEXT HIGHER FUNCTION DTSCS26 +00834 *----------------------------------------------------- DTSCS26 +00835 DTSCS26 +00836 IF LCCM-F03-88 DTSCS26 +00837 MOVE WRK-F03-SCR-ID TO LCCM-REQ-SCR-ID DTSCS26 +00838 SET REQ-JUMP TO TRUE DTSCS26 +00839 GO TO P1000-EXIT. DTSCS26 +00840 DTSCS26 +00841 DTSCS26 +00842 *----------------------------------------------------- DTSCS26 +00843 * IF PRIOR SCREEN KEY PRESSED, JUMP TO PREVIOUS SCREEN DTSCS26 +00844 *----------------------------------------------------- DTSCS26 +00845 DTSCS26 +00846 IF LCCM-F04-88 DTSCS26 +00847 MOVE LCCM-PRIOR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS26 +00848 SET REQ-JUMP TO TRUE DTSCS26 +00849 GO TO P1000-EXIT. DTSCS26 00850 DTSCS26 -00851 *----------------------------------------------------- DTSCS26 -00852 * IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO DTSCS26 -00853 * REQUESTED SCREEN TYPE DTSCS26 -00854 *----------------------------------------------------- DTSCS26 -00855 DTSCS26 -00856 IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID DTSCS26 -00857 NEXT SENTENCE DTSCS26 -00858 ELSE DTSCS26 -00859 MOVE MAP-GOTO TO LCCM-REQ-SCR-ID DTSCS26 -00860 SET REQ-JUMP TO TRUE DTSCS26 -00861 GO TO P1000-EXIT. DTSCS26 +00851 DTSCS26 +00852 *--------------------------------------------------------- DTSCS26 +00853 * IF CORRESPONDENCE SCREEN KEY PRESSED, JUMP TO DTSCS26 +00854 * CORRESPONDENCE SCREEN. DTSCS26 +00855 *--------------------------------------------------------- DTSCS26 +00856 DTSCS26 +00857 IF LCCM-F14-88 DTSCS26 +00858 MOVE LCCM-CORR-SCR-ID TO LCCM-REQ-SCR-ID DTSCS26 +00859 SET REQ-JUMP TO TRUE DTSCS26 +00860 GO TO P1000-EXIT. DTSCS26 +00861 DTSCS26 00862 DTSCS26 -00863 DTSCS26 -00864 *----------------------------------------------------- DTSCS26 -00865 * IF REQUEST TO UPDATE THE DATA (ADD,MOD,DEL) DTSCS26 -00866 * VERIFY USER ACCESS TO PERFORM UPDATE DTSCS26 -00867 *----------------------------------------------------- DTSCS26 -00868 DTSCS26 -00869 IF LCCM-ENTER-88 DTSCS26 -00870 IF SCR-ACCESS-UPDATE DTSCS26 -00871 SET REQ-UPDATE TO TRUE DTSCS26 -00872 GO TO P1000-EXIT DTSCS26 -00873 ELSE DTSCS26 -00874 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS26 -00875 SET REQ-ERROR TO TRUE DTSCS26 -00876 GO TO P1000-EXIT. DTSCS26 -00877 DTSCS26 -00878 DTSCS26 -00879 IF LCCM-F10-88 DTSCS26 -00880 OR LCCM-F23-88 DTSCS26 -00881 IF SCR-ACCESS-UPDATE DTSCS26 -00882 SET REQ-EDIT TO TRUE DTSCS26 -00883 GO TO P1000-EXIT DTSCS26 -00884 ELSE DTSCS26 -00885 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS26 -00886 SET REQ-ERROR TO TRUE DTSCS26 -00887 GO TO P1000-EXIT. DTSCS26 -00888 DTSCS26 +00863 *----------------------------------------------------- DTSCS26 +00864 * IF DIFFERENT SCREEN TYPE IS REQUESTED, JUMP TO DTSCS26 +00865 * REQUESTED SCREEN TYPE DTSCS26 +00866 *----------------------------------------------------- DTSCS26 +00867 DTSCS26 +00868 IF MAP-GOTO = SPACES OR LOW-VALUES OR WRK-SCR-ID DTSCS26 +00869 NEXT SENTENCE DTSCS26 +00870 ELSE DTSCS26 +00871 MOVE MAP-GOTO TO LCCM-REQ-SCR-ID DTSCS26 +00872 SET REQ-JUMP TO TRUE DTSCS26 +00873 GO TO P1000-EXIT. DTSCS26 +00874 DTSCS26 +00875 DTSCS26 +00876 *----------------------------------------------------- DTSCS26 +00877 * IF REQUEST TO UPDATE THE DATA (ADD,MOD,DEL) DTSCS26 +00878 * VERIFY USER ACCESS TO PERFORM UPDATE DTSCS26 +00879 *----------------------------------------------------- DTSCS26 +00880 DTSCS26 +00881 IF LCCM-ENTER-88 DTSCS26 +00882 IF SCR-ACCESS-UPDATE DTSCS26 +00883 SET REQ-UPDATE TO TRUE DTSCS26 +00884 GO TO P1000-EXIT DTSCS26 +00885 ELSE DTSCS26 +00886 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS26 +00887 SET REQ-ERROR TO TRUE DTSCS26 +00888 GO TO P1000-EXIT. DTSCS26 00889 DTSCS26 -00890 *----------------------------------------------------- DTSCS26 -00891 * IF INQUIRY TYPE KEY PRESSED (F9, F7, OR F8), DTSCS26 -00892 * INDICATES INQUIRY REQUEST DTSCS26 -00893 *----------------------------------------------------- DTSCS26 -00894 DTSCS26 -00895 IF LCCM-F09-88 DTSCS26 -00896 OR LCCM-F07-88 DTSCS26 -00897 OR LCCM-F08-88 DTSCS26 -00898 SET REQ-INQUIRE TO TRUE DTSCS26 -00899 GO TO P1000-EXIT. DTSCS26 +00890 DTSCS26 +00891 IF LCCM-F10-88 DTSCS26 +00892 OR LCCM-F23-88 DTSCS26 +00893 IF SCR-ACCESS-UPDATE DTSCS26 +00894 SET REQ-EDIT TO TRUE DTSCS26 +00895 GO TO P1000-EXIT DTSCS26 +00896 ELSE DTSCS26 +00897 PERFORM S804-INVALID-KEY THRU S804-EXIT DTSCS26 +00898 SET REQ-ERROR TO TRUE DTSCS26 +00899 GO TO P1000-EXIT. DTSCS26 00900 DTSCS26 00901 DTSCS26 00902 *----------------------------------------------------- DTSCS26 -00903 * ANY OTHER KEY IS INVALID DTSCS26 -00904 *----------------------------------------------------- DTSCS26 -00905 DTSCS26 -00906 PERFORM S804-INVALID-KEY THRU S804-EXIT. DTSCS26 -00907 DTSCS26 -00908 SET REQ-ERROR TO TRUE. DTSCS26 -00909 P1000-EXIT. DTSCS26 -00910 EXIT. DTSCS26 -00911 EJECT DTSCS26 -00912 ******************************************************************DTSCS26 -00913 * THE SCREEN IS LOCKED FOR UPDATE AND THE USER CONFIRMS HIS WISH *DTSCS26 -00914 ******************************************************************DTSCS26 -00915 DTSCS26 -00916 P1100-UPDATE-LOCKED. DTSCS26 +00903 * IF INQUIRY TYPE KEY PRESSED (F9, F7, OR F8), DTSCS26 +00904 * INDICATES INQUIRY REQUEST DTSCS26 +00905 *----------------------------------------------------- DTSCS26 +00906 DTSCS26 +00907 IF LCCM-F09-88 DTSCS26 +00908 OR LCCM-F07-88 DTSCS26 +00909 OR LCCM-F08-88 DTSCS26 +00910 SET REQ-INQUIRE TO TRUE DTSCS26 +00911 GO TO P1000-EXIT. DTSCS26 +00912 DTSCS26 +00913 DTSCS26 +00914 *----------------------------------------------------- DTSCS26 +00915 * ANY OTHER KEY IS INVALID DTSCS26 +00916 *----------------------------------------------------- DTSCS26 00917 DTSCS26 -00918 *----------------------------------------------------- DTSCS26 -00919 * IF THE SCREEN IS "LOCKED FOR UPDATE", THEN DTSCS26 -00920 * THE ONLY VALID OPERATOR REQUESTS ARE ENTER DTSCS26 -00921 * (CONFIRMING UPDATE) OR F12 (CANCELLING UPDATE). DTSCS26 -00922 *----------------------------------------------------- DTSCS26 -00923 DTSCS26 -00924 IF LCCM-ENTER-88 OR LCCM-F12-88 DTSCS26 -00925 SET REQ-UPDATE TO TRUE DTSCS26 -00926 ELSE DTSCS26 -00927 SET REQ-ERROR TO TRUE DTSCS26 -00928 ********IF LCCM-SCR-ADD-LOCKED DTSCS26 -00929 ******** MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-ID DTSCS26 -00930 ********ELSE DTSCS26 -00931 IF LCCM-SCR-MOD-LOCKED DTSCS26 -00932 MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID DTSCS26 -00933 ELSE DTSCS26 -00934 IF LCCM-SCR-DEL-LOCKED DTSCS26 -00935 MOVE PMSG-DEL-CONFIRM TO LCCM-MSG-ID DTSCS26 -00936 ELSE DTSCS26 -00937 GO TO S899-ABEND. DTSCS26 -00938 P1100-EXIT. DTSCS26 -00939 EXIT. DTSCS26 -00940 SKIP3 DTSCS26 -00941 *----------------------------------------------------- DTSCS26 -00942 * IF A DOCUMENT IS INDICATED BY LCCM-BATCH-NO AND DTSCS26 -00943 * LCCM-ITEM-NO AND THE DOCUMENT EXISTS AND THE DTSCS26 -00944 * DOCUMENT IS AN AADJ RECORD, THEN ASSUME WE ARE TO DTSCS26 -00945 * INQUIRE LCCM-BATCH-NO+LCCM-ITEM-NO; DTSCS26 -00946 * DTSCS26 -00947 * OTHERWISE, ASSUME WE ARE TO SET THE SCREEN TO A DTSCS26 -00948 * DATA ENTRY MODE (SET SCREEN TO CLEAR). DTSCS26 -00949 *----------------------------------------------------- DTSCS26 -00950 DTSCS26 -00951 P1200-JUMP-IN. DTSCS26 -00952 MOVE LOW-VALUES TO LCCM-SCR-HOLD-AREA. DTSCS26 -00953 DTSCS26 -00954 SET LCCM-F09-88 TO TRUE. DTSCS26 -00955 DTSCS26 -00956 IF LCCM-BATCH-NO = +0 DTSCS26 -00957 SET REQ-CLEAR TO TRUE DTSCS26 -00958 GO TO P1200-EXIT. DTSCS26 -00959 DTSCS26 -00960 IF LCCM-ITEM-NO = +0 DTSCS26 -00961 SET REQ-CLEAR TO TRUE DTSCS26 -00962 GO TO P1200-EXIT. DTSCS26 -00963 DTSCS26 -00964 DTSCS26 -00965 MOVE LOW-VALUES TO ASKL-KEY-AREA. DTSCS26 -00966 DTSCS26 -00967 MOVE LCCM-BATCH-NO TO ASKL-BATCH-NO. DTSCS26 -00968 DTSCS26 -00969 MOVE LCCM-ITEM-NO TO ASKL-ITEM-NO. DTSCS26 -00970 DTSCS26 -00971 PERFORM S823-READ THRU S823-EXIT. DTSCS26 -00972 DTSCS26 -00973 IF L823-NO-REC-88 DTSCS26 -00974 SET REQ-CLEAR TO TRUE DTSCS26 -00975 ELSE DTSCS26 -00976 IF ASKL-ADJ-88 DTSCS26 -00977 SET REQ-INQUIRE TO TRUE DTSCS26 -00978 MOVE LCCM-BATCH-NO TO MAP-BATCH-NO-N DTSCS26 -00979 MOVE LCCM-ITEM-NO TO MAP-ITEM-NO-N DTSCS26 -00980 ELSE DTSCS26 -00981 SET REQ-CLEAR TO TRUE. DTSCS26 -00982 P1200-EXIT. DTSCS26 -00983 EXIT. DTSCS26 -00984 /*****************************************************************DTSCS26 -00985 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED. *DTSCS26 -00986 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN. *DTSCS26 -00987 ******************************************************************DTSCS26 -00988 DTSCS26 -00989 P2000-REQUEST-ERROR. DTSCS26 -00990 IF LCCM-MSG DTSCS26 -00991 SET RESP-SEND-MSGONLY TO TRUE DTSCS26 +00918 PERFORM S804-INVALID-KEY THRU S804-EXIT. DTSCS26 +00919 DTSCS26 +00920 SET REQ-ERROR TO TRUE. DTSCS26 +00921 P1000-EXIT. DTSCS26 +00922 EXIT. DTSCS26 +00923 EJECT DTSCS26 +00924 ******************************************************************DTSCS26 +00925 * THE SCREEN IS LOCKED FOR UPDATE AND THE USER CONFIRMS HIS WISH *DTSCS26 +00926 ******************************************************************DTSCS26 +00927 DTSCS26 +00928 P1100-UPDATE-LOCKED. DTSCS26 +00929 DTSCS26 +00930 *----------------------------------------------------- DTSCS26 +00931 * IF THE SCREEN IS "LOCKED FOR UPDATE", THEN DTSCS26 +00932 * THE ONLY VALID OPERATOR REQUESTS ARE ENTER DTSCS26 +00933 * (CONFIRMING UPDATE) OR F12 (CANCELLING UPDATE). DTSCS26 +00934 *----------------------------------------------------- DTSCS26 +00935 DTSCS26 +00936 IF LCCM-ENTER-88 OR LCCM-F12-88 DTSCS26 +00937 SET REQ-UPDATE TO TRUE DTSCS26 +00938 ELSE DTSCS26 +00939 SET REQ-ERROR TO TRUE DTSCS26 +00940 ********IF LCCM-SCR-ADD-LOCKED DTSCS26 +00941 ******** MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-ID DTSCS26 +00942 ********ELSE DTSCS26 +00943 IF LCCM-SCR-MOD-LOCKED DTSCS26 +00944 MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID DTSCS26 +00945 ELSE DTSCS26 +00946 IF LCCM-SCR-DEL-LOCKED DTSCS26 +00947 MOVE PMSG-DEL-CONFIRM TO LCCM-MSG-ID DTSCS26 +00948 ELSE DTSCS26 +00949 GO TO S899-ABEND. DTSCS26 +00950 P1100-EXIT. DTSCS26 +00951 EXIT. DTSCS26 +00952 SKIP3 DTSCS26 +00953 *----------------------------------------------------- DTSCS26 +00954 * IF A DOCUMENT IS INDICATED BY LCCM-BATCH-NO AND DTSCS26 +00955 * LCCM-ITEM-NO AND THE DOCUMENT EXISTS AND THE DTSCS26 +00956 * DOCUMENT IS AN AADJ RECORD, THEN ASSUME WE ARE TO DTSCS26 +00957 * INQUIRE LCCM-BATCH-NO+LCCM-ITEM-NO; DTSCS26 +00958 * DTSCS26 +00959 * OTHERWISE, ASSUME WE ARE TO SET THE SCREEN TO A DTSCS26 +00960 * DATA ENTRY MODE (SET SCREEN TO CLEAR). DTSCS26 +00961 *----------------------------------------------------- DTSCS26 +00962 DTSCS26 +00963 P1200-JUMP-IN. DTSCS26 +00964 MOVE LOW-VALUES TO LCCM-SCR-HOLD-AREA. DTSCS26 +00965 DTSCS26 +00966 SET LCCM-F09-88 TO TRUE. DTSCS26 +00967 DTSCS26 +00968 IF LCCM-BATCH-NO = +0 DTSCS26 +00969 SET REQ-CLEAR TO TRUE DTSCS26 +00970 GO TO P1200-EXIT. DTSCS26 +00971 DTSCS26 +00972 IF LCCM-ITEM-NO = +0 DTSCS26 +00973 SET REQ-CLEAR TO TRUE DTSCS26 +00974 GO TO P1200-EXIT. DTSCS26 +00975 DTSCS26 +00976 DTSCS26 +00977 MOVE LOW-VALUES TO ASKL-KEY-AREA. DTSCS26 +00978 DTSCS26 +00979 MOVE LCCM-BATCH-NO TO ASKL-BATCH-NO. DTSCS26 +00980 DTSCS26 +00981 MOVE LCCM-ITEM-NO TO ASKL-ITEM-NO. DTSCS26 +00982 DTSCS26 +00983 PERFORM S823-READ THRU S823-EXIT. DTSCS26 +00984 DTSCS26 +00985 IF L823-NO-REC-88 DTSCS26 +00986 SET REQ-CLEAR TO TRUE DTSCS26 +00987 ELSE DTSCS26 +00988 IF ASKL-ADJ-88 DTSCS26 +00989 SET REQ-INQUIRE TO TRUE DTSCS26 +00990 MOVE LCCM-BATCH-NO TO MAP-BATCH-NO-N DTSCS26 +00991 MOVE LCCM-ITEM-NO TO MAP-ITEM-NO-N DTSCS26 00992 ELSE DTSCS26 -00993 GO TO S899-ABEND. DTSCS26 -00994 P2000-EXIT. DTSCS26 +00993 SET REQ-CLEAR TO TRUE. DTSCS26 +00994 P1200-EXIT. DTSCS26 00995 EXIT. DTSCS26 00996 /*****************************************************************DTSCS26 -00997 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED *DTSCS26 -00998 ******************************************************************DTSCS26 -00999 DTSCS26 -01000 P3000-REQUEST-JUMP. DTSCS26 -01001 DTSCS26 -01002 *----------------------------------------------------- DTSCS26 -01003 * VERIFY THAT THE REQUESTED SCREEN EXISTS AND IS ACCESSIBLE DTSCS26 -01004 * BY USER DTSCS26 -01005 *----------------------------------------------------- DTSCS26 -01006 DTSCS26 -01007 PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT. DTSCS26 -01008 DTSCS26 -01009 DTSCS26 -01010 *----------------------------------------------------- DTSCS26 -01011 * VERIFICATION RETURN LCCM-MSG IF ERROR DETECTED DTSCS26 -01012 *----------------------------------------------------- DTSCS26 +00997 * ANALYZE REQUEST HAS DETERMINED AN ERROR THAT MUST BE REPORTED. *DTSCS26 +00998 * VERIFY THAT A MESSAGE HAS BEEN FILLED IN. *DTSCS26 +00999 ******************************************************************DTSCS26 +01000 DTSCS26 +01001 P2000-REQUEST-ERROR. DTSCS26 +01002 IF LCCM-MSG DTSCS26 +01003 SET RESP-SEND-MSGONLY TO TRUE DTSCS26 +01004 ELSE DTSCS26 +01005 GO TO S899-ABEND. DTSCS26 +01006 P2000-EXIT. DTSCS26 +01007 EXIT. DTSCS26 +01008 /*****************************************************************DTSCS26 +01009 * JUMP TO A DIFFERENT SCREEN TYPE WAS REQUESTED *DTSCS26 +01010 ******************************************************************DTSCS26 +01011 DTSCS26 +01012 P3000-REQUEST-JUMP. DTSCS26 01013 DTSCS26 -01014 IF LCCM-MSG DTSCS26 -01015 SET RESP-SEND-MSGONLY TO TRUE DTSCS26 -01016 SET CURSOR-SET-GOTO TO TRUE DTSCS26 -01017 GO TO P3000-EXIT. DTSCS26 +01014 *----------------------------------------------------- DTSCS26 +01015 * VERIFY THAT THE REQUESTED SCREEN EXISTS AND IS ACCESSIBLE DTSCS26 +01016 * BY USER DTSCS26 +01017 *----------------------------------------------------- DTSCS26 01018 DTSCS26 -01019 DTSCS26 -01020 MOVE MAP-DOC-NO-AREA TO L019-S-DOC-NO. DTSCS26 +01019 PERFORM S803-REQ-SCR-ID-EDIT THRU S803-EXIT. DTSCS26 +01020 DTSCS26 01021 DTSCS26 -01022 PERFORM S019-BATCH-NO-FROM-SCREEN THRU S019-EXIT. DTSCS26 -01023 DTSCS26 -01024 IF L019-VALID DTSCS26 -01025 MOVE L019-DOC-NO TO LCCM-DOC-NO. DTSCS26 -01026 DTSCS26 -01027 DTSCS26 -01028 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS26 -01029 DTSCS26 -01030 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS26 +01022 *----------------------------------------------------- DTSCS26 +01023 * VERIFICATION RETURN LCCM-MSG IF ERROR DETECTED DTSCS26 +01024 *----------------------------------------------------- DTSCS26 +01025 DTSCS26 +01026 IF LCCM-MSG DTSCS26 +01027 SET RESP-SEND-MSGONLY TO TRUE DTSCS26 +01028 SET CURSOR-SET-GOTO TO TRUE DTSCS26 +01029 GO TO P3000-EXIT. DTSCS26 +01030 DTSCS26 01031 DTSCS26 -01032 IF L018-VALID DTSCS26 -01033 MOVE L018-EMP-NO TO LCCM-EMP-NO DTSCS26 -01034 MOVE MAP-APPLIC-YRQ-AREA TO L029-S-YRQ-AREA DTSCS26 -01035 PERFORM S029-YRQ-FROM-SCREEN THRU S029-EXIT DTSCS26 -01036 IF L029-VALID DTSCS26 -01037 MOVE L029-YRQ TO LCCM-YRQ DTSCS26 -01038 ELSE DTSCS26 -01039 MOVE +0 TO LCCM-YRQ. DTSCS26 -01040 DTSCS26 +01032 MOVE MAP-DOC-NO-AREA TO L019-S-DOC-NO. DTSCS26 +01033 DTSCS26 +01034 PERFORM S019-BATCH-NO-FROM-SCREEN THRU S019-EXIT. DTSCS26 +01035 DTSCS26 +01036 IF L019-VALID DTSCS26 +01037 MOVE L019-DOC-NO TO LCCM-DOC-NO. DTSCS26 +01038 DTSCS26 +01039 DTSCS26 +01040 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS26 01041 DTSCS26 -01042 *----------------------------------------------------- DTSCS26 -01043 * CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING DTSCS26 -01044 *----------------------------------------------------- DTSCS26 -01045 DTSCS26 -01046 MOVE LOW-VALUES TO LCCM-SCR-STATUS DTSCS26 -01047 LCCM-SCR-HOLD-AREA. DTSCS26 -01048 DTSCS26 -01049 MOVE +0 TO LCCM-SCR-ABSTIME. DTSCS26 -01050 DTSCS26 -01051 SET RESP-JUMP TO TRUE. DTSCS26 -01052 P3000-EXIT. DTSCS26 -01053 EXIT. DTSCS26 -01054 /*****************************************************************DTSCS26 -01055 * CLEAR KEY WAS PRESSED *DTSCS26 -01056 ******************************************************************DTSCS26 +01042 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS26 +01043 DTSCS26 +01044 IF L018-VALID DTSCS26 +01045 MOVE L018-EMP-NO TO LCCM-EMP-NO DTSCS26 +01046 MOVE MAP-APPLIC-YRQ-AREA TO L029-S-YRQ-AREA DTSCS26 +01047 PERFORM S029-YRQ-FROM-SCREEN THRU S029-EXIT DTSCS26 +01048 IF L029-VALID DTSCS26 +01049 MOVE L029-YRQ TO LCCM-YRQ DTSCS26 +01050 ELSE DTSCS26 +01051 MOVE +0 TO LCCM-YRQ. DTSCS26 +01052 DTSCS26 +01053 DTSCS26 +01054 *----------------------------------------------------- DTSCS26 +01055 * CLEAN UP INDICATORS AND PAGING STORAGE PRIOR TO LEAVING DTSCS26 +01056 *----------------------------------------------------- DTSCS26 01057 DTSCS26 -01058 P4000-REQUEST-CLEAR. DTSCS26 -01059 DTSCS26 -01060 *----------------------------------------------------- DTSCS26 -01061 * CLEAN UP INDICATORS AND PAGING STORAGE. RESET KEY DTSCS26 -01062 * FIELDS FROM EARLIER REQUESTS DTSCS26 -01063 *----------------------------------------------------- DTSCS26 -01064 DTSCS26 -01065 IF LCCM-BATCH-NO > ZERO DTSCS26 -01066 MOVE LCCM-BATCH-NO TO MAP-BATCH-NO. DTSCS26 -01067 DTSCS26 -01068 MOVE +0 TO LCCM-BATCH-NO. DTSCS26 +01058 MOVE LOW-VALUES TO LCCM-SCR-STATUS DTSCS26 +01059 LCCM-SCR-HOLD-AREA. DTSCS26 +01060 DTSCS26 +01061 MOVE +0 TO LCCM-SCR-ABSTIME. DTSCS26 +01062 DTSCS26 +01063 SET RESP-JUMP TO TRUE. DTSCS26 +01064 P3000-EXIT. DTSCS26 +01065 EXIT. DTSCS26 +01066 /*****************************************************************DTSCS26 +01067 * CLEAR KEY WAS PRESSED *DTSCS26 +01068 ******************************************************************DTSCS26 01069 DTSCS26 -01070 MOVE +0 TO LCCM-ITEM-NO. DTSCS26 +01070 P4000-REQUEST-CLEAR. DTSCS26 01071 DTSCS26 -01072 DTSCS26 -01073 *****IF (LCCM-SCR-ID = '23') DTSCS26 -01074 ***********AND DTSCS26 -01075 ********(LCCM-EMP-NO > +0) DTSCS26 -01076 *********PERFORM P4100-EMP-NO THRU P4100-EXIT. DTSCS26 -01077 DTSCS26 -01078 *****MOVE LCCM-ENTRY-MODE TO MAP-ENTRY-MODE. DTSCS26 +01072 *----------------------------------------------------- DTSCS26 +01073 * CLEAN UP INDICATORS AND PAGING STORAGE. RESET KEY DTSCS26 +01074 * FIELDS FROM EARLIER REQUESTS DTSCS26 +01075 *----------------------------------------------------- DTSCS26 +01076 DTSCS26 +01077 IF LCCM-BATCH-NO > ZERO DTSCS26 +01078 MOVE LCCM-BATCH-NO TO MAP-BATCH-NO. DTSCS26 01079 DTSCS26 -01080 *****IF MAP-ENTRY-MODE-2 DTSCS26 -01081 *********PERFORM P4200-ENTRY-MODE-2 THRU P4200-EXIT. DTSCS26 -01082 DTSCS26 -01083 IF SCR-ACCESS-UPDATE AND CURSOR-SET-NO DTSCS26 -01084 MOVE CATB-CURSOR TO MAP-ADJ-TYPE-L DTSCS26 -01085 SET CURSOR-SET-YES TO TRUE. DTSCS26 -01086 DTSCS26 -01087 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS26 -01088 DTSCS26 -01089 SET LCCM-SCR-CLEAR TO TRUE. DTSCS26 -01090 DTSCS26 -01091 IF SCR-ACCESS-UPDATE DTSCS26 -01092 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT DTSCS26 -01093 ELSE DTSCS26 -01094 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS26 -01095 DTSCS26 -01096 MOVE LOW-VALUES TO LCCM-SCR-HOLD-AREA. DTSCS26 -01097 DTSCS26 -01098 SET RESP-SEND-MAP TO TRUE. DTSCS26 -01099 P4000-EXIT. DTSCS26 -01100 EXIT. DTSCS26 -01101 SKIP3 DTSCS26 -01102 *P4100-EMP-NO. DTSCS26 -01103 *****MOVE LOW-VALUES TO MPRF-KEY-AREA. DTSCS26 -01104 *****MOVE LCCM-EMP-NO TO MPRF-EMP-NO. DTSCS26 -01105 *****SET MPRF-PRF-88 TO TRUE. DTSCS26 -01106 *****MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSCS26 -01107 *****PERFORM S810-READ THRU S810-EXIT. DTSCS26 -01108 *****IF L810-OK-88 DTSCS26 -01109 *********MOVE MSKL-REC TO MPRF-REC DTSCS26 -01110 *********MOVE LCCM-EMP-NO TO WRK-DISPLAY DTSCS26 -01111 *********MOVE WRK-EMP-NO-1 TO MAP-EMP-NO-1 DTSCS26 -01112 *********MOVE WRK-EMP-NO-2 TO MAP-EMP-NO-2 DTSCS26 -01113 *********MOVE MPRF-BUSINESS-NAME (1:4) TO MAP-NAME-CHECK. DTSCS26 -01114 *P4100-EXIT. DTSCS26 -01115 *****EXIT. DTSCS26 -01116 DTSCS26 -01117 DTSCS26 -01118 DTSCS26 -01119 *P4200-ENTRY-MODE-2. DTSCS26 -01120 *P4200-EXIT. DTSCS26 -01121 *****EXIT. DTSCS26 -01122 /*****************************************************************DTSCS26 -01123 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED *DTSCS26 -01124 ******************************************************************DTSCS26 -01125 DTSCS26 -01126 P5000-CURSOR-TO-GOTO. DTSCS26 -01127 SET CURSOR-SET-GOTO TO TRUE. DTSCS26 +01080 MOVE +0 TO LCCM-BATCH-NO. DTSCS26 +01081 DTSCS26 +01082 MOVE +0 TO LCCM-ITEM-NO. DTSCS26 +01083 DTSCS26 +01084 DTSCS26 +01085 *****IF (LCCM-SCR-ID = '23') DTSCS26 +01086 ***********AND DTSCS26 +01087 ********(LCCM-EMP-NO > +0) DTSCS26 +01088 *********PERFORM P4100-EMP-NO THRU P4100-EXIT. DTSCS26 +01089 DTSCS26 +01090 *****MOVE LCCM-ENTRY-MODE TO MAP-ENTRY-MODE. DTSCS26 +01091 DTSCS26 +01092 *****IF MAP-ENTRY-MODE-2 DTSCS26 +01093 *********PERFORM P4200-ENTRY-MODE-2 THRU P4200-EXIT. DTSCS26 +01094 DTSCS26 +01095 IF SCR-ACCESS-UPDATE AND CURSOR-SET-NO DTSCS26 +01096 MOVE CATB-CURSOR TO MAP-ADJ-TYPE-L DTSCS26 +01097 SET CURSOR-SET-YES TO TRUE. DTSCS26 +01098 DTSCS26 +01099 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS26 +01100 DTSCS26 +01101 SET LCCM-SCR-CLEAR TO TRUE. DTSCS26 +01102 DTSCS26 +01103 IF SCR-ACCESS-UPDATE DTSCS26 +01104 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT DTSCS26 +01105 ELSE DTSCS26 +01106 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS26 +01107 DTSCS26 +01108 MOVE LOW-VALUES TO LCCM-SCR-HOLD-AREA. DTSCS26 +01109 DTSCS26 +01110 SET RESP-SEND-MAP TO TRUE. DTSCS26 +01111 P4000-EXIT. DTSCS26 +01112 EXIT. DTSCS26 +01113 SKIP3 DTSCS26 +01114 *P4100-EMP-NO. DTSCS26 +01115 *****MOVE LOW-VALUES TO MPRF-KEY-AREA. DTSCS26 +01116 *****MOVE LCCM-EMP-NO TO MPRF-EMP-NO. DTSCS26 +01117 *****SET MPRF-PRF-88 TO TRUE. DTSCS26 +01118 *****MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSCS26 +01119 *****PERFORM S810-READ THRU S810-EXIT. DTSCS26 +01120 *****IF L810-OK-88 DTSCS26 +01121 *********MOVE MSKL-REC TO MPRF-REC DTSCS26 +01122 *********MOVE LCCM-EMP-NO TO WRK-DISPLAY DTSCS26 +01123 *********MOVE WRK-EMP-NO-1 TO MAP-EMP-NO-1 DTSCS26 +01124 *********MOVE WRK-EMP-NO-2 TO MAP-EMP-NO-2 DTSCS26 +01125 *********MOVE MPRF-BUSINESS-NAME (1:4) TO MAP-NAME-CHECK. DTSCS26 +01126 *P4100-EXIT. DTSCS26 +01127 *****EXIT. DTSCS26 01128 DTSCS26 -01129 SET RESP-CURSOR-TO-GOTO TO TRUE. DTSCS26 -01130 P5000-EXIT. DTSCS26 -01131 EXIT. DTSCS26 -01132 /*****************************************************************DTSCS26 -01133 * INQUIRY WAS REQUESTED *DTSCS26 -01134 ******************************************************************DTSCS26 -01135 DTSCS26 -01136 P6000-REQUEST-INQUIRE. DTSCS26 -01137 MOVE MAP-DOC-NO-AREA TO L019-S-DOC-NO. DTSCS26 -01138 DTSCS26 -01139 MOVE LOW-VALUES TO MAP-AREA. DTSCS26 +01129 DTSCS26 +01130 DTSCS26 +01131 *P4200-ENTRY-MODE-2. DTSCS26 +01132 *P4200-EXIT. DTSCS26 +01133 *****EXIT. DTSCS26 +01134 /*****************************************************************DTSCS26 +01135 * POSITION CURSOR ON GO TO FIELD WAS REQUESTED *DTSCS26 +01136 ******************************************************************DTSCS26 +01137 DTSCS26 +01138 P5000-CURSOR-TO-GOTO. DTSCS26 +01139 SET CURSOR-SET-GOTO TO TRUE. DTSCS26 01140 DTSCS26 -01141 MOVE L019-S-DOC-NO TO MAP-DOC-NO-AREA. DTSCS26 -01142 DTSCS26 -01143 DTSCS26 -01144 SET LCCM-SCR-CLEAR TO TRUE. DTSCS26 -01145 DTSCS26 -01146 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS26 +01141 SET RESP-CURSOR-TO-GOTO TO TRUE. DTSCS26 +01142 P5000-EXIT. DTSCS26 +01143 EXIT. DTSCS26 +01144 /*****************************************************************DTSCS26 +01145 * INQUIRY WAS REQUESTED *DTSCS26 +01146 ******************************************************************DTSCS26 01147 DTSCS26 -01148 SET RESP-SEND-MAP TO TRUE. DTSCS26 -01149 DTSCS26 -01150 IF SCR-ACCESS-UPDATE DTSCS26 -01151 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT DTSCS26 -01152 ELSE DTSCS26 -01153 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS26 +01148 P6000-REQUEST-INQUIRE. DTSCS26 +01149 MOVE MAP-DOC-NO-AREA TO L019-S-DOC-NO. DTSCS26 +01150 DTSCS26 +01151 MOVE LOW-VALUES TO MAP-AREA. DTSCS26 +01152 DTSCS26 +01153 MOVE L019-S-DOC-NO TO MAP-DOC-NO-AREA. DTSCS26 01154 DTSCS26 -01155 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS26 -01156 DTSCS26 -01157 IF LCCM-MSG DTSCS26 -01158 GO TO P6000-EXIT. DTSCS26 +01155 DTSCS26 +01156 SET LCCM-SCR-CLEAR TO TRUE. DTSCS26 +01157 DTSCS26 +01158 MOVE LCCM-TASK-START-ABSTIME TO LCCM-SCR-ABSTIME. DTSCS26 01159 DTSCS26 -01160 IF WRK-BATCH-NO = LCCM-BATCH-NO DTSCS26 -01161 NEXT SENTENCE DTSCS26 -01162 ELSE DTSCS26 -01163 MOVE WRK-BATCH-NO TO LCCM-BATCH-NO DTSCS26 -01164 MOVE +0 TO LCCM-ITEM-NO. DTSCS26 -01165 DTSCS26 -01166 IF WRK-ITEM-NO = +0 DTSCS26 -01167 MOVE LCCM-ITEM-NO TO WRK-ITEM-NO. DTSCS26 +01160 SET RESP-SEND-MAP TO TRUE. DTSCS26 +01161 DTSCS26 +01162 IF SCR-ACCESS-UPDATE DTSCS26 +01163 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT DTSCS26 +01164 ELSE DTSCS26 +01165 PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT. DTSCS26 +01166 DTSCS26 +01167 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS26 01168 DTSCS26 -01169 PERFORM P6100-LOCATE-REC THRU P6100-EXIT. DTSCS26 -01170 DTSCS26 -01171 IF LCCM-MSG DTSCS26 -01172 GO TO P6000-EXIT. DTSCS26 -01173 DTSCS26 -01174 MOVE ASKL-ITEM-NO TO LCCM-ITEM-NO. DTSCS26 -01175 DTSCS26 -01176 IF REQ-JUMP DTSCS26 -01177 MOVE LCCM-ITEM-NO TO MAP-ITEM-NO-N DTSCS26 -01178 PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT DTSCS26 -01179 GO TO P6000-EXIT. DTSCS26 +01169 IF LCCM-MSG DTSCS26 +01170 GO TO P6000-EXIT. DTSCS26 +01171 DTSCS26 +01172 IF WRK-BATCH-NO = LCCM-BATCH-NO DTSCS26 +01173 NEXT SENTENCE DTSCS26 +01174 ELSE DTSCS26 +01175 MOVE WRK-BATCH-NO TO LCCM-BATCH-NO DTSCS26 +01176 MOVE +0 TO LCCM-ITEM-NO. DTSCS26 +01177 DTSCS26 +01178 IF WRK-ITEM-NO = +0 DTSCS26 +01179 MOVE LCCM-ITEM-NO TO WRK-ITEM-NO. DTSCS26 01180 DTSCS26 -01181 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT DTSCS26 +01181 PERFORM P6100-LOCATE-REC THRU P6100-EXIT. DTSCS26 01182 DTSCS26 -01183 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS26 -01184 P6000-EXIT. DTSCS26 -01185 EXIT. DTSCS26 -01186 EJECT DTSCS26 -01187 P6100-LOCATE-REC. DTSCS26 -01188 PERFORM P6110-START-REC THRU P6110-EXIT. DTSCS26 -01189 DTSCS26 -01190 IF L823-NO-REC-88 DTSCS26 -01191 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS26 -01192 PERFORM S1111-ERROR THRU S1111-EXIT DTSCS26 -01193 GO TO P6100-EXIT. DTSCS26 +01183 IF LCCM-MSG DTSCS26 +01184 GO TO P6000-EXIT. DTSCS26 +01185 DTSCS26 +01186 MOVE ASKL-ITEM-NO TO LCCM-ITEM-NO. DTSCS26 +01187 DTSCS26 +01188 IF REQ-JUMP DTSCS26 +01189 MOVE LCCM-ITEM-NO TO MAP-ITEM-NO-N DTSCS26 +01190 PERFORM P3000-REQUEST-JUMP THRU P3000-EXIT DTSCS26 +01191 GO TO P6000-EXIT. DTSCS26 +01192 DTSCS26 +01193 PERFORM P6900-CONSTRUCT-SCREEN THRU P6900-EXIT DTSCS26 01194 DTSCS26 -01195 MOVE SPACE TO PAGE-TYPE-IND. DTSCS26 -01196 DTSCS26 -01197 IF LCCM-F09-88 DTSCS26 -01198 PERFORM P6120-PAGE-NONE THRU P6120-EXIT DTSCS26 -01199 ELSE DTSCS26 -01200 IF LCCM-F07-88 DTSCS26 -01201 PERFORM P6130-PAGE-BACK THRU P6130-EXIT DTSCS26 -01202 ELSE DTSCS26 -01203 IF LCCM-F08-88 DTSCS26 -01204 PERFORM P6140-PAGE-NEXT THRU P6140-EXIT DTSCS26 -01205 ELSE DTSCS26 -01206 GO TO S899-ABEND. DTSCS26 -01207 DTSCS26 -01208 IF LCCM-MSG DTSCS26 -01209 GO TO P6100-EXIT. DTSCS26 -01210 DTSCS26 -01211 IF ASKL-ADJ-88 DTSCS26 -01212 NEXT SENTENCE DTSCS26 -01213 ELSE DTSCS26 -01214 IF ASKL-PAY-88 DTSCS26 -01215 MOVE '25' TO LCCM-REQ-SCR-ID DTSCS26 -01216 SET REQ-JUMP TO TRUE DTSCS26 +01195 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS26 +01196 P6000-EXIT. DTSCS26 +01197 EXIT. DTSCS26 +01198 EJECT DTSCS26 +01199 P6100-LOCATE-REC. DTSCS26 +01200 PERFORM P6110-START-REC THRU P6110-EXIT. DTSCS26 +01201 DTSCS26 +01202 IF L823-NO-REC-88 DTSCS26 +01203 MOVE EMSG-NO-RECORD TO WRK-MSG-AREA DTSCS26 +01204 PERFORM S1111-ERROR THRU S1111-EXIT DTSCS26 +01205 GO TO P6100-EXIT. DTSCS26 +01206 DTSCS26 +01207 MOVE SPACE TO PAGE-TYPE-IND. DTSCS26 +01208 DTSCS26 +01209 IF LCCM-F09-88 DTSCS26 +01210 PERFORM P6120-PAGE-NONE THRU P6120-EXIT DTSCS26 +01211 ELSE DTSCS26 +01212 IF LCCM-F07-88 DTSCS26 +01213 PERFORM P6130-PAGE-BACK THRU P6130-EXIT DTSCS26 +01214 ELSE DTSCS26 +01215 IF LCCM-F08-88 DTSCS26 +01216 PERFORM P6140-PAGE-NEXT THRU P6140-EXIT DTSCS26 01217 ELSE DTSCS26 -01218 IF ASKL-RPT-88 DTSCS26 -01219 MOVE '24' TO LCCM-REQ-SCR-ID DTSCS26 -01220 SET REQ-JUMP TO TRUE DTSCS26 -01221 ELSE DTSCS26 -01222 GO TO S899-ABEND. DTSCS26 -01223 P6100-EXIT. DTSCS26 -01224 EXIT. DTSCS26 -01225 SKIP3 DTSCS26 -01226 P6110-START-REC. DTSCS26 -01227 MOVE LOW-VALUES TO ASKL-KEY-AREA. DTSCS26 -01228 DTSCS26 -01229 MOVE WRK-BATCH-NO TO ASKL-BATCH-NO. DTSCS26 -01230 DTSCS26 -01231 MOVE WRK-ITEM-NO TO ASKL-ITEM-NO. DTSCS26 -01232 DTSCS26 -01233 IF ASKL-ITEM-NO = +0 DTSCS26 -01234 MOVE +1 TO ASKL-ITEM-NO. DTSCS26 -01235 DTSCS26 -01236 DTSCS26 -01237 PERFORM S823-START-BROWSE THRU S823-EXIT. DTSCS26 -01238 DTSCS26 -01239 IF L823-NO-REC-88 DTSCS26 -01240 NEXT SENTENCE DTSCS26 -01241 ELSE DTSCS26 -01242 IF WRK-BATCH-NO = ASKL-BATCH-NO DTSCS26 -01243 GO TO P6110-EXIT DTSCS26 -01244 ELSE DTSCS26 -01245 PERFORM S823-END-BROWSE THRU S823-EXIT. DTSCS26 -01246 DTSCS26 +01218 GO TO S899-ABEND. DTSCS26 +01219 DTSCS26 +01220 IF LCCM-MSG DTSCS26 +01221 GO TO P6100-EXIT. DTSCS26 +01222 DTSCS26 +01223 IF ASKL-ADJ-88 DTSCS26 +01224 NEXT SENTENCE DTSCS26 +01225 ELSE DTSCS26 +01226 IF ASKL-PAY-88 DTSCS26 +01227 MOVE '25' TO LCCM-REQ-SCR-ID DTSCS26 +01228 SET REQ-JUMP TO TRUE DTSCS26 +01229 ELSE DTSCS26 +01230 IF ASKL-RPT-88 DTSCS26 +01231 MOVE '24' TO LCCM-REQ-SCR-ID DTSCS26 +01232 SET REQ-JUMP TO TRUE DTSCS26 +01233 ELSE DTSCS26 +01234 GO TO S899-ABEND. DTSCS26 +01235 P6100-EXIT. DTSCS26 +01236 EXIT. DTSCS26 +01237 SKIP3 DTSCS26 +01238 P6110-START-REC. DTSCS26 +01239 MOVE LOW-VALUES TO ASKL-KEY-AREA. DTSCS26 +01240 DTSCS26 +01241 MOVE WRK-BATCH-NO TO ASKL-BATCH-NO. DTSCS26 +01242 DTSCS26 +01243 MOVE WRK-ITEM-NO TO ASKL-ITEM-NO. DTSCS26 +01244 DTSCS26 +01245 IF ASKL-ITEM-NO = +0 DTSCS26 +01246 MOVE +1 TO ASKL-ITEM-NO. DTSCS26 01247 DTSCS26 -01248 MOVE LOW-VALUES TO ASKL-KEY-AREA. DTSCS26 -01249 DTSCS26 -01250 MOVE WRK-BATCH-NO TO ASKL-BATCH-NO. DTSCS26 -01251 DTSCS26 -01252 MOVE +1 TO ASKL-ITEM-NO. DTSCS26 -01253 DTSCS26 -01254 PERFORM S823-START-BROWSE THRU S823-EXIT. DTSCS26 -01255 DTSCS26 -01256 IF L823-NO-REC-88 DTSCS26 -01257 NEXT SENTENCE DTSCS26 -01258 ELSE DTSCS26 -01259 IF WRK-BATCH-NO = ASKL-BATCH-NO DTSCS26 -01260 PERFORM P6111-POSITION-LAST THRU P6111-EXIT DTSCS26 -01261 GO TO P6110-EXIT DTSCS26 -01262 ELSE DTSCS26 -01263 PERFORM S823-END-BROWSE THRU S823-EXIT DTSCS26 -01264 SET L823-NO-REC-88 TO TRUE. DTSCS26 -01265 P6110-EXIT. DTSCS26 -01266 EXIT. DTSCS26 -01267 SKIP3 DTSCS26 -01268 P6111-POSITION-LAST. DTSCS26 -01269 PERFORM DTSCS26 -01270 UNTIL L823-NO-REC-88 DTSCS26 -01271 MOVE ASKL-KEY-AREA TO HOLD-KEY-AREA DTSCS26 -01272 PERFORM S823-READ-NEXT THRU S823-EXIT DTSCS26 -01273 IF L823-OK-88 DTSCS26 -01274 IF WRK-BATCH-NO NOT = ASKL-BATCH-NO DTSCS26 -01275 PERFORM S823-END-BROWSE THRU S823-EXIT DTSCS26 -01276 SET L823-NO-REC-88 TO TRUE DTSCS26 -01277 END-IF DTSCS26 -01278 END-IF DTSCS26 -01279 END-PERFORM. DTSCS26 -01280 DTSCS26 -01281 MOVE HOLD-KEY-AREA TO ASKL-KEY-AREA. DTSCS26 -01282 DTSCS26 -01283 PERFORM S823-START-BROWSE THRU S823-EXIT. DTSCS26 -01284 DTSCS26 -01285 IF L823-NO-REC-88 DTSCS26 -01286 NEXT SENTENCE DTSCS26 -01287 ELSE DTSCS26 -01288 IF ASKL-KEY-AREA NOT = HOLD-KEY-AREA DTSCS26 -01289 PERFORM S823-END-BROWSE THRU S823-EXIT DTSCS26 -01290 SET L823-NO-REC-88 TO TRUE. DTSCS26 -01291 P6111-EXIT. DTSCS26 -01292 EXIT. DTSCS26 -01293 SKIP3 DTSCS26 -01294 P6120-PAGE-NONE. DTSCS26 -01295 PERFORM S823-END-BROWSE THRU S823-EXIT. DTSCS26 +01248 DTSCS26 +01249 PERFORM S823-START-BROWSE THRU S823-EXIT. DTSCS26 +01250 DTSCS26 +01251 IF L823-NO-REC-88 DTSCS26 +01252 NEXT SENTENCE DTSCS26 +01253 ELSE DTSCS26 +01254 IF WRK-BATCH-NO = ASKL-BATCH-NO DTSCS26 +01255 GO TO P6110-EXIT DTSCS26 +01256 ELSE DTSCS26 +01257 PERFORM S823-END-BROWSE THRU S823-EXIT. DTSCS26 +01258 DTSCS26 +01259 DTSCS26 +01260 MOVE LOW-VALUES TO ASKL-KEY-AREA. DTSCS26 +01261 DTSCS26 +01262 MOVE WRK-BATCH-NO TO ASKL-BATCH-NO. DTSCS26 +01263 DTSCS26 +01264 MOVE +1 TO ASKL-ITEM-NO. DTSCS26 +01265 DTSCS26 +01266 PERFORM S823-START-BROWSE THRU S823-EXIT. DTSCS26 +01267 DTSCS26 +01268 IF L823-NO-REC-88 DTSCS26 +01269 NEXT SENTENCE DTSCS26 +01270 ELSE DTSCS26 +01271 IF WRK-BATCH-NO = ASKL-BATCH-NO DTSCS26 +01272 PERFORM P6111-POSITION-LAST THRU P6111-EXIT DTSCS26 +01273 GO TO P6110-EXIT DTSCS26 +01274 ELSE DTSCS26 +01275 PERFORM S823-END-BROWSE THRU S823-EXIT DTSCS26 +01276 SET L823-NO-REC-88 TO TRUE. DTSCS26 +01277 P6110-EXIT. DTSCS26 +01278 EXIT. DTSCS26 +01279 SKIP3 DTSCS26 +01280 P6111-POSITION-LAST. DTSCS26 +01281 PERFORM DTSCS26 +01282 UNTIL L823-NO-REC-88 DTSCS26 +01283 MOVE ASKL-KEY-AREA TO HOLD-KEY-AREA DTSCS26 +01284 PERFORM S823-READ-NEXT THRU S823-EXIT DTSCS26 +01285 IF L823-OK-88 DTSCS26 +01286 IF WRK-BATCH-NO NOT = ASKL-BATCH-NO DTSCS26 +01287 PERFORM S823-END-BROWSE THRU S823-EXIT DTSCS26 +01288 SET L823-NO-REC-88 TO TRUE DTSCS26 +01289 END-IF DTSCS26 +01290 END-IF DTSCS26 +01291 END-PERFORM. DTSCS26 +01292 DTSCS26 +01293 MOVE HOLD-KEY-AREA TO ASKL-KEY-AREA. DTSCS26 +01294 DTSCS26 +01295 PERFORM S823-START-BROWSE THRU S823-EXIT. DTSCS26 01296 DTSCS26 -01297 IF WRK-ITEM-NO = +0 DTSCS26 +01297 IF L823-NO-REC-88 DTSCS26 01298 NEXT SENTENCE DTSCS26 01299 ELSE DTSCS26 -01300 IF ASKL-ITEM-NO = WRK-ITEM-NO DTSCS26 -01301 NEXT SENTENCE DTSCS26 -01302 ELSE DTSCS26 -01303 MOVE EMSG-NO-DOC TO WRK-MSG-AREA DTSCS26 -01304 PERFORM S1112-ERROR THRU S1112-EXIT. DTSCS26 -01305 P6120-EXIT. DTSCS26 -01306 EXIT. DTSCS26 -01307 SKIP3 DTSCS26 -01308 P6130-PAGE-BACK. DTSCS26 -01309 IF ASKL-ITEM-NO >= LCCM-ITEM-NO DTSCS26 +01300 IF ASKL-KEY-AREA NOT = HOLD-KEY-AREA DTSCS26 +01301 PERFORM S823-END-BROWSE THRU S823-EXIT DTSCS26 +01302 SET L823-NO-REC-88 TO TRUE. DTSCS26 +01303 P6111-EXIT. DTSCS26 +01304 EXIT. DTSCS26 +01305 SKIP3 DTSCS26 +01306 P6120-PAGE-NONE. DTSCS26 +01307 PERFORM S823-END-BROWSE THRU S823-EXIT. DTSCS26 +01308 DTSCS26 +01309 IF WRK-ITEM-NO = +0 DTSCS26 01310 NEXT SENTENCE DTSCS26 01311 ELSE DTSCS26 -01312 PERFORM S823-END-BROWSE THRU S823-EXIT DTSCS26 -01313 GO TO P6130-EXIT. DTSCS26 -01314 DTSCS26 -01315 MOVE ASKL-KEY-AREA TO HOLD-KEY-AREA. DTSCS26 -01316 DTSCS26 -01317 PERFORM S823-READ-PREV THRU S823-EXIT. DTSCS26 -01318 DTSCS26 -01319 IF L823-NO-REC-88 DTSCS26 -01320 SET PAGE-FIRST-88 TO TRUE DTSCS26 -01321 GO TO P6130-EXIT. DTSCS26 -01322 DTSCS26 -01323 PERFORM S823-READ-PREV THRU S823-EXIT. DTSCS26 -01324 DTSCS26 -01325 IF L823-NO-REC-88 DTSCS26 -01326 SET PAGE-FIRST-88 TO TRUE DTSCS26 -01327 GO TO P6130-EXIT. DTSCS26 +01312 IF ASKL-ITEM-NO = WRK-ITEM-NO DTSCS26 +01313 NEXT SENTENCE DTSCS26 +01314 ELSE DTSCS26 +01315 MOVE EMSG-NO-DOC TO WRK-MSG-AREA DTSCS26 +01316 PERFORM S1112-ERROR THRU S1112-EXIT. DTSCS26 +01317 P6120-EXIT. DTSCS26 +01318 EXIT. DTSCS26 +01319 SKIP3 DTSCS26 +01320 P6130-PAGE-BACK. DTSCS26 +01321 IF ASKL-ITEM-NO >= LCCM-ITEM-NO DTSCS26 +01322 NEXT SENTENCE DTSCS26 +01323 ELSE DTSCS26 +01324 PERFORM S823-END-BROWSE THRU S823-EXIT DTSCS26 +01325 GO TO P6130-EXIT. DTSCS26 +01326 DTSCS26 +01327 MOVE ASKL-KEY-AREA TO HOLD-KEY-AREA. DTSCS26 01328 DTSCS26 -01329 PERFORM S823-END-BROWSE THRU S823-EXIT. DTSCS26 +01329 PERFORM S823-READ-PREV THRU S823-EXIT. DTSCS26 01330 DTSCS26 -01331 IF (ASKL-ITEM-NO > +0) DTSCS26 -01332 AND DTSCS26 -01333 (ASKL-BATCH-NO = WRK-BATCH-NO) DTSCS26 -01334 NEXT SENTENCE DTSCS26 -01335 ELSE DTSCS26 -01336 SET PAGE-FIRST-88 TO TRUE DTSCS26 -01337 MOVE HOLD-KEY-AREA TO ASKL-KEY-AREA DTSCS26 -01338 PERFORM S823-READ THRU S823-EXIT DTSCS26 -01339 IF L823-NO-REC-88 DTSCS26 -01340 GO TO S899-ABEND. DTSCS26 -01341 P6130-EXIT. DTSCS26 -01342 EXIT. DTSCS26 -01343 SKIP3 DTSCS26 -01344 P6140-PAGE-NEXT. DTSCS26 -01345 IF LCCM-ITEM-NO = ASKL-ITEM-NO DTSCS26 +01331 IF L823-NO-REC-88 DTSCS26 +01332 SET PAGE-FIRST-88 TO TRUE DTSCS26 +01333 GO TO P6130-EXIT. DTSCS26 +01334 DTSCS26 +01335 PERFORM S823-READ-PREV THRU S823-EXIT. DTSCS26 +01336 DTSCS26 +01337 IF L823-NO-REC-88 DTSCS26 +01338 SET PAGE-FIRST-88 TO TRUE DTSCS26 +01339 GO TO P6130-EXIT. DTSCS26 +01340 DTSCS26 +01341 PERFORM S823-END-BROWSE THRU S823-EXIT. DTSCS26 +01342 DTSCS26 +01343 IF (ASKL-ITEM-NO > +0) DTSCS26 +01344 AND DTSCS26 +01345 (ASKL-BATCH-NO = WRK-BATCH-NO) DTSCS26 01346 NEXT SENTENCE DTSCS26 01347 ELSE DTSCS26 -01348 PERFORM S823-END-BROWSE THRU S823-EXIT DTSCS26 -01349 GO TO P6140-EXIT. DTSCS26 -01350 DTSCS26 -01351 MOVE ASKL-KEY-AREA TO HOLD-KEY-AREA. DTSCS26 -01352 DTSCS26 -01353 PERFORM S823-READ-NEXT THRU S823-EXIT. DTSCS26 -01354 DTSCS26 -01355 IF L823-NO-REC-88 DTSCS26 -01356 SET PAGE-LAST-88 TO TRUE DTSCS26 -01357 GO TO P6140-EXIT. DTSCS26 -01358 DTSCS26 -01359 PERFORM S823-END-BROWSE THRU S823-EXIT. DTSCS26 -01360 DTSCS26 -01361 IF (ASKL-ITEM-NO > +0) DTSCS26 -01362 AND DTSCS26 -01363 (ASKL-BATCH-NO = WRK-BATCH-NO) DTSCS26 -01364 NEXT SENTENCE DTSCS26 -01365 ELSE DTSCS26 -01366 SET PAGE-LAST-88 TO TRUE DTSCS26 -01367 MOVE HOLD-KEY-AREA TO ASKL-KEY-AREA DTSCS26 -01368 PERFORM S823-READ THRU S823-EXIT DTSCS26 -01369 IF L823-NO-REC-88 DTSCS26 -01370 GO TO S899-ABEND. DTSCS26 -01371 P6140-EXIT. DTSCS26 -01372 EXIT. DTSCS26 -01373 /*****************************************************************DTSCS26 -01374 * THE RECORD WAS FOUND SO FORMAT AND PLACE ALL FIELDS *DTSCS26 -01375 ******************************************************************DTSCS26 -01376 DTSCS26 -01377 P6900-CONSTRUCT-SCREEN. DTSCS26 -01378 IF ASKL-ADJ-88 DTSCS26 -01379 NEXT SENTENCE DTSCS26 -01380 ELSE DTSCS26 -01381 GO TO S899-ABEND. DTSCS26 -01382 DTSCS26 -01383 MOVE ASKL-REC TO AADJ-REC. DTSCS26 -01384 DTSCS26 -01385 PERFORM P6910-FROM-AADJ THRU P6910-EXIT. DTSCS26 -01386 DTSCS26 -01387 IF AADJ-PROCESSED-DATE > +0 DTSCS26 -01388 MOVE MSG-P26D-AREA TO LCCM-MSG-AREA DTSCS26 -01389 *********PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT DTSCS26 -01390 GO TO P6900-EXIT. DTSCS26 -01391 DTSCS26 -01392 IF PAGE-FIRST-88 DTSCS26 -01393 MOVE PMSG-FIRST-PAGE TO LCCM-MSG-AREA DTSCS26 -01394 ELSE DTSCS26 -01395 IF PAGE-LAST-88 DTSCS26 -01396 MOVE PMSG-LAST-PAGE TO LCCM-MSG-AREA. DTSCS26 -01397 P6900-EXIT. DTSCS26 -01398 EXIT. DTSCS26 -01399 DTSCS26 -01400 P6910-FROM-AADJ. DTSCS26 -01401 MOVE AADJ-BATCH-NO TO MAP-BATCH-NO-N. DTSCS26 -01402 DTSCS26 -01403 MOVE AADJ-ITEM-NO TO MAP-ITEM-NO-N. DTSCS26 -01404 DTSCS26 -01405 MOVE AADJ-NAME-CHECK TO MAP-NAME-CHECK. DTSCS26 -01406 DTSCS26 -01407 MOVE AADJ-ADJ-TYPE TO MAP-ADJ-TYPE. DTSCS26 -01408 DTSCS26 -01409 MOVE AADJ-EMP-NO TO LCCM-EMP-NO DTSCS26 -01410 WRK-DISPLAY. DTSCS26 +01348 SET PAGE-FIRST-88 TO TRUE DTSCS26 +01349 MOVE HOLD-KEY-AREA TO ASKL-KEY-AREA DTSCS26 +01350 PERFORM S823-READ THRU S823-EXIT DTSCS26 +01351 IF L823-NO-REC-88 DTSCS26 +01352 GO TO S899-ABEND. DTSCS26 +01353 P6130-EXIT. DTSCS26 +01354 EXIT. DTSCS26 +01355 SKIP3 DTSCS26 +01356 P6140-PAGE-NEXT. DTSCS26 +01357 IF LCCM-ITEM-NO = ASKL-ITEM-NO DTSCS26 +01358 NEXT SENTENCE DTSCS26 +01359 ELSE DTSCS26 +01360 PERFORM S823-END-BROWSE THRU S823-EXIT DTSCS26 +01361 GO TO P6140-EXIT. DTSCS26 +01362 DTSCS26 +01363 MOVE ASKL-KEY-AREA TO HOLD-KEY-AREA. DTSCS26 +01364 DTSCS26 +01365 PERFORM S823-READ-NEXT THRU S823-EXIT. DTSCS26 +01366 DTSCS26 +01367 IF L823-NO-REC-88 DTSCS26 +01368 SET PAGE-LAST-88 TO TRUE DTSCS26 +01369 GO TO P6140-EXIT. DTSCS26 +01370 DTSCS26 +01371 PERFORM S823-END-BROWSE THRU S823-EXIT. DTSCS26 +01372 DTSCS26 +01373 IF (ASKL-ITEM-NO > +0) DTSCS26 +01374 AND DTSCS26 +01375 (ASKL-BATCH-NO = WRK-BATCH-NO) DTSCS26 +01376 NEXT SENTENCE DTSCS26 +01377 ELSE DTSCS26 +01378 SET PAGE-LAST-88 TO TRUE DTSCS26 +01379 MOVE HOLD-KEY-AREA TO ASKL-KEY-AREA DTSCS26 +01380 PERFORM S823-READ THRU S823-EXIT DTSCS26 +01381 IF L823-NO-REC-88 DTSCS26 +01382 GO TO S899-ABEND. DTSCS26 +01383 P6140-EXIT. DTSCS26 +01384 EXIT. DTSCS26 +01385 /*****************************************************************DTSCS26 +01386 * THE RECORD WAS FOUND SO FORMAT AND PLACE ALL FIELDS *DTSCS26 +01387 ******************************************************************DTSCS26 +01388 DTSCS26 +01389 P6900-CONSTRUCT-SCREEN. DTSCS26 +01390 IF ASKL-ADJ-88 DTSCS26 +01391 NEXT SENTENCE DTSCS26 +01392 ELSE DTSCS26 +01393 GO TO S899-ABEND. DTSCS26 +01394 DTSCS26 +01395 MOVE ASKL-REC TO AADJ-REC. DTSCS26 +01396 DTSCS26 +01397 PERFORM P6910-FROM-AADJ THRU P6910-EXIT. CL**9 +01398 DTSCS26 +01399 IF AADJ-PROCESSED-DATE > +0 DTSCS26 +01400 MOVE MSG-P26D-AREA TO LCCM-MSG-AREA DTSCS26 +01401 *********PERFORM S5300-SET-INQ-ATTRB THRU S5300-EXIT DTSCS26 +01402 GO TO P6900-EXIT. DTSCS26 +01403 DTSCS26 +01404 IF PAGE-FIRST-88 DTSCS26 +01405 MOVE PMSG-FIRST-PAGE TO LCCM-MSG-AREA DTSCS26 +01406 ELSE DTSCS26 +01407 IF PAGE-LAST-88 DTSCS26 +01408 MOVE PMSG-LAST-PAGE TO LCCM-MSG-AREA. DTSCS26 +01409 P6900-EXIT. DTSCS26 +01410 EXIT. DTSCS26 01411 DTSCS26 -01412 MOVE WRK-EMP-NO-1 TO MAP-EMP-NO-1. DTSCS26 -01413 DTSCS26 -01414 MOVE WRK-EMP-NO-2 TO MAP-EMP-NO-2. DTSCS26 -01415 DTSCS26 -01416 MOVE AADJ-AMT TO MAP-AMT-N. DTSCS26 -01417 DTSCS26 -01418 IF AADJ-APPLIC-YRQ > 0 DTSCS26 -01419 IF AADJ-APPLIC-YRQ = LCCM-PICKUP-YRQ DTSCS26 -01420 MOVE 'PU' TO MAP-APPLIC-YRQ-YR DTSCS26 -01421 MOVE ' ' TO MAP-APPLIC-YRQ-Q DTSCS26 -01422 ELSE DTSCS26 -01423 MOVE AADJ-APPLIC-YRQ TO WRK-DISPLAY DTSCS26 -01424 MOVE WRK-DISPLAY-YRQ-YR TO MAP-APPLIC-YRQ-YR DTSCS26 -01425 MOVE WRK-DISPLAY-YRQ-Q TO MAP-APPLIC-YRQ-Q. DTSCS26 -01426 DTSCS26 -01427 MOVE AADJ-APPLIC-IND TO MAP-APPLIC-IND. DTSCS26 -01428 DTSCS26 -01429 IF AADJ-APPLIC-DOC-NO = NULL-DOC-NO DTSCS26 -01430 NEXT SENTENCE DTSCS26 -01431 ELSE DTSCS26 -01432 MOVE AADJ-APPLIC-BATCH-NO TO MAP-APPLIC-BATCH-NO-N DTSCS26 -01433 MOVE AADJ-APPLIC-ITEM-NO TO MAP-APPLIC-ITEM-NO-N. DTSCS26 -01434 DTSCS26 -01435 IF AADJ-DATE-1 > +0 DTSCS26 -01436 MOVE AADJ-DATE-1 TO WRK-DISPLAY DTSCS26 -01437 MOVE WRK-DISPLAY-MO TO MAP-DATE-1-MO DTSCS26 -01438 MOVE WRK-DISPLAY-DA TO MAP-DATE-1-DA DTSCS26 -01439 MOVE WRK-DISPLAY-YR TO MAP-DATE-1-YR. DTSCS26 +01412 P6910-FROM-AADJ. DTSCS26 +01413 MOVE AADJ-BATCH-NO TO MAP-BATCH-NO-N. DTSCS26 +01414 DTSCS26 +01415 MOVE AADJ-ITEM-NO TO MAP-ITEM-NO-N. DTSCS26 +01416 DTSCS26 +01417 MOVE AADJ-NAME-CHECK TO MAP-NAME-CHECK. DTSCS26 +01418 DTSCS26 +01419 MOVE AADJ-ADJ-TYPE TO MAP-ADJ-TYPE. DTSCS26 +01420 DTSCS26 +01421 MOVE AADJ-EMP-NO TO LCCM-EMP-NO DTSCS26 +01422 WRK-DISPLAY. DTSCS26 +01423 DTSCS26 +01424 MOVE WRK-EMP-NO-1 TO MAP-EMP-NO-1. DTSCS26 +01425 DTSCS26 +01426 MOVE WRK-EMP-NO-2 TO MAP-EMP-NO-2. DTSCS26 +01427 DTSCS26 +01428 MOVE AADJ-AMT TO MAP-AMT-N. DTSCS26 +01429 DTSCS26 +01430 IF AADJ-APPLIC-YRQ > 0 DTSCS26 +01431 IF AADJ-APPLIC-YRQ = LCCM-PICKUP-YRQ DTSCS26 +01432 MOVE 'PU' TO MAP-APPLIC-YRQ-YR DTSCS26 +01433 MOVE ' ' TO MAP-APPLIC-YRQ-Q DTSCS26 +01434 ELSE DTSCS26 +01435 MOVE AADJ-APPLIC-YRQ TO WRK-DISPLAY DTSCS26 +01436 MOVE WRK-DISPLAY-YRQ-YR TO MAP-APPLIC-YRQ-YR DTSCS26 +01437 MOVE WRK-DISPLAY-YRQ-Q TO MAP-APPLIC-YRQ-Q. DTSCS26 +01438 DTSCS26 +01439 MOVE AADJ-APPLIC-IND TO MAP-APPLIC-IND. DTSCS26 01440 DTSCS26 -01441 IF AADJ-DATE-2 > +0 DTSCS26 -01442 MOVE AADJ-DATE-2 TO WRK-DISPLAY DTSCS26 -01443 MOVE WRK-DISPLAY-MO TO MAP-DATE-2-MO DTSCS26 -01444 MOVE WRK-DISPLAY-DA TO MAP-DATE-2-DA DTSCS26 -01445 MOVE WRK-DISPLAY-YR TO MAP-DATE-2-YR. DTSCS26 +01441 IF AADJ-APPLIC-DOC-NO = NULL-DOC-NO DTSCS26 +01442 NEXT SENTENCE DTSCS26 +01443 ELSE DTSCS26 +01444 MOVE AADJ-APPLIC-BATCH-NO TO MAP-APPLIC-BATCH-NO-N DTSCS26 +01445 MOVE AADJ-APPLIC-ITEM-NO TO MAP-APPLIC-ITEM-NO-N. DTSCS26 01446 DTSCS26 -01447 MOVE AADJ-INT-SPAN-IND TO MAP-INT-SPAN-IND. DTSCS26 -01448 DTSCS26 -01449 IF (AADJ-INT-DATE-88) DTSCS26 -01450 AND DTSCS26 -01451 (AADJ-DATE-1 NOT = ALL-NINES-DATE) DTSCS26 -01452 MOVE AADJ-INT-RATE TO L056-RATE DTSCS26 -01453 PERFORM S056-DISP1-LEFT THRU S056-EXIT DTSCS26 -01454 MOVE L056-DISP-RATE TO MAP-INT-RATE. DTSCS26 -01455 DTSCS26 -01456 IF AADJ-RECEIVED-DATE > +0 DTSCS26 -01457 MOVE AADJ-RECEIVED-DATE TO WRK-DISPLAY DTSCS26 -01458 MOVE WRK-DISPLAY-MO TO MAP-RECEIVED-DATE-MO DTSCS26 -01459 MOVE WRK-DISPLAY-DA TO MAP-RECEIVED-DATE-DA DTSCS26 -01460 MOVE WRK-DISPLAY-YR TO MAP-RECEIVED-DATE-YR. DTSCS26 -01461 DTSCS26 -01462 MOVE AADJ-RESPONSIBLE-ACTIVITY TO MAP-RESPONSIBLE-ACTIVITY. DTSCS26 -01463 DTSCS26 -01464 MOVE AADJ-RESPONSIBLE-OP-ID TO MAP-RESPONSIBLE-OP-ID. DTSCS26 -01465 DTSCS26 -01466 MOVE AADJ-DISREGARD-EDITS-IND TO MAP-DISREGARD-EDITS-IND. DTSCS26 +01447 IF AADJ-DATE-1 > +0 DTSCS26 +01448 MOVE AADJ-DATE-1 TO WRK-DISPLAY DTSCS26 +01449 MOVE WRK-DISPLAY-MO TO MAP-DATE-1-MO DTSCS26 +01450 MOVE WRK-DISPLAY-DA TO MAP-DATE-1-DA DTSCS26 +01451 MOVE WRK-DISPLAY-YR TO MAP-DATE-1-YR. DTSCS26 +01452 DTSCS26 +01453 IF AADJ-DATE-2 > +0 DTSCS26 +01454 MOVE AADJ-DATE-2 TO WRK-DISPLAY DTSCS26 +01455 MOVE WRK-DISPLAY-MO TO MAP-DATE-2-MO DTSCS26 +01456 MOVE WRK-DISPLAY-DA TO MAP-DATE-2-DA DTSCS26 +01457 MOVE WRK-DISPLAY-YR TO MAP-DATE-2-YR. DTSCS26 +01458 DTSCS26 +01459 MOVE AADJ-INT-SPAN-IND TO MAP-INT-SPAN-IND. DTSCS26 +01460 DTSCS26 +01461 IF (AADJ-INT-DATE-88) DTSCS26 +01462 AND DTSCS26 +01463 (AADJ-DATE-1 NOT = ALL-NINES-DATE) DTSCS26 +01464 MOVE AADJ-INT-RATE TO L056-RATE DTSCS26 +01465 PERFORM S056-DISP1-LEFT THRU S056-EXIT DTSCS26 +01466 MOVE L056-DISP-RATE TO MAP-INT-RATE. DTSCS26 01467 DTSCS26 -01468 IF AADJ-PROCESSED-DATE > +0 DTSCS26 -01469 MOVE AADJ-PROCESSED-DATE TO L001-FED-8-DATE-9 DTSCS26 -01470 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSCS26 -01471 MOVE L001-SLASH-DATE TO MAP-PROCESSED-DATE DTSCS26 -01472 END-IF. DTSCS26 +01468 IF AADJ-RECEIVED-DATE > +0 DTSCS26 +01469 MOVE AADJ-RECEIVED-DATE TO WRK-DISPLAY DTSCS26 +01470 MOVE WRK-DISPLAY-MO TO MAP-RECEIVED-DATE-MO DTSCS26 +01471 MOVE WRK-DISPLAY-DA TO MAP-RECEIVED-DATE-DA DTSCS26 +01472 MOVE WRK-DISPLAY-YR TO MAP-RECEIVED-DATE-YR. DTSCS26 01473 DTSCS26 -01474 IF AADJ-CMP-ESTB-ABSTIME > ZERO DTSCS26 -01475 SET MAP-CMPRMISE-YES-88 TO TRUE DTSCS26 -01476 END-IF. DTSCS26 -01477 P6910-EXIT. DTSCS26 -01478 EXIT. DTSCS26 -01479 /*****************************************************************DTSCS26 -01480 * FUNCTION KEY TO ADD, MOD OR DEL THE RECORD WAS PRESSED. *DTSCS26 -01481 ******************************************************************DTSCS26 -01482 DTSCS26 -01483 P7000-REQUEST-EDIT. DTSCS26 -01484 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS26 +01474 MOVE AADJ-RESPONSIBLE-ACTIVITY TO MAP-RESPONSIBLE-ACTIVITY. DTSCS26 +01475 DTSCS26 +01476 MOVE AADJ-RESPONSIBLE-OP-ID TO MAP-RESPONSIBLE-OP-ID. DTSCS26 +01477 DTSCS26 +01478 MOVE AADJ-DISREGARD-EDITS-IND TO MAP-DISREGARD-EDITS-IND. DTSCS26 +01479 DTSCS26 +01480 IF AADJ-PROCESSED-DATE > +0 DTSCS26 +01481 MOVE AADJ-PROCESSED-DATE TO L001-FED-8-DATE-9 DTSCS26 +01482 PERFORM S001-FROM-FED-8 THRU S001-EXIT DTSCS26 +01483 MOVE L001-SLASH-DATE TO MAP-PROCESSED-DATE DTSCS26 +01484 END-IF. DTSCS26 01485 DTSCS26 -01486 *****IF LCCM-ENTER-88 DTSCS26 -01487 ***** PERFORM P7100-EDIT-ADD THRU P7100-EXIT DTSCS26 -01488 *****ELSE DTSCS26 -01489 IF LCCM-F10-88 DTSCS26 -01490 PERFORM P7200-EDIT-MOD THRU P7200-EXIT DTSCS26 -01491 ELSE DTSCS26 -01492 IF LCCM-F23-88 DTSCS26 -01493 PERFORM P7300-EDIT-DEL THRU P7300-EXIT DTSCS26 -01494 ELSE DTSCS26 -01495 GO TO S899-ABEND. DTSCS26 -01496 DTSCS26 +01486 IF AADJ-CMP-ESTB-ABSTIME > ZERO DTSCS26 +01487 SET MAP-CMPRMISE-YES-88 TO TRUE DTSCS26 +01488 END-IF. DTSCS26 +01489 P6910-EXIT. DTSCS26 +01490 EXIT. DTSCS26 +01491 /*****************************************************************DTSCS26 +01492 * FUNCTION KEY TO ADD, MOD OR DEL THE RECORD WAS PRESSED. *DTSCS26 +01493 ******************************************************************DTSCS26 +01494 DTSCS26 +01495 P7000-REQUEST-EDIT. DTSCS26 +01496 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS26 01497 DTSCS26 -01498 *------------------------------------------------------ DTSCS26 -01499 * SCREEN STATUS IS NOT CHANGED IF AN ERROR IS DETECTED. DTSCS26 -01500 * IN ORDER TO CONTINUE TO ATTEMPT A MOD THE SCREEN MUST DTSCS26 -01501 * REMAIN IN 'INQUIRE' STATUS. DTSCS26 -01502 *------------------------------------------------------ DTSCS26 -01503 DTSCS26 -01504 IF LCCM-MSG DTSCS26 -01505 NEXT SENTENCE DTSCS26 -01506 ELSE DTSCS26 -01507 PERFORM S5100-SET-LOCK-ATTRB THRU S5100-EXIT DTSCS26 -01508 ********IF LCCM-ENTER-88 DTSCS26 -01509 ***********SET LCCM-SCR-ADD-LOCKED TO TRUE DTSCS26 -01510 ***********MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-ID DTSCS26 -01511 ********ELSE DTSCS26 -01512 IF LCCM-F10-88 DTSCS26 -01513 SET LCCM-SCR-MOD-LOCKED TO TRUE DTSCS26 -01514 MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID DTSCS26 -01515 ELSE DTSCS26 -01516 IF LCCM-F23-88 DTSCS26 -01517 SET LCCM-SCR-DEL-LOCKED TO TRUE DTSCS26 -01518 MOVE PMSG-DEL-CONFIRM TO LCCM-MSG-ID. DTSCS26 -01519 DTSCS26 -01520 SET RESP-SEND-MAP TO TRUE. DTSCS26 -01521 P7000-EXIT. DTSCS26 -01522 EXIT. DTSCS26 -01523 /*****************************************************************DTSCS26 -01524 * MODIFICATION FUNCTION WAS REQUESTED *DTSCS26 -01525 ******************************************************************DTSCS26 -01526 DTSCS26 -01527 P7200-EDIT-MOD. DTSCS26 -01528 DTSCS26 -01529 *----------------------------------------------------- DTSCS26 -01530 * MODIFICATION REQUIRES THAT A RECORD WAS SUCCESSFULLY DTSCS26 -01531 * INQUIRED DTSCS26 -01532 *----------------------------------------------------- DTSCS26 -01533 DTSCS26 -01534 IF NOT LCCM-SCR-INQUIRE DTSCS26 -01535 MOVE EMSG-MOD-PRECEDED TO LCCM-MSG-ID DTSCS26 -01536 GO TO P7200-EXIT. DTSCS26 -01537 DTSCS26 +01498 *****IF LCCM-ENTER-88 DTSCS26 +01499 ***** PERFORM P7100-EDIT-ADD THRU P7100-EXIT DTSCS26 +01500 *****ELSE DTSCS26 +01501 IF LCCM-F10-88 DTSCS26 +01502 PERFORM P7200-EDIT-MOD THRU P7200-EXIT DTSCS26 +01503 ELSE DTSCS26 +01504 IF LCCM-F23-88 DTSCS26 +01505 PERFORM P7300-EDIT-DEL THRU P7300-EXIT DTSCS26 +01506 ELSE DTSCS26 +01507 GO TO S899-ABEND. DTSCS26 +01508 DTSCS26 +01509 DTSCS26 +01510 *------------------------------------------------------ DTSCS26 +01511 * SCREEN STATUS IS NOT CHANGED IF AN ERROR IS DETECTED. DTSCS26 +01512 * IN ORDER TO CONTINUE TO ATTEMPT A MOD THE SCREEN MUST DTSCS26 +01513 * REMAIN IN 'INQUIRE' STATUS. DTSCS26 +01514 *------------------------------------------------------ DTSCS26 +01515 DTSCS26 +01516 IF LCCM-MSG DTSCS26 +01517 NEXT SENTENCE DTSCS26 +01518 ELSE DTSCS26 +01519 PERFORM S5100-SET-LOCK-ATTRB THRU S5100-EXIT DTSCS26 +01520 ********IF LCCM-ENTER-88 DTSCS26 +01521 ***********SET LCCM-SCR-ADD-LOCKED TO TRUE DTSCS26 +01522 ***********MOVE PMSG-ADD-CONFIRM TO LCCM-MSG-ID DTSCS26 +01523 ********ELSE DTSCS26 +01524 IF LCCM-F10-88 DTSCS26 +01525 SET LCCM-SCR-MOD-LOCKED TO TRUE DTSCS26 +01526 MOVE PMSG-MOD-CONFIRM TO LCCM-MSG-ID DTSCS26 +01527 ELSE DTSCS26 +01528 IF LCCM-F23-88 DTSCS26 +01529 SET LCCM-SCR-DEL-LOCKED TO TRUE DTSCS26 +01530 MOVE PMSG-DEL-CONFIRM TO LCCM-MSG-ID. DTSCS26 +01531 DTSCS26 +01532 SET RESP-SEND-MAP TO TRUE. DTSCS26 +01533 P7000-EXIT. DTSCS26 +01534 EXIT. DTSCS26 +01535 /*****************************************************************DTSCS26 +01536 * MODIFICATION FUNCTION WAS REQUESTED *DTSCS26 +01537 ******************************************************************DTSCS26 01538 DTSCS26 -01539 *----------------------------------------------------- DTSCS26 -01540 * MAP-BATCH-NO MAY NOT BE CHANGED DURING THE MOD DTSCS26 +01539 P7200-EDIT-MOD. DTSCS26 +01540 DTSCS26 01541 *----------------------------------------------------- DTSCS26 -01542 DTSCS26 -01543 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS26 -01544 DTSCS26 -01545 IF LCCM-MSG DTSCS26 -01546 GO TO P7200-EXIT. DTSCS26 -01547 DTSCS26 -01548 DTSCS26 -01549 IF LCCM-BATCH-NO NOT = WRK-BATCH-NO DTSCS26 -01550 MOVE EMSG-NO-BATCH-NO-CHANGE TO WRK-MSG-AREA DTSCS26 -01551 PERFORM S1111-ERROR THRU S1111-EXIT DTSCS26 -01552 GO TO P7200-EXIT. DTSCS26 -01553 DTSCS26 +01542 * MODIFICATION REQUIRES THAT A RECORD WAS SUCCESSFULLY DTSCS26 +01543 * INQUIRED DTSCS26 +01544 *----------------------------------------------------- DTSCS26 +01545 DTSCS26 +01546 IF NOT LCCM-SCR-INQUIRE DTSCS26 +01547 MOVE EMSG-MOD-PRECEDED TO LCCM-MSG-ID DTSCS26 +01548 GO TO P7200-EXIT. DTSCS26 +01549 DTSCS26 +01550 DTSCS26 +01551 *----------------------------------------------------- DTSCS26 +01552 * MAP-BATCH-NO MAY NOT BE CHANGED DURING THE MOD DTSCS26 +01553 *----------------------------------------------------- DTSCS26 01554 DTSCS26 -01555 IF LCCM-ITEM-NO NOT = WRK-ITEM-NO DTSCS26 -01556 MOVE EMSG-NO-ITEM-NO-CHANGE TO WRK-MSG-AREA DTSCS26 -01557 PERFORM S1112-ERROR THRU S1112-EXIT DTSCS26 -01558 GO TO P7200-EXIT. DTSCS26 +01555 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS26 +01556 DTSCS26 +01557 IF LCCM-MSG DTSCS26 +01558 GO TO P7200-EXIT. DTSCS26 01559 DTSCS26 01560 DTSCS26 -01561 PERFORM P7910-EDIT-FOR-PROCESSED THRU P7910-EXIT. DTSCS26 -01562 DTSCS26 -01563 IF LCCM-MSG DTSCS26 -01564 GO TO P7200-EXIT. DTSCS26 +01561 IF LCCM-BATCH-NO NOT = WRK-BATCH-NO DTSCS26 +01562 MOVE EMSG-NO-BATCH-NO-CHANGE TO WRK-MSG-AREA DTSCS26 +01563 PERFORM S1111-ERROR THRU S1111-EXIT DTSCS26 +01564 GO TO P7200-EXIT. DTSCS26 01565 DTSCS26 01566 DTSCS26 -01567 PERFORM S1000-SCREEN-EDITS THRU S1000-EXIT. DTSCS26 -01568 P7200-EXIT. DTSCS26 -01569 EXIT. DTSCS26 -01570 /*****************************************************************DTSCS26 -01571 * DELETE FUNCTION WAS REQUESTED *DTSCS26 -01572 ******************************************************************DTSCS26 -01573 DTSCS26 -01574 P7300-EDIT-DEL. DTSCS26 -01575 DTSCS26 -01576 *----------------------------------------------------- DTSCS26 -01577 * DELETION REQUIRES THAT A RECORD WAS SUCCESSFULLY DTSCS26 -01578 * INQUIRED DTSCS26 -01579 *----------------------------------------------------- DTSCS26 -01580 DTSCS26 -01581 IF NOT LCCM-SCR-INQUIRE DTSCS26 -01582 MOVE EMSG-DEL-PRECEDED TO LCCM-MSG-ID DTSCS26 -01583 GO TO P7300-EXIT. DTSCS26 -01584 DTSCS26 +01567 IF LCCM-ITEM-NO NOT = WRK-ITEM-NO DTSCS26 +01568 MOVE EMSG-NO-ITEM-NO-CHANGE TO WRK-MSG-AREA DTSCS26 +01569 PERFORM S1112-ERROR THRU S1112-EXIT DTSCS26 +01570 GO TO P7200-EXIT. DTSCS26 +01571 DTSCS26 +01572 DTSCS26 +01573 PERFORM P7910-EDIT-FOR-PROCESSED THRU P7910-EXIT. DTSCS26 +01574 DTSCS26 +01575 IF LCCM-MSG DTSCS26 +01576 GO TO P7200-EXIT. DTSCS26 +01577 DTSCS26 +01578 DTSCS26 +01579 PERFORM S1000-SCREEN-EDITS THRU S1000-EXIT. DTSCS26 +01580 P7200-EXIT. DTSCS26 +01581 EXIT. DTSCS26 +01582 /*****************************************************************DTSCS26 +01583 * DELETE FUNCTION WAS REQUESTED *DTSCS26 +01584 ******************************************************************DTSCS26 01585 DTSCS26 -01586 *----------------------------------------------------- DTSCS26 -01587 * MAP-BATCH-NO MAY NOT BE CHANGED DURING THE DEL DTSCS26 +01586 P7300-EDIT-DEL. DTSCS26 +01587 DTSCS26 01588 *----------------------------------------------------- DTSCS26 -01589 DTSCS26 -01590 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS26 -01591 DTSCS26 -01592 IF LCCM-MSG DTSCS26 -01593 GO TO P7300-EXIT. DTSCS26 -01594 DTSCS26 -01595 DTSCS26 -01596 IF LCCM-BATCH-NO NOT = WRK-BATCH-NO DTSCS26 -01597 MOVE EMSG-NO-BATCH-NO-CHANGE TO WRK-MSG-AREA DTSCS26 -01598 PERFORM S1111-ERROR THRU S1111-EXIT DTSCS26 -01599 GO TO P7300-EXIT. DTSCS26 -01600 DTSCS26 +01589 * DELETION REQUIRES THAT A RECORD WAS SUCCESSFULLY DTSCS26 +01590 * INQUIRED DTSCS26 +01591 *----------------------------------------------------- DTSCS26 +01592 DTSCS26 +01593 IF NOT LCCM-SCR-INQUIRE DTSCS26 +01594 MOVE EMSG-DEL-PRECEDED TO LCCM-MSG-ID DTSCS26 +01595 GO TO P7300-EXIT. DTSCS26 +01596 DTSCS26 +01597 DTSCS26 +01598 *----------------------------------------------------- DTSCS26 +01599 * MAP-BATCH-NO MAY NOT BE CHANGED DURING THE DEL DTSCS26 +01600 *----------------------------------------------------- DTSCS26 01601 DTSCS26 -01602 IF LCCM-ITEM-NO NOT = WRK-ITEM-NO DTSCS26 -01603 MOVE EMSG-NO-ITEM-NO-CHANGE TO WRK-MSG-AREA DTSCS26 -01604 PERFORM S1112-ERROR THRU S1112-EXIT DTSCS26 -01605 GO TO P7300-EXIT. DTSCS26 +01602 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS26 +01603 DTSCS26 +01604 IF LCCM-MSG DTSCS26 +01605 GO TO P7300-EXIT. DTSCS26 01606 DTSCS26 01607 DTSCS26 -01608 PERFORM P7910-EDIT-FOR-PROCESSED THRU P7910-EXIT. DTSCS26 -01609 DTSCS26 -01610 IF LCCM-MSG DTSCS26 -01611 GO TO P7300-EXIT. DTSCS26 -01612 P7300-EXIT. DTSCS26 -01613 EXIT. DTSCS26 -01614 EJECT DTSCS26 -01615 P7910-EDIT-FOR-PROCESSED. DTSCS26 -01616 MOVE LOW-VALUES TO ASKL-KEY-AREA. DTSCS26 -01617 DTSCS26 -01618 MOVE WRK-BATCH-NO TO ASKL-BATCH-NO. DTSCS26 +01608 IF LCCM-BATCH-NO NOT = WRK-BATCH-NO DTSCS26 +01609 MOVE EMSG-NO-BATCH-NO-CHANGE TO WRK-MSG-AREA DTSCS26 +01610 PERFORM S1111-ERROR THRU S1111-EXIT DTSCS26 +01611 GO TO P7300-EXIT. DTSCS26 +01612 DTSCS26 +01613 DTSCS26 +01614 IF LCCM-ITEM-NO NOT = WRK-ITEM-NO DTSCS26 +01615 MOVE EMSG-NO-ITEM-NO-CHANGE TO WRK-MSG-AREA DTSCS26 +01616 PERFORM S1112-ERROR THRU S1112-EXIT DTSCS26 +01617 GO TO P7300-EXIT. DTSCS26 +01618 DTSCS26 01619 DTSCS26 -01620 MOVE WRK-ITEM-NO TO ASKL-ITEM-NO. DTSCS26 +01620 PERFORM P7910-EDIT-FOR-PROCESSED THRU P7910-EXIT. DTSCS26 01621 DTSCS26 -01622 PERFORM S823-READ THRU S823-EXIT. DTSCS26 -01623 DTSCS26 -01624 IF L823-NO-REC-88 DTSCS26 -01625 GO TO P7910-EXIT. DTSCS26 -01626 DTSCS26 -01627 DTSCS26 -01628 MOVE ASKL-REC TO AADJ-REC. DTSCS26 +01622 IF LCCM-MSG DTSCS26 +01623 GO TO P7300-EXIT. DTSCS26 +01624 P7300-EXIT. DTSCS26 +01625 EXIT. DTSCS26 +01626 EJECT DTSCS26 +01627 P7910-EDIT-FOR-PROCESSED. DTSCS26 +01628 MOVE LOW-VALUES TO ASKL-KEY-AREA. DTSCS26 01629 DTSCS26 -01630 DTSCS26 -01631 IF AADJ-NOT-PROCESSED-88 DTSCS26 -01632 CONTINUE DTSCS26 -01633 ELSE DTSCS26 -01634 MOVE MSG-E26D-AREA TO WRK-MSG-AREA DTSCS26 -01635 PERFORM S1111-ERROR THRU S1111-EXIT DTSCS26 -01636 PERFORM S1112-ERROR THRU S1112-EXIT DTSCS26 +01630 MOVE WRK-BATCH-NO TO ASKL-BATCH-NO. DTSCS26 +01631 DTSCS26 +01632 MOVE WRK-ITEM-NO TO ASKL-ITEM-NO. DTSCS26 +01633 DTSCS26 +01634 PERFORM S823-READ THRU S823-EXIT. DTSCS26 +01635 DTSCS26 +01636 IF L823-NO-REC-88 DTSCS26 01637 GO TO P7910-EXIT. DTSCS26 -01638 P7910-EXIT. DTSCS26 -01639 EXIT. DTSCS26 -01640 /*****************************************************************DTSCS26 -01641 * THE UPDATE/ADD/DELETE FUNCTION WAS CONFIRMED OR CANCELED *DTSCS26 -01642 ******************************************************************DTSCS26 -01643 DTSCS26 -01644 P8000-REQUEST-UPDATE. DTSCS26 -01645 DTSCS26 -01646 *****IF LCCM-SCR-ADD-LOCKED DTSCS26 -01647 ***** PERFORM P8100-ADD THRU P8100-EXIT DTSCS26 -01648 *****ELSE DTSCS26 -01649 IF LCCM-SCR-MOD-LOCKED DTSCS26 -01650 PERFORM P8200-MOD THRU P8200-EXIT DTSCS26 -01651 ELSE DTSCS26 -01652 IF LCCM-SCR-DEL-LOCKED DTSCS26 -01653 PERFORM P8300-DEL THRU P8300-EXIT DTSCS26 -01654 ELSE DTSCS26 -01655 PERFORM P8100-ADD THRU P8100-EXIT. DTSCS26 -01656 DTSCS26 -01657 SET RESP-SEND-MAP TO TRUE. DTSCS26 -01658 P8000-EXIT. DTSCS26 -01659 EXIT. DTSCS26 -01660 /*****************************************************************DTSCS26 -01661 * *DTSCS26 -01662 ******************************************************************DTSCS26 -01663 DTSCS26 -01664 P8100-ADD. DTSCS26 -01665 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS26 -01666 DTSCS26 -01667 IF NOT LCCM-SCR-CLEAR DTSCS26 -01668 MOVE EMSG-ADD-PRECEDED TO LCCM-MSG-ID DTSCS26 -01669 GO TO P8100-EXIT. DTSCS26 -01670 DTSCS26 -01671 DTSCS26 -01672 PERFORM S1000-SCREEN-EDITS THRU S1000-EXIT. DTSCS26 -01673 DTSCS26 -01674 IF (WRK-BATCH-NO = LCCM-BATCH-NO) DTSCS26 -01675 *************OR DTSCS26 -01676 ********(WRK-BATCH-NO = +0) DTSCS26 -01677 NEXT SENTENCE DTSCS26 -01678 ELSE DTSCS26 -01679 MOVE WRK-BATCH-NO TO LCCM-BATCH-NO DTSCS26 -01680 MOVE +0 TO LCCM-ITEM-NO. DTSCS26 -01681 DTSCS26 -01682 IF LCCM-MSG DTSCS26 -01683 GO TO P8100-EXIT. DTSCS26 -01684 DTSCS26 +01638 DTSCS26 +01639 DTSCS26 +01640 MOVE ASKL-REC TO AADJ-REC. DTSCS26 +01641 DTSCS26 +01642 DTSCS26 +01643 IF AADJ-NOT-PROCESSED-88 DTSCS26 +01644 CONTINUE DTSCS26 +01645 ELSE DTSCS26 +01646 MOVE MSG-E26D-AREA TO WRK-MSG-AREA DTSCS26 +01647 PERFORM S1111-ERROR THRU S1111-EXIT DTSCS26 +01648 PERFORM S1112-ERROR THRU S1112-EXIT DTSCS26 +01649 GO TO P7910-EXIT. DTSCS26 +01650 P7910-EXIT. DTSCS26 +01651 EXIT. DTSCS26 +01652 /*****************************************************************DTSCS26 +01653 * THE UPDATE/ADD/DELETE FUNCTION WAS CONFIRMED OR CANCELED *DTSCS26 +01654 ******************************************************************DTSCS26 +01655 DTSCS26 +01656 P8000-REQUEST-UPDATE. DTSCS26 +01657 DTSCS26 +01658 *****IF LCCM-SCR-ADD-LOCKED DTSCS26 +01659 ***** PERFORM P8100-ADD THRU P8100-EXIT DTSCS26 +01660 *****ELSE DTSCS26 +01661 IF LCCM-SCR-MOD-LOCKED DTSCS26 +01662 PERFORM P8200-MOD THRU P8200-EXIT DTSCS26 +01663 ELSE DTSCS26 +01664 IF LCCM-SCR-DEL-LOCKED DTSCS26 +01665 PERFORM P8300-DEL THRU P8300-EXIT DTSCS26 +01666 ELSE DTSCS26 +01667 PERFORM P8100-ADD THRU P8100-EXIT. DTSCS26 +01668 DTSCS26 +01669 SET RESP-SEND-MAP TO TRUE. DTSCS26 +01670 P8000-EXIT. DTSCS26 +01671 EXIT. DTSCS26 +01672 /*****************************************************************DTSCS26 +01673 * *DTSCS26 +01674 ******************************************************************DTSCS26 +01675 DTSCS26 +01676 P8100-ADD. DTSCS26 +01677 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS26 +01678 DTSCS26 +01679 IF NOT LCCM-SCR-CLEAR DTSCS26 +01680 MOVE EMSG-ADD-PRECEDED TO LCCM-MSG-ID DTSCS26 +01681 GO TO P8100-EXIT. DTSCS26 +01682 DTSCS26 +01683 DTSCS26 +01684 PERFORM S1000-SCREEN-EDITS THRU S1000-EXIT. DTSCS26 01685 DTSCS26 -01686 *--------------------------------------------------- DTSCS26 -01687 * BATCH HEADER RECORD MUST EXIST DTSCS26 -01688 *--------------------------------------------------- DTSCS26 -01689 DTSCS26 -01690 *****IF WRK-BATCH-NO NOT = +0 DTSCS26 -01691 ********MOVE LCCM-TRAN-MAX TO WRK-TRAN-MAX DTSCS26 -01692 ********MOVE +999 TO WRK-ITEM-MAX DTSCS26 +01686 IF (WRK-BATCH-NO = LCCM-BATCH-NO) DTSCS26 +01687 *************OR DTSCS26 +01688 ********(WRK-BATCH-NO = +0) DTSCS26 +01689 NEXT SENTENCE DTSCS26 +01690 ELSE DTSCS26 +01691 MOVE WRK-BATCH-NO TO LCCM-BATCH-NO DTSCS26 +01692 MOVE +0 TO LCCM-ITEM-NO. DTSCS26 01693 DTSCS26 -01694 PERFORM P8910-CHECK-BATCH THRU P8910-EXIT. DTSCS26 -01695 DTSCS26 -01696 IF LCCM-MSG DTSCS26 -01697 GO TO P8100-EXIT. DTSCS26 -01698 DTSCS26 -01699 DTSCS26 -01700 IF WRK-ITEM-NO = +0 DTSCS26 -01701 PERFORM P8102-CHECK-FULL-BATCH THRU P8102-EXIT DTSCS26 -01702 ELSE DTSCS26 -01703 PERFORM P8103-CHECK-DUPLICATE THRU P8103-EXIT. DTSCS26 -01704 DTSCS26 -01705 IF LCCM-MSG DTSCS26 -01706 GO TO P8100-EXIT. DTSCS26 +01694 IF LCCM-MSG DTSCS26 +01695 GO TO P8100-EXIT. DTSCS26 +01696 DTSCS26 +01697 DTSCS26 +01698 *--------------------------------------------------- DTSCS26 +01699 * BATCH HEADER RECORD MUST EXIST DTSCS26 +01700 *--------------------------------------------------- DTSCS26 +01701 DTSCS26 +01702 *****IF WRK-BATCH-NO NOT = +0 DTSCS26 +01703 ********MOVE LCCM-TRAN-MAX TO WRK-TRAN-MAX DTSCS26 +01704 ********MOVE +999 TO WRK-ITEM-MAX DTSCS26 +01705 DTSCS26 +01706 PERFORM P8910-CHECK-BATCH THRU P8910-EXIT. DTSCS26 01707 DTSCS26 -01708 DTSCS26 -01709 *-------------------------------------------------------- DTSCS26 -01710 * FOR ANNUAL QUARTERS, WRITE 4 ADJUSTMENT TRANSACTIONS DTSCS26 -01711 *-------------------------------------------------------- DTSCS26 -01712 IF MPRF-ORG-HSEHLD-DMSTIC-88 DTSCS26 -01713 MOVE WRK-APPLIC-YRQ TO L410-YRQ DTSCS26 -01714 MOVE WRK-EMP-NO TO L410-EMP-NO DTSCS26 -01715 PERFORM S410-FILING-SCHEDULE THRU S410-EXIT DTSCS26 -01716 IF L410-ANN-SCHED-88 DTSCS26 -01717 IF ADJ-FOUR-QTRS-YES-88 DTSCS26 -01718 PERFORM P8130-FOUR-QTRS THRU P8130-EXIT DTSCS26 -01719 ELSE DTSCS26 -01720 PERFORM P8110-ADD-AADJ THRU P8110-EXIT DTSCS26 -01721 ELSE DTSCS26 -01722 PERFORM P8110-ADD-AADJ THRU P8110-EXIT DTSCS26 -01723 ELSE DTSCS26 -01724 PERFORM P8110-ADD-AADJ THRU P8110-EXIT. DTSCS26 -01725 DTSCS26 -01726 MOVE 'A' TO L221-UPDATE-FUNCTION. DTSCS26 -01727 PERFORM S221-WRITE-R906 THRU S221-EXIT. DTSCS26 -01728 DTSCS26 -01729 **** PERFORM P8110-ADD-AADJ THRU P8110-EXIT. DTSCS26 -01730 DTSCS26 -01731 *****IF LCCM-MSG DTSCS26 -01732 *********NEXT SENTENCE DTSCS26 -01733 *****ELSE DTSCS26 -01734 *********MOVE PMSG-ADD-SUCCESSFUL TO LCCM-MSG-ID. DTSCS26 -01735 DTSCS26 -01736 PERFORM P8120-READY-SCREEN THRU P8120-EXIT. DTSCS26 -01737 P8100-EXIT. DTSCS26 -01738 EXIT. DTSCS26 -01739 DTSCS26 +01708 IF LCCM-MSG DTSCS26 +01709 GO TO P8100-EXIT. DTSCS26 +01710 DTSCS26 +01711 DTSCS26 +01712 IF WRK-ITEM-NO = +0 DTSCS26 +01713 PERFORM P8102-CHECK-FULL-BATCH THRU P8102-EXIT DTSCS26 +01714 ELSE DTSCS26 +01715 PERFORM P8103-CHECK-DUPLICATE THRU P8103-EXIT. DTSCS26 +01716 DTSCS26 +01717 IF LCCM-MSG DTSCS26 +01718 GO TO P8100-EXIT. DTSCS26 +01719 DTSCS26 +01720 DTSCS26 +01721 *-------------------------------------------------------- DTSCS26 +01722 * FOR ANNUAL QUARTERS, WRITE 4 ADJUSTMENT TRANSACTIONS DTSCS26 +01723 *-------------------------------------------------------- DTSCS26 +01724 IF MPRF-ORG-HSEHLD-DMSTIC-88 DTSCS26 +01725 MOVE WRK-APPLIC-YRQ TO L410-YRQ DTSCS26 +01726 MOVE WRK-EMP-NO TO L410-EMP-NO DTSCS26 +01727 PERFORM S410-FILING-SCHEDULE THRU S410-EXIT DTSCS26 +01728 IF L410-ANN-SCHED-88 DTSCS26 +01729 IF ADJ-FOUR-QTRS-YES-88 DTSCS26 +01730 PERFORM P8130-FOUR-QTRS THRU P8130-EXIT DTSCS26 +01731 ELSE DTSCS26 +01732 PERFORM P8110-ADD-AADJ THRU P8110-EXIT DTSCS26 +01733 ELSE DTSCS26 +01734 PERFORM P8110-ADD-AADJ THRU P8110-EXIT DTSCS26 +01735 ELSE DTSCS26 +01736 PERFORM P8110-ADD-AADJ THRU P8110-EXIT. DTSCS26 +01737 DTSCS26 +01738 MOVE 'A' TO L221-UPDATE-FUNCTION. DTSCS26 +01739 PERFORM S221-WRITE-R906 THRU S221-EXIT. DTSCS26 01740 DTSCS26 -01741 DTSCS26 -01742 P8102-CHECK-FULL-BATCH. DTSCS26 -01743 IF L372-LAST-USED-ITEM-MAX-88 DTSCS26 -01744 MOVE EMSG-BATCH-FULL TO WRK-MSG-AREA DTSCS26 -01745 PERFORM S1111-ERROR THRU S1111-EXIT. DTSCS26 -01746 P8102-EXIT. DTSCS26 -01747 EXIT. DTSCS26 -01748 DTSCS26 -01749 DTSCS26 -01750 DTSCS26 -01751 P8103-CHECK-DUPLICATE. DTSCS26 -01752 IF WRK-ITEM-NO > L372-LAST-USED-ITEM-NO DTSCS26 -01753 GO TO P8103-EXIT. DTSCS26 -01754 DTSCS26 -01755 DTSCS26 -01756 MOVE LOW-VALUES TO ASKL-KEY-AREA. DTSCS26 -01757 DTSCS26 -01758 MOVE WRK-BATCH-NO TO ASKL-BATCH-NO. DTSCS26 -01759 DTSCS26 -01760 MOVE WRK-ITEM-NO TO ASKL-ITEM-NO. DTSCS26 +01741 **** PERFORM P8110-ADD-AADJ THRU P8110-EXIT. DTSCS26 +01742 DTSCS26 +01743 *****IF LCCM-MSG DTSCS26 +01744 *********NEXT SENTENCE DTSCS26 +01745 *****ELSE DTSCS26 +01746 *********MOVE PMSG-ADD-SUCCESSFUL TO LCCM-MSG-ID. DTSCS26 +01747 DTSCS26 +01748 PERFORM P8120-READY-SCREEN THRU P8120-EXIT. DTSCS26 +01749 P8100-EXIT. DTSCS26 +01750 EXIT. DTSCS26 +01751 DTSCS26 +01752 DTSCS26 +01753 DTSCS26 +01754 P8102-CHECK-FULL-BATCH. DTSCS26 +01755 IF L372-LAST-USED-ITEM-MAX-88 DTSCS26 +01756 MOVE EMSG-BATCH-FULL TO WRK-MSG-AREA DTSCS26 +01757 PERFORM S1111-ERROR THRU S1111-EXIT. DTSCS26 +01758 P8102-EXIT. DTSCS26 +01759 EXIT. DTSCS26 +01760 DTSCS26 01761 DTSCS26 -01762 PERFORM S823-READ THRU S823-EXIT. DTSCS26 -01763 DTSCS26 -01764 IF L823-OK-88 DTSCS26 -01765 MOVE EMSG-RECORD-EXISTS TO WRK-MSG-AREA DTSCS26 -01766 PERFORM S1112-ERROR THRU S1112-EXIT. DTSCS26 -01767 P8103-EXIT. DTSCS26 -01768 EXIT. DTSCS26 +01762 DTSCS26 +01763 P8103-CHECK-DUPLICATE. DTSCS26 +01764 IF WRK-ITEM-NO > L372-LAST-USED-ITEM-NO DTSCS26 +01765 GO TO P8103-EXIT. DTSCS26 +01766 DTSCS26 +01767 DTSCS26 +01768 MOVE LOW-VALUES TO ASKL-KEY-AREA. DTSCS26 01769 DTSCS26 -01770 DTSCS26 +01770 MOVE WRK-BATCH-NO TO ASKL-BATCH-NO. DTSCS26 01771 DTSCS26 -01772 P8110-ADD-AADJ. DTSCS26 -01773 *--------------------------------------------------- DTSCS26 -01774 * BUILD A BATCH HEADER ON THE FLY IF NO BATCH-NO SPECIFIED DTSCS26 -01775 *--------------------------------------------------- DTSCS26 -01776 *****IF WRK-BATCH-NO = +0 DTSCS26 -01777 ********MOVE LCCM-OP-ID TO L373-ENTRY-OP-ID DTSCS26 -01778 ********PERFORM S373-ADD-HDR THRU S373-EXIT DTSCS26 -01779 ********MOVE L373-BATCH-NO TO MAP-BATCH-NO DTSCS26 -01780 ******************************LCCM-BATCH-NO DTSCS26 -01781 ******************************WRK-BATCH-NO. DTSCS26 +01772 MOVE WRK-ITEM-NO TO ASKL-ITEM-NO. DTSCS26 +01773 DTSCS26 +01774 PERFORM S823-READ THRU S823-EXIT. DTSCS26 +01775 DTSCS26 +01776 IF L823-OK-88 DTSCS26 +01777 MOVE EMSG-RECORD-EXISTS TO WRK-MSG-AREA DTSCS26 +01778 PERFORM S1112-ERROR THRU S1112-EXIT. DTSCS26 +01779 P8103-EXIT. DTSCS26 +01780 EXIT. DTSCS26 +01781 DTSCS26 01782 DTSCS26 -01783 MOVE WRK-BATCH-NO TO L372-BATCH-NO. DTSCS26 -01784 DTSCS26 -01785 MOVE +1 TO L372-CHNG-ATC-FILE-TRAN-CNT. DTSCS26 -01786 DTSCS26 -01787 MOVE +0 TO L372-CHNG-ATC-FILE-REMIT-AMT. DTSCS26 -01788 DTSCS26 -01789 IF ADJ-FOUR-QTRS-YES-88 DTSCS26 -01790 MOVE +0 TO L372-CHNG-LAST-USED-ITEM-NO DTSCS26 -01791 WRK-ITEM-NO DTSCS26 -01792 SET L372-CHNG-INCR-LAST-USED-Y-88 TO TRUE DTSCS26 -01793 ELSE DTSCS26 -01794 IF WRK-ITEM-NO > +0 DTSCS26 -01795 MOVE WRK-ITEM-NO TO L372-CHNG-LAST-USED-ITEM-NO DTSCS26 -01796 SET L372-CHNG-INCR-LAST-USED-N-88 TO TRUE DTSCS26 -01797 ELSE DTSCS26 -01798 MOVE +0 TO L372-CHNG-LAST-USED-ITEM-NO DTSCS26 -01799 SET L372-CHNG-INCR-LAST-USED-Y-88 TO TRUE. DTSCS26 +01783 DTSCS26 +01784 P8110-ADD-AADJ. DTSCS26 +01785 *--------------------------------------------------- DTSCS26 +01786 * BUILD A BATCH HEADER ON THE FLY IF NO BATCH-NO SPECIFIED DTSCS26 +01787 *--------------------------------------------------- DTSCS26 +01788 *****IF WRK-BATCH-NO = +0 DTSCS26 +01789 ********MOVE LCCM-OP-ID TO L373-ENTRY-OP-ID DTSCS26 +01790 ********PERFORM S373-ADD-HDR THRU S373-EXIT DTSCS26 +01791 ********MOVE L373-BATCH-NO TO MAP-BATCH-NO DTSCS26 +01792 ******************************LCCM-BATCH-NO DTSCS26 +01793 ******************************WRK-BATCH-NO. DTSCS26 +01794 DTSCS26 +01795 MOVE WRK-BATCH-NO TO L372-BATCH-NO. DTSCS26 +01796 DTSCS26 +01797 MOVE +1 TO L372-CHNG-ATC-FILE-TRAN-CNT. DTSCS26 +01798 DTSCS26 +01799 MOVE +0 TO L372-CHNG-ATC-FILE-REMIT-AMT. DTSCS26 01800 DTSCS26 -01801 PERFORM S372-BATCH-UPDATE THRU S372-EXIT. DTSCS26 -01802 DTSCS26 -01803 IF L372-RESULT-OK DTSCS26 -01804 NEXT SENTENCE DTSCS26 +01801 IF ADJ-FOUR-QTRS-YES-88 DTSCS26 +01802 MOVE +0 TO L372-CHNG-LAST-USED-ITEM-NO DTSCS26 +01803 WRK-ITEM-NO DTSCS26 +01804 SET L372-CHNG-INCR-LAST-USED-Y-88 TO TRUE DTSCS26 01805 ELSE DTSCS26 -01806 GO TO S899-ABEND. DTSCS26 -01807 DTSCS26 -01808 *****MOVE L372-LAST-USED-ITEM-NO TO LCCM-ITEM-NO DTSCS26 -01809 *********************************** WRK-ITEM-NO. DTSCS26 -01810 DTSCS26 -01811 IF WRK-ITEM-NO > +0 DTSCS26 -01812 MOVE WRK-ITEM-NO TO LCCM-ITEM-NO DTSCS26 -01813 ELSE DTSCS26 -01814 MOVE L372-LAST-USED-ITEM-NO TO WRK-ITEM-NO DTSCS26 -01815 LCCM-ITEM-NO. DTSCS26 -01816 DTSCS26 -01817 PERFORM P8920-CONSTRUCT-AADJ THRU P8920-EXIT. DTSCS26 -01818 DTSCS26 -01819 MOVE AADJ-REC TO ASKL-REC. DTSCS26 -01820 DTSCS26 -01821 PERFORM S823-WRITE THRU S823-EXIT. DTSCS26 +01806 IF WRK-ITEM-NO > +0 DTSCS26 +01807 MOVE WRK-ITEM-NO TO L372-CHNG-LAST-USED-ITEM-NO DTSCS26 +01808 SET L372-CHNG-INCR-LAST-USED-N-88 TO TRUE DTSCS26 +01809 ELSE DTSCS26 +01810 MOVE +0 TO L372-CHNG-LAST-USED-ITEM-NO DTSCS26 +01811 SET L372-CHNG-INCR-LAST-USED-Y-88 TO TRUE. DTSCS26 +01812 DTSCS26 +01813 PERFORM S372-BATCH-UPDATE THRU S372-EXIT. DTSCS26 +01814 DTSCS26 +01815 IF L372-RESULT-OK DTSCS26 +01816 NEXT SENTENCE DTSCS26 +01817 ELSE DTSCS26 +01818 GO TO S899-ABEND. DTSCS26 +01819 DTSCS26 +01820 *****MOVE L372-LAST-USED-ITEM-NO TO LCCM-ITEM-NO DTSCS26 +01821 *********************************** WRK-ITEM-NO. DTSCS26 01822 DTSCS26 -01823 SET WRK-AATH-ACTION-ADD-88 TO TRUE. DTSCS26 -01824 PERFORM S826-WRITE-ATH THRU S826-EXIT. DTSCS26 -01825 DTSCS26 -01826 P8110-EXIT. DTSCS26 -01827 EXIT. DTSCS26 +01823 IF WRK-ITEM-NO > +0 DTSCS26 +01824 MOVE WRK-ITEM-NO TO LCCM-ITEM-NO DTSCS26 +01825 ELSE DTSCS26 +01826 MOVE L372-LAST-USED-ITEM-NO TO WRK-ITEM-NO DTSCS26 +01827 LCCM-ITEM-NO. DTSCS26 01828 DTSCS26 -01829 P8120-READY-SCREEN. DTSCS26 -01830 MOVE LOW-VALUES TO MAP-AREA. DTSCS26 -01831 DTSCS26 -01832 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS26 -01833 DTSCS26 -01834 MOVE LCCM-BATCH-NO TO MAP-BATCH-NO-N. DTSCS26 -01835 DTSCS26 -01836 MOVE LCCM-ENTRY-MODE TO MAP-ENTRY-MODE. DTSCS26 +01829 PERFORM P8920-CONSTRUCT-AADJ THRU P8920-EXIT. DTSCS26 +01830 DTSCS26 +01831 MOVE AADJ-REC TO ASKL-REC. DTSCS26 +01832 DTSCS26 +01833 PERFORM S823-WRITE THRU S823-EXIT. DTSCS26 +01834 DTSCS26 +01835 SET WRK-AATH-ACTION-ADD-88 TO TRUE. DTSCS26 +01836 PERFORM S826-WRITE-ATH THRU S826-EXIT. DTSCS26 01837 DTSCS26 -01838 IF MAP-ENTRY-MODE-1 DTSCS26 -01839 IF CURSOR-SET-NO DTSCS26 -01840 MOVE CATB-CURSOR TO MAP-ADJ-TYPE-L DTSCS26 -01841 SET CURSOR-SET-YES TO TRUE DTSCS26 -01842 END-IF DTSCS26 -01843 ELSE DTSCS26 -01844 IF MAP-ENTRY-MODE-2 OR MAP-ENTRY-MODE-3 DTSCS26 -01845 MOVE AADJ-NAME-CHECK TO MAP-NAME-CHECK DTSCS26 -01846 MOVE AADJ-EMP-NO TO LCCM-EMP-NO DTSCS26 -01847 WRK-DISPLAY DTSCS26 -01848 MOVE WRK-EMP-NO-1 TO MAP-EMP-NO-1 DTSCS26 -01849 MOVE WRK-EMP-NO-2 TO MAP-EMP-NO-2 DTSCS26 -01850 MOVE AADJ-ADJ-TYPE TO MAP-ADJ-TYPE DTSCS26 -01851 MOVE AADJ-RESPONSIBLE-ACTIVITY DTSCS26 -01852 TO MAP-RESPONSIBLE-ACTIVITY DTSCS26 -01853 MOVE AADJ-RESPONSIBLE-OP-ID DTSCS26 -01854 TO MAP-RESPONSIBLE-OP-ID DTSCS26 -01855 IF AADJ-RECEIVED-DATE > +0 DTSCS26 -01856 MOVE AADJ-RECEIVED-DATE TO WRK-DISPLAY DTSCS26 -01857 MOVE WRK-DISPLAY-MO TO MAP-RECEIVED-DATE-MO DTSCS26 -01858 MOVE WRK-DISPLAY-DA TO MAP-RECEIVED-DATE-DA DTSCS26 -01859 MOVE WRK-DISPLAY-YR TO MAP-RECEIVED-DATE-YR DTSCS26 -01860 END-IF DTSCS26 -01861 IF AADJ-CMP-ESTB-ABSTIME > ZERO DTSCS26 -01862 SET MAP-CMPRMISE-YES-88 TO TRUE DTSCS26 -01863 END-IF DTSCS26 -01864 IF CURSOR-SET-NO DTSCS26 -01865 MOVE CATB-CURSOR TO MAP-AMT-L DTSCS26 -01866 SET CURSOR-SET-YES TO TRUE DTSCS26 -01867 END-IF DTSCS26 -01868 END-IF. DTSCS26 -01869 P8120-EXIT. DTSCS26 -01870 EXIT. DTSCS26 -01871 DTSCS26 -01872 P8130-FOUR-QTRS. DTSCS26 -01873 PERFORM DTSCS26 -01874 VARYING QTR-SUB FROM +1 BY +1 DTSCS26 -01875 UNTIL QTR-SUB > +4 DTSCS26 -01876 MOVE WRK-MQTR-YRQ (QTR-SUB) TO WRK-APPLIC-YRQ DTSCS26 -01877 IF WRK-MQTR-BYPASS-NO-88 (QTR-SUB) DTSCS26 -01878 PERFORM P8110-ADD-AADJ THRU P8110-EXIT DTSCS26 -01879 END-IF DTSCS26 -01880 END-PERFORM. DTSCS26 -01881 DTSCS26 -01882 P8130-EXIT. DTSCS26 -01883 EXIT. DTSCS26 -01884 DTSCS26 -01885 *P8130-FOUR-QTRS. DTSCS26 -01886 * PERFORM DTSCS26 -01887 * VARYING QTR-SUB FROM +1 BY +1 DTSCS26 -01888 * UNTIL QTR-SUB > +4 DTSCS26 -01889 * MOVE WRK-MQTR-YRQ (QTR-SUB) TO WRK-APPLIC-YRQ DTSCS26 -01890 * IF AADJ-AUTO-88 OR AADJ-MANUAL-88 DTSCS26 -01891 * OR AADJ-DUE-DATE-88 OR AADJ-WAIVE-DATE-88 DTSCS26 -01892 * OR AADJ-INT-DATE-88 DTSCS26 -01893 * IF WRK-MQTR-BYPASS-NO-88 (QTR-SUB) DTSCS26 -01894 * PERFORM P8110-ADD-AADJ THRU P8110-EXIT DTSCS26 -01895 * END-IF DTSCS26 -01896 * ELSE DTSCS26 -01897 * MOVE WRK-MQTR-ADJ-AMT (QTR-SUB) TO WRK-AMT DTSCS26 -01898 * IF WRK-AMT NOT = ZERO DTSCS26 -01899 * PERFORM P8110-ADD-AADJ THRU P8110-EXIT DTSCS26 -01900 * END-IF DTSCS26 -01901 * END-IF DTSCS26 -01902 * END-PERFORM. DTSCS26 -01903 * DTSCS26 -01904 *P8130-EXIT. DTSCS26 -01905 * EXIT. DTSCS26 -01906 /*****************************************************************DTSCS26 -01907 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS *DTSCS26 -01908 ******************************************************************DTSCS26 -01909 DTSCS26 -01910 P8200-MOD. DTSCS26 -01911 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS26 -01912 DTSCS26 -01913 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS26 -01914 DTSCS26 -01915 IF LCCM-F12-88 DTSCS26 -01916 MOVE PMSG-MOD-CANCELED TO LCCM-MSG-ID DTSCS26 -01917 GO TO P8200-EXIT. DTSCS26 -01918 DTSCS26 -01919 DTSCS26 -01920 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS26 +01838 P8110-EXIT. DTSCS26 +01839 EXIT. DTSCS26 +01840 DTSCS26 +01841 P8120-READY-SCREEN. DTSCS26 +01842 MOVE LOW-VALUES TO MAP-AREA. DTSCS26 +01843 DTSCS26 +01844 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS26 +01845 DTSCS26 +01846 MOVE LCCM-BATCH-NO TO MAP-BATCH-NO-N. DTSCS26 +01847 DTSCS26 +01848 MOVE LCCM-ENTRY-MODE TO MAP-ENTRY-MODE. DTSCS26 +01849 DTSCS26 +01850 IF MAP-ENTRY-MODE-1 DTSCS26 +01851 IF CURSOR-SET-NO DTSCS26 +01852 MOVE CATB-CURSOR TO MAP-ADJ-TYPE-L DTSCS26 +01853 SET CURSOR-SET-YES TO TRUE DTSCS26 +01854 END-IF DTSCS26 +01855 ELSE DTSCS26 +01856 IF MAP-ENTRY-MODE-2 OR MAP-ENTRY-MODE-3 DTSCS26 +01857 MOVE AADJ-NAME-CHECK TO MAP-NAME-CHECK DTSCS26 +01858 MOVE AADJ-EMP-NO TO LCCM-EMP-NO DTSCS26 +01859 WRK-DISPLAY DTSCS26 +01860 MOVE WRK-EMP-NO-1 TO MAP-EMP-NO-1 DTSCS26 +01861 MOVE WRK-EMP-NO-2 TO MAP-EMP-NO-2 DTSCS26 +01862 MOVE AADJ-ADJ-TYPE TO MAP-ADJ-TYPE DTSCS26 +01863 MOVE AADJ-RESPONSIBLE-ACTIVITY DTSCS26 +01864 TO MAP-RESPONSIBLE-ACTIVITY DTSCS26 +01865 MOVE AADJ-RESPONSIBLE-OP-ID DTSCS26 +01866 TO MAP-RESPONSIBLE-OP-ID DTSCS26 +01867 IF AADJ-RECEIVED-DATE > +0 DTSCS26 +01868 MOVE AADJ-RECEIVED-DATE TO WRK-DISPLAY DTSCS26 +01869 MOVE WRK-DISPLAY-MO TO MAP-RECEIVED-DATE-MO DTSCS26 +01870 MOVE WRK-DISPLAY-DA TO MAP-RECEIVED-DATE-DA DTSCS26 +01871 MOVE WRK-DISPLAY-YR TO MAP-RECEIVED-DATE-YR DTSCS26 +01872 END-IF DTSCS26 +01873 IF AADJ-CMP-ESTB-ABSTIME > ZERO DTSCS26 +01874 SET MAP-CMPRMISE-YES-88 TO TRUE DTSCS26 +01875 END-IF DTSCS26 +01876 IF CURSOR-SET-NO DTSCS26 +01877 MOVE CATB-CURSOR TO MAP-AMT-L DTSCS26 +01878 SET CURSOR-SET-YES TO TRUE DTSCS26 +01879 END-IF DTSCS26 +01880 END-IF. DTSCS26 +01881 P8120-EXIT. DTSCS26 +01882 EXIT. DTSCS26 +01883 DTSCS26 +01884 P8130-FOUR-QTRS. DTSCS26 +01885 PERFORM DTSCS26 +01886 VARYING QTR-SUB FROM +1 BY +1 DTSCS26 +01887 UNTIL QTR-SUB > +4 DTSCS26 +01888 MOVE WRK-MQTR-YRQ (QTR-SUB) TO WRK-APPLIC-YRQ DTSCS26 +01889 IF WRK-MQTR-BYPASS-NO-88 (QTR-SUB) DTSCS26 +01890 PERFORM P8110-ADD-AADJ THRU P8110-EXIT DTSCS26 +01891 END-IF DTSCS26 +01892 END-PERFORM. DTSCS26 +01893 DTSCS26 +01894 P8130-EXIT. DTSCS26 +01895 EXIT. DTSCS26 +01896 DTSCS26 +01897 *P8130-FOUR-QTRS. DTSCS26 +01898 * PERFORM DTSCS26 +01899 * VARYING QTR-SUB FROM +1 BY +1 DTSCS26 +01900 * UNTIL QTR-SUB > +4 DTSCS26 +01901 * MOVE WRK-MQTR-YRQ (QTR-SUB) TO WRK-APPLIC-YRQ DTSCS26 +01902 * IF AADJ-AUTO-88 OR AADJ-MANUAL-88 DTSCS26 +01903 * OR AADJ-DUE-DATE-88 OR AADJ-WAIVE-DATE-88 DTSCS26 +01904 * OR AADJ-INT-DATE-88 DTSCS26 +01905 * IF WRK-MQTR-BYPASS-NO-88 (QTR-SUB) DTSCS26 +01906 * PERFORM P8110-ADD-AADJ THRU P8110-EXIT DTSCS26 +01907 * END-IF DTSCS26 +01908 * ELSE DTSCS26 +01909 * MOVE WRK-MQTR-ADJ-AMT (QTR-SUB) TO WRK-AMT DTSCS26 +01910 * IF WRK-AMT NOT = ZERO DTSCS26 +01911 * PERFORM P8110-ADD-AADJ THRU P8110-EXIT DTSCS26 +01912 * END-IF DTSCS26 +01913 * END-IF DTSCS26 +01914 * END-PERFORM. DTSCS26 +01915 * DTSCS26 +01916 *P8130-EXIT. DTSCS26 +01917 * EXIT. DTSCS26 +01918 /*****************************************************************DTSCS26 +01919 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS *DTSCS26 +01920 ******************************************************************DTSCS26 01921 DTSCS26 -01922 IF LCCM-MSG DTSCS26 -01923 GO TO P8200-EXIT. DTSCS26 +01922 P8200-MOD. DTSCS26 +01923 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS26 01924 DTSCS26 -01925 DTSCS26 -01926 *--------------------------------------------------- DTSCS26 -01927 * BATCH HEADER RECORD MUST EXIST. DTSCS26 -01928 *--------------------------------------------------- DTSCS26 -01929 *****IF WRK-BATCH-NO > +0 DTSCS26 -01930 ********MOVE +1000 TO WRK-TRAN-MAX DTSCS26 -01931 **********************WRK-ITEM-MAX DTSCS26 -01932 DTSCS26 -01933 PERFORM P8910-CHECK-BATCH THRU P8910-EXIT. DTSCS26 -01934 DTSCS26 -01935 IF LCCM-MSG DTSCS26 -01936 GO TO P8200-EXIT. DTSCS26 +01925 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS26 +01926 DTSCS26 +01927 IF LCCM-F12-88 DTSCS26 +01928 MOVE PMSG-MOD-CANCELED TO LCCM-MSG-ID DTSCS26 +01929 GO TO P8200-EXIT. DTSCS26 +01930 DTSCS26 +01931 DTSCS26 +01932 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS26 +01933 DTSCS26 +01934 IF LCCM-MSG DTSCS26 +01935 GO TO P8200-EXIT. DTSCS26 +01936 DTSCS26 01937 DTSCS26 -01938 PERFORM P8210-CONSTRUCT-AADJ THRU P8210-EXIT. DTSCS26 -01939 DTSCS26 -01940 MOVE 'M' TO L221-UPDATE-FUNCTION. DTSCS26 -01941 PERFORM S221-WRITE-R906 THRU S221-EXIT. DTSCS26 -01942 DTSCS26 -01943 MOVE PMSG-MOD-SUCCESSFUL TO LCCM-MSG-ID. DTSCS26 -01944 P8200-EXIT. DTSCS26 -01945 EXIT. DTSCS26 -01946 EJECT DTSCS26 -01947 P8210-CONSTRUCT-AADJ. DTSCS26 -01948 MOVE WRK-BATCH-NO TO AADJ-BATCH-NO. DTSCS26 +01938 *--------------------------------------------------- DTSCS26 +01939 * BATCH HEADER RECORD MUST EXIST. DTSCS26 +01940 *--------------------------------------------------- DTSCS26 +01941 *****IF WRK-BATCH-NO > +0 DTSCS26 +01942 ********MOVE +1000 TO WRK-TRAN-MAX DTSCS26 +01943 **********************WRK-ITEM-MAX DTSCS26 +01944 DTSCS26 +01945 PERFORM P8910-CHECK-BATCH THRU P8910-EXIT. DTSCS26 +01946 DTSCS26 +01947 IF LCCM-MSG DTSCS26 +01948 GO TO P8200-EXIT. DTSCS26 01949 DTSCS26 -01950 MOVE WRK-ITEM-NO TO AADJ-ITEM-NO. DTSCS26 +01950 PERFORM P8210-CONSTRUCT-AADJ THRU P8210-EXIT. DTSCS26 01951 DTSCS26 -01952 MOVE AADJ-KEY-AREA TO ASKL-REC. DTSCS26 -01953 DTSCS26 -01954 PERFORM S823-READ THRU S823-EXIT. DTSCS26 -01955 DTSCS26 -01956 IF L823-NO-REC-88 DTSCS26 -01957 MOVE EMSG-NO-DOC TO WRK-MSG-AREA DTSCS26 -01958 PERFORM S1112-ERROR THRU S1112-EXIT DTSCS26 -01959 GO TO P8210-EXIT. DTSCS26 -01960 DTSCS26 +01952 MOVE 'M' TO L221-UPDATE-FUNCTION. DTSCS26 +01953 PERFORM S221-WRITE-R906 THRU S221-EXIT. DTSCS26 +01954 DTSCS26 +01955 MOVE PMSG-MOD-SUCCESSFUL TO LCCM-MSG-ID. DTSCS26 +01956 P8200-EXIT. DTSCS26 +01957 EXIT. DTSCS26 +01958 EJECT DTSCS26 +01959 P8210-CONSTRUCT-AADJ. DTSCS26 +01960 MOVE WRK-BATCH-NO TO AADJ-BATCH-NO. DTSCS26 01961 DTSCS26 -01962 MOVE ASKL-REC TO AADJ-REC. DTSCS26 +01962 MOVE WRK-ITEM-NO TO AADJ-ITEM-NO. DTSCS26 01963 DTSCS26 -01964 DTSCS26 -01965 MOVE MAP-AMT-AREA TO L011-S-AMT-AREA. DTSCS26 -01966 DTSCS26 -01967 PERFORM S011-AMT-FROM-SCREEN THRU S011-EXIT. DTSCS26 -01968 DTSCS26 -01969 DTSCS26 -01970 *****MOVE LCCM-BATCH-NO TO L372-BATCH-NO. DTSCS26 -01971 DTSCS26 -01972 *****COMPUTE L372-CHNG-KEYED-REMIT-AMT = L011-AMT DTSCS26 -01973 ***************************************- AADJ-AMT. DTSCS26 -01974 DTSCS26 -01975 *****MOVE +0 TO L372-CHNG-KEYED-ITEM-CNT DTSCS26 -01976 *************** L372-CHNG-KEYED-TRAN-CNT. DTSCS26 -01977 DTSCS26 -01978 *****IF*MAP-CHECK-YES-88 DTSCS26 -01979 ******** MOVE +1 TO L372-CHNG-KEYED-CHECK-CNT DTSCS26 -01980 ******** MOVE L011-AMT TO L372-CHNG-KEYED-CHECK-AMT DTSCS26 -01981 *****ELSE DTSCS26 -01982 ******** MOVE +0 TO L372-CHNG-KEYED-CHECK-CNT DTSCS26 -01983 ******** L372-CHNG-KEYED-CHECK-AMT. DTSCS26 -01984 DTSCS26 -01985 *****IF*AADJ-REMIT-AND-CHECK-88 DTSCS26 -01986 ******** SUBTRACT 1 FROM L372-CHNG-KEYED-CHECK-CNT DTSCS26 -01987 ******** SUBTRACT AADJ-AMT FROM L372-CHNG-KEYED-CHECK-AMT. DTSCS26 -01988 DTSCS26 -01989 *****PERFORM S372-BATCH-UPDATE THRU S372-EXIT. DTSCS26 -01990 *****IF*L372-REC-NOT-FOUND DTSCS26 -01991 ******** GO TO S899-ABEND. DTSCS26 -01992 DTSCS26 -01993 PERFORM P8220-CONSTRUCT-WRK-AREA THRU P8220-EXIT. DTSCS26 -01994 DTSCS26 -01995 PERFORM P8920-CONSTRUCT-AADJ THRU P8920-EXIT. DTSCS26 +01964 MOVE AADJ-KEY-AREA TO ASKL-REC. DTSCS26 +01965 DTSCS26 +01966 PERFORM S823-READ THRU S823-EXIT. DTSCS26 +01967 DTSCS26 +01968 IF L823-NO-REC-88 DTSCS26 +01969 MOVE EMSG-NO-DOC TO WRK-MSG-AREA DTSCS26 +01970 PERFORM S1112-ERROR THRU S1112-EXIT DTSCS26 +01971 GO TO P8210-EXIT. DTSCS26 +01972 DTSCS26 +01973 DTSCS26 +01974 MOVE ASKL-REC TO AADJ-REC. DTSCS26 +01975 DTSCS26 +01976 DTSCS26 +01977 MOVE MAP-AMT-AREA TO L011-S-AMT-AREA. DTSCS26 +01978 DTSCS26 +01979 PERFORM S011-AMT-FROM-SCREEN THRU S011-EXIT. DTSCS26 +01980 DTSCS26 +01981 DTSCS26 +01982 *****MOVE LCCM-BATCH-NO TO L372-BATCH-NO. DTSCS26 +01983 DTSCS26 +01984 *****COMPUTE L372-CHNG-KEYED-REMIT-AMT = L011-AMT DTSCS26 +01985 ***************************************- AADJ-AMT. DTSCS26 +01986 DTSCS26 +01987 *****MOVE +0 TO L372-CHNG-KEYED-ITEM-CNT DTSCS26 +01988 *************** L372-CHNG-KEYED-TRAN-CNT. DTSCS26 +01989 DTSCS26 +01990 *****IF*MAP-CHECK-YES-88 DTSCS26 +01991 ******** MOVE +1 TO L372-CHNG-KEYED-CHECK-CNT DTSCS26 +01992 ******** MOVE L011-AMT TO L372-CHNG-KEYED-CHECK-AMT DTSCS26 +01993 *****ELSE DTSCS26 +01994 ******** MOVE +0 TO L372-CHNG-KEYED-CHECK-CNT DTSCS26 +01995 ******** L372-CHNG-KEYED-CHECK-AMT. DTSCS26 01996 DTSCS26 -01997 MOVE AADJ-REC TO ASKL-REC. DTSCS26 -01998 DTSCS26 -01999 PERFORM S823-REWRITE THRU S823-EXIT. DTSCS26 +01997 *****IF*AADJ-REMIT-AND-CHECK-88 DTSCS26 +01998 ******** SUBTRACT 1 FROM L372-CHNG-KEYED-CHECK-CNT DTSCS26 +01999 ******** SUBTRACT AADJ-AMT FROM L372-CHNG-KEYED-CHECK-AMT. DTSCS26 02000 DTSCS26 -02001 SET WRK-AATH-ACTION-UPD-88 TO TRUE. DTSCS26 -02002 PERFORM S826-WRITE-ATH THRU S826-EXIT. DTSCS26 -02003 DTSCS26 -02004 P8210-EXIT. DTSCS26 -02005 EXIT. DTSCS26 +02001 *****PERFORM S372-BATCH-UPDATE THRU S372-EXIT. DTSCS26 +02002 *****IF*L372-REC-NOT-FOUND DTSCS26 +02003 ******** GO TO S899-ABEND. DTSCS26 +02004 DTSCS26 +02005 PERFORM P8220-CONSTRUCT-WRK-AREA THRU P8220-EXIT. DTSCS26 02006 DTSCS26 -02007 DTSCS26 +02007 PERFORM P8920-CONSTRUCT-AADJ THRU P8920-EXIT. DTSCS26 02008 DTSCS26 -02009 P8220-CONSTRUCT-WRK-AREA. DTSCS26 -02010 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS26 -02011 DTSCS26 -02012 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS26 -02013 DTSCS26 -02014 MOVE L018-EMP-NO TO WRK-EMP-NO. DTSCS26 +02009 MOVE AADJ-REC TO ASKL-REC. DTSCS26 +02010 DTSCS26 +02011 PERFORM S823-REWRITE THRU S823-EXIT. DTSCS26 +02012 DTSCS26 +02013 SET WRK-AATH-ACTION-UPD-88 TO TRUE. DTSCS26 +02014 PERFORM S826-WRITE-ATH THRU S826-EXIT. DTSCS26 02015 DTSCS26 -02016 DTSCS26 -02017 MOVE MAP-AMT-AREA TO L011-S-AMT-AREA. DTSCS26 +02016 P8210-EXIT. DTSCS26 +02017 EXIT. DTSCS26 02018 DTSCS26 -02019 PERFORM S011-AMT-FROM-SCREEN THRU S011-EXIT. DTSCS26 +02019 DTSCS26 02020 DTSCS26 -02021 MOVE L011-AMT TO WRK-AMT. DTSCS26 -02022 DTSCS26 +02021 P8220-CONSTRUCT-WRK-AREA. DTSCS26 +02022 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS26 02023 DTSCS26 -02024 MOVE MAP-APPLIC-YRQ-AREA TO L029-S-YRQ-AREA. DTSCS26 +02024 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS26 02025 DTSCS26 -02026 PERFORM S029-YRQ-FROM-SCREEN THRU S029-EXIT. DTSCS26 +02026 MOVE L018-EMP-NO TO WRK-EMP-NO. DTSCS26 02027 DTSCS26 -02028 MOVE L029-YRQ TO WRK-APPLIC-YRQ. DTSCS26 -02029 DTSCS26 +02028 DTSCS26 +02029 MOVE MAP-AMT-AREA TO L011-S-AMT-AREA. DTSCS26 02030 DTSCS26 -02031 MOVE MAP-APPLIC-IND TO WRK-APPLIC-IND. DTSCS26 +02031 PERFORM S011-AMT-FROM-SCREEN THRU S011-EXIT. DTSCS26 02032 DTSCS26 -02033 DTSCS26 -02034 MOVE MAP-APPLIC-DOC-NO-AREA TO L019-S-DOC-NO. DTSCS26 +02033 MOVE L011-AMT TO WRK-AMT. DTSCS26 +02034 DTSCS26 02035 DTSCS26 -02036 PERFORM S019-BATCH-NO-FROM-SCREEN THRU S019-EXIT. DTSCS26 +02036 MOVE MAP-APPLIC-YRQ-AREA TO L029-S-YRQ-AREA. DTSCS26 02037 DTSCS26 -02038 MOVE L019-DOC-NO TO WRK-APPLIC-DOC-NO. DTSCS26 +02038 PERFORM S029-YRQ-FROM-SCREEN THRU S029-EXIT. DTSCS26 02039 DTSCS26 -02040 DTSCS26 -02041 MOVE MAP-DATE-1-AREA TO L015-S-DATE-AREA. DTSCS26 +02040 MOVE L029-YRQ TO WRK-APPLIC-YRQ. DTSCS26 +02041 DTSCS26 02042 DTSCS26 -02043 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS26 +02043 MOVE MAP-APPLIC-IND TO WRK-APPLIC-IND. DTSCS26 02044 DTSCS26 -02045 IF (MAP-DATE-1-MO = '99') DTSCS26 -02046 AND DTSCS26 -02047 (MAP-DATE-1-DA = '99') DTSCS26 -02048 AND DTSCS26 -02049 (MAP-DATE-1-YR = '99') DTSCS26 -02050 MOVE ALL-NINES-DATE TO WRK-DATE-1 DTSCS26 -02051 ELSE DTSCS26 -02052 MOVE L015-DATE TO WRK-DATE-1. DTSCS26 -02053 DTSCS26 +02045 DTSCS26 +02046 MOVE MAP-APPLIC-DOC-NO-AREA TO L019-S-DOC-NO. DTSCS26 +02047 DTSCS26 +02048 PERFORM S019-BATCH-NO-FROM-SCREEN THRU S019-EXIT. DTSCS26 +02049 DTSCS26 +02050 MOVE L019-DOC-NO TO WRK-APPLIC-DOC-NO. DTSCS26 +02051 DTSCS26 +02052 DTSCS26 +02053 MOVE MAP-DATE-1-AREA TO L015-S-DATE-AREA. DTSCS26 02054 DTSCS26 -02055 MOVE MAP-DATE-2-AREA TO L015-S-DATE-AREA. DTSCS26 +02055 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS26 02056 DTSCS26 -02057 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS26 -02058 DTSCS26 -02059 IF (MAP-DATE-2-MO = '99') DTSCS26 +02057 IF (MAP-DATE-1-MO = '99') DTSCS26 +02058 AND DTSCS26 +02059 (MAP-DATE-1-DA = '99') DTSCS26 02060 AND DTSCS26 -02061 (MAP-DATE-2-DA = '99') DTSCS26 -02062 AND DTSCS26 -02063 (MAP-DATE-2-YR = '99') DTSCS26 -02064 MOVE ALL-NINES-DATE TO WRK-DATE-2 DTSCS26 -02065 ELSE DTSCS26 -02066 MOVE L015-DATE TO WRK-DATE-2. DTSCS26 -02067 DTSCS26 +02061 (MAP-DATE-1-YR = '99') DTSCS26 +02062 MOVE ALL-NINES-DATE TO WRK-DATE-1 DTSCS26 +02063 ELSE DTSCS26 +02064 MOVE L015-DATE TO WRK-DATE-1. DTSCS26 +02065 DTSCS26 +02066 DTSCS26 +02067 MOVE MAP-DATE-2-AREA TO L015-S-DATE-AREA. DTSCS26 02068 DTSCS26 -02069 MOVE MAP-INT-RATE-AREA TO L012-S-RATE-AREA. DTSCS26 +02069 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS26 02070 DTSCS26 -02071 PERFORM S012-RATE-FROM-SCREEN THRU S012-EXIT. DTSCS26 -02072 DTSCS26 -02073 IF L012-NO-ENTRY DTSCS26 -02074 SET WRK-INT-NO-ENTRY-88 TO TRUE DTSCS26 -02075 ELSE DTSCS26 -02076 MOVE L012-RATE TO WRK-INT-RATE. DTSCS26 -02077 DTSCS26 -02078 DTSCS26 -02079 MOVE MAP-RECEIVED-DATE-AREA TO L015-S-DATE-AREA. DTSCS26 +02071 IF (MAP-DATE-2-MO = '99') DTSCS26 +02072 AND DTSCS26 +02073 (MAP-DATE-2-DA = '99') DTSCS26 +02074 AND DTSCS26 +02075 (MAP-DATE-2-YR = '99') DTSCS26 +02076 MOVE ALL-NINES-DATE TO WRK-DATE-2 DTSCS26 +02077 ELSE DTSCS26 +02078 MOVE L015-DATE TO WRK-DATE-2. DTSCS26 +02079 DTSCS26 02080 DTSCS26 -02081 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS26 +02081 MOVE MAP-INT-RATE-AREA TO L012-S-RATE-AREA. DTSCS26 02082 DTSCS26 -02083 MOVE L015-DATE TO WRK-RECEIVED-DATE. DTSCS26 -02084 P8220-EXIT. DTSCS26 -02085 EXIT. DTSCS26 -02086 DTSCS26 -02087 /*****************************************************************DTSCS26 -02088 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS *DTSCS26 -02089 ******************************************************************DTSCS26 +02083 PERFORM S012-RATE-FROM-SCREEN THRU S012-EXIT. DTSCS26 +02084 DTSCS26 +02085 IF L012-NO-ENTRY DTSCS26 +02086 SET WRK-INT-NO-ENTRY-88 TO TRUE DTSCS26 +02087 ELSE DTSCS26 +02088 MOVE L012-RATE TO WRK-INT-RATE. DTSCS26 +02089 DTSCS26 02090 DTSCS26 -02091 P8300-DEL. DTSCS26 -02092 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS26 -02093 DTSCS26 -02094 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS26 -02095 DTSCS26 -02096 IF LCCM-F12-88 DTSCS26 -02097 MOVE PMSG-DEL-CANCELED TO LCCM-MSG-ID DTSCS26 -02098 GO TO P8300-EXIT. DTSCS26 -02099 DTSCS26 -02100 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS26 -02101 DTSCS26 -02102 *--------------------------------------------------- DTSCS26 -02103 * BATCH HEADER RECORD MUST EXIST DTSCS26 -02104 *--------------------------------------------------- DTSCS26 +02091 MOVE MAP-RECEIVED-DATE-AREA TO L015-S-DATE-AREA. DTSCS26 +02092 DTSCS26 +02093 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS26 +02094 DTSCS26 +02095 MOVE L015-DATE TO WRK-RECEIVED-DATE. DTSCS26 +02096 P8220-EXIT. DTSCS26 +02097 EXIT. DTSCS26 +02098 DTSCS26 +02099 /*****************************************************************DTSCS26 +02100 * IF ENTER OR CANCEL, MODULE IS SET TO INQUIRY REGARDLESS *DTSCS26 +02101 ******************************************************************DTSCS26 +02102 DTSCS26 +02103 P8300-DEL. DTSCS26 +02104 SET LCCM-SCR-INQUIRE TO TRUE. DTSCS26 02105 DTSCS26 -02106 *****IF WRK-BATCH-NO > +0 DTSCS26 -02107 ********MOVE +1000 TO WRK-TRAN-MAX DTSCS26 -02108 **********************WRK-ITEM-MAX. DTSCS26 -02109 DTSCS26 -02110 PERFORM P8910-CHECK-BATCH THRU P8910-EXIT. DTSCS26 +02106 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS26 +02107 DTSCS26 +02108 IF LCCM-F12-88 DTSCS26 +02109 MOVE PMSG-DEL-CANCELED TO LCCM-MSG-ID DTSCS26 +02110 GO TO P8300-EXIT. DTSCS26 02111 DTSCS26 -02112 *****MOVE -99999 TO L372-BATCH-NO. DTSCS26 +02112 PERFORM S1100-EDIT-KEY THRU S1100-EXIT. DTSCS26 02113 DTSCS26 -02114 *****SET L372-REC-NOT-FOUND TO TRUE. DTSCS26 -02115 DTSCS26 -02116 IF LCCM-MSG DTSCS26 -02117 GO TO P8300-EXIT. DTSCS26 -02118 DTSCS26 -02119 DTSCS26 -02120 MOVE WRK-BATCH-NO TO L371-BATCH-NO. DTSCS26 +02114 *--------------------------------------------------- DTSCS26 +02115 * BATCH HEADER RECORD MUST EXIST DTSCS26 +02116 *--------------------------------------------------- DTSCS26 +02117 DTSCS26 +02118 *****IF WRK-BATCH-NO > +0 DTSCS26 +02119 ********MOVE +1000 TO WRK-TRAN-MAX DTSCS26 +02120 **********************WRK-ITEM-MAX. DTSCS26 02121 DTSCS26 -02122 MOVE WRK-ITEM-NO TO L371-ITEM-NO. DTSCS26 +02122 PERFORM P8910-CHECK-BATCH THRU P8910-EXIT. DTSCS26 02123 DTSCS26 -02124 PERFORM S371-DELETE THRU S371-EXIT. DTSCS26 +02124 *****MOVE -99999 TO L372-BATCH-NO. DTSCS26 02125 DTSCS26 -02126 SET WRK-AATH-ACTION-DEL-88 TO TRUE. DTSCS26 -02127 PERFORM S826-WRITE-ATH THRU S826-EXIT. DTSCS26 -02128 DTSCS26 -02129 *& MOVE 'D' TO L221-UPDATE-FUNCTION. DTSCS26 -02130 *& PERFORM S221-WRITE-R906 THRU S221-EXIT. DTSCS26 +02126 *****SET L372-REC-NOT-FOUND TO TRUE. DTSCS26 +02127 DTSCS26 +02128 IF LCCM-MSG DTSCS26 +02129 GO TO P8300-EXIT. DTSCS26 +02130 DTSCS26 02131 DTSCS26 -02132 MOVE LOW-VALUES TO MAP-AREA. DTSCS26 +02132 MOVE WRK-BATCH-NO TO L371-BATCH-NO. DTSCS26 02133 DTSCS26 -02134 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS26 +02134 MOVE WRK-ITEM-NO TO L371-ITEM-NO. DTSCS26 02135 DTSCS26 -02136 MOVE LCCM-BATCH-NO TO MAP-BATCH-NO. DTSCS26 +02136 PERFORM S371-DELETE THRU S371-EXIT. DTSCS26 02137 DTSCS26 -02138 MOVE LCCM-ITEM-NO TO MAP-ITEM-NO. DTSCS26 -02139 DTSCS26 -02140 SET LCCM-SCR-CLEAR TO TRUE. DTSCS26 -02141 DTSCS26 -02142 MOVE PMSG-DEL-SUCCESSFUL TO LCCM-MSG-ID. DTSCS26 -02143 P8300-EXIT. DTSCS26 -02144 EXIT. DTSCS26 -02145 EJECT DTSCS26 -02146 P8910-CHECK-BATCH. DTSCS26 -02147 MOVE WRK-BATCH-NO TO L372-BATCH-NO. DTSCS26 -02148 DTSCS26 -02149 PERFORM S372-BATCH-INQUIRY THRU S372-EXIT. DTSCS26 -02150 DTSCS26 -02151 IF L372-REC-NOT-FOUND DTSCS26 -02152 MOVE EMSG-NO-BATCH TO WRK-MSG-AREA DTSCS26 -02153 PERFORM S1111-ERROR THRU S1111-EXIT DTSCS26 -02154 GO TO P8910-EXIT. DTSCS26 -02155 P8910-EXIT. DTSCS26 +02138 SET WRK-AATH-ACTION-DEL-88 TO TRUE. DTSCS26 +02139 PERFORM S826-WRITE-ATH THRU S826-EXIT. DTSCS26 +02140 DTSCS26 +02141 *& MOVE 'D' TO L221-UPDATE-FUNCTION. DTSCS26 +02142 *& PERFORM S221-WRITE-R906 THRU S221-EXIT. DTSCS26 +02143 DTSCS26 +02144 MOVE LOW-VALUES TO MAP-AREA. DTSCS26 +02145 DTSCS26 +02146 PERFORM S5200-SET-UPDATE-ATTRB THRU S5200-EXIT. DTSCS26 +02147 DTSCS26 +02148 MOVE LCCM-BATCH-NO TO MAP-BATCH-NO. DTSCS26 +02149 DTSCS26 +02150 MOVE LCCM-ITEM-NO TO MAP-ITEM-NO. DTSCS26 +02151 DTSCS26 +02152 SET LCCM-SCR-CLEAR TO TRUE. DTSCS26 +02153 DTSCS26 +02154 MOVE PMSG-DEL-SUCCESSFUL TO LCCM-MSG-ID. DTSCS26 +02155 P8300-EXIT. DTSCS26 02156 EXIT. DTSCS26 -02157 SKIP3 DTSCS26 -02158 P8920-CONSTRUCT-AADJ. DTSCS26 -02159 MOVE LOW-VALUES TO AADJ-REC. DTSCS26 +02157 EJECT DTSCS26 +02158 P8910-CHECK-BATCH. DTSCS26 +02159 MOVE WRK-BATCH-NO TO L372-BATCH-NO. DTSCS26 02160 DTSCS26 -02161 DTSCS26 -02162 MOVE WRK-BATCH-NO TO AADJ-BATCH-NO. DTSCS26 -02163 DTSCS26 -02164 MOVE WRK-ITEM-NO TO AADJ-ITEM-NO. DTSCS26 -02165 DTSCS26 -02166 SET AADJ-ADJ-88 TO TRUE. DTSCS26 -02167 DTSCS26 -02168 DTSCS26 -02169 * DATA HAS BEEN EDITED AND STORED INCLUDING DEFAULTS IN WRK-* DTSCS26 -02170 DTSCS26 -02171 MOVE MAP-NAME-CHECK TO AADJ-NAME-CHECK. DTSCS26 +02161 PERFORM S372-BATCH-INQUIRY THRU S372-EXIT. DTSCS26 +02162 DTSCS26 +02163 IF L372-REC-NOT-FOUND DTSCS26 +02164 MOVE EMSG-NO-BATCH TO WRK-MSG-AREA DTSCS26 +02165 PERFORM S1111-ERROR THRU S1111-EXIT DTSCS26 +02166 GO TO P8910-EXIT. DTSCS26 +02167 P8910-EXIT. DTSCS26 +02168 EXIT. DTSCS26 +02169 SKIP3 DTSCS26 +02170 P8920-CONSTRUCT-AADJ. DTSCS26 +02171 MOVE LOW-VALUES TO AADJ-REC. DTSCS26 02172 DTSCS26 -02173 MOVE WRK-EMP-NO TO AADJ-EMP-NO. DTSCS26 -02174 DTSCS26 -02175 MOVE MAP-ADJ-TYPE TO AADJ-ADJ-TYPE. DTSCS26 -02176 DTSCS26 -02177 MOVE WRK-AMT TO AADJ-AMT. DTSCS26 -02178 DTSCS26 -02179 MOVE WRK-RECEIVED-DATE TO AADJ-RECEIVED-DATE. DTSCS26 +02173 DTSCS26 +02174 MOVE WRK-BATCH-NO TO AADJ-BATCH-NO. DTSCS26 +02175 DTSCS26 +02176 MOVE WRK-ITEM-NO TO AADJ-ITEM-NO. DTSCS26 +02177 DTSCS26 +02178 SET AADJ-ADJ-88 TO TRUE. DTSCS26 +02179 DTSCS26 02180 DTSCS26 -02181 MOVE +0 TO AADJ-DEPOSIT-DATE. DTSCS26 +02181 * DATA HAS BEEN EDITED AND STORED INCLUDING DEFAULTS IN WRK-* DTSCS26 02182 DTSCS26 -02183 MOVE WRK-APPLIC-YRQ TO AADJ-APPLIC-YRQ. DTSCS26 +02183 MOVE MAP-NAME-CHECK TO AADJ-NAME-CHECK. DTSCS26 02184 DTSCS26 -02185 MOVE WRK-APPLIC-IND TO AADJ-APPLIC-IND. DTSCS26 +02185 MOVE WRK-EMP-NO TO AADJ-EMP-NO. DTSCS26 02186 DTSCS26 -02187 MOVE WRK-APPLIC-DOC-NO TO AADJ-APPLIC-DOC-NO. DTSCS26 +02187 MOVE MAP-ADJ-TYPE TO AADJ-ADJ-TYPE. DTSCS26 02188 DTSCS26 -02189 MOVE WRK-DATE-1 TO AADJ-DATE-1. DTSCS26 +02189 MOVE WRK-AMT TO AADJ-AMT. DTSCS26 02190 DTSCS26 -02191 MOVE WRK-DATE-2 TO AADJ-DATE-2. DTSCS26 +02191 MOVE WRK-RECEIVED-DATE TO AADJ-RECEIVED-DATE. DTSCS26 02192 DTSCS26 -02193 MOVE MAP-INT-SPAN-IND TO AADJ-INT-SPAN-IND. DTSCS26 +02193 MOVE +0 TO AADJ-DEPOSIT-DATE. DTSCS26 02194 DTSCS26 -02195 MOVE WRK-INT-RATE TO AADJ-INT-RATE. DTSCS26 +02195 MOVE WRK-APPLIC-YRQ TO AADJ-APPLIC-YRQ. DTSCS26 02196 DTSCS26 -02197 MOVE MAP-DISREGARD-EDITS-IND TO AADJ-DISREGARD-EDITS-IND. DTSCS26 +02197 MOVE WRK-APPLIC-IND TO AADJ-APPLIC-IND. DTSCS26 02198 DTSCS26 -02199 MOVE MAP-RESPONSIBLE-ACTIVITY TO AADJ-RESPONSIBLE-ACTIVITY. DTSCS26 +02199 MOVE WRK-APPLIC-DOC-NO TO AADJ-APPLIC-DOC-NO. DTSCS26 02200 DTSCS26 -02201 MOVE MAP-RESPONSIBLE-OP-ID TO AADJ-RESPONSIBLE-OP-ID. DTSCS26 +02201 MOVE WRK-DATE-1 TO AADJ-DATE-1. DTSCS26 02202 DTSCS26 -02203 IF MAP-CMPRMISE-YES-88 DTSCS26 -02204 IF LCCM-ENTER-88 DTSCS26 -02205 MOVE MCMP-ESTB-ABSTIME TO AADJ-CMP-ESTB-ABSTIME DTSCS26 -02206 END-IF DTSCS26 -02207 ELSE DTSCS26 -02208 MOVE ZERO TO AADJ-CMP-ESTB-ABSTIME DTSCS26 -02209 END-IF. DTSCS26 +02203 MOVE WRK-DATE-2 TO AADJ-DATE-2. DTSCS26 +02204 DTSCS26 +02205 MOVE MAP-INT-SPAN-IND TO AADJ-INT-SPAN-IND. DTSCS26 +02206 DTSCS26 +02207 MOVE WRK-INT-RATE TO AADJ-INT-RATE. DTSCS26 +02208 DTSCS26 +02209 MOVE MAP-DISREGARD-EDITS-IND TO AADJ-DISREGARD-EDITS-IND. DTSCS26 02210 DTSCS26 -02211 SET AADJ-NOT-PROCESSED-88 TO TRUE. DTSCS26 -02212 P8920-EXIT. DTSCS26 -02213 EXIT. DTSCS26 -02214 /*****************************************************************DTSCS26 -02215 * LINKS TO UTILITY MODULES DTSCS26 -02216 ******************************************************************DTSCS26 -02217 DTSCS26 -02218 DTSCS26 -02219 S001-FROM-FED-8. DTSCS26 -02220 SET L001-FROM-FED-8 TO TRUE. DTSCS26 -02221 GO TO S001-DATE. DTSCS26 +02211 MOVE MAP-RESPONSIBLE-ACTIVITY TO AADJ-RESPONSIBLE-ACTIVITY. DTSCS26 +02212 DTSCS26 +02213 MOVE MAP-RESPONSIBLE-OP-ID TO AADJ-RESPONSIBLE-OP-ID. DTSCS26 +02214 DTSCS26 +02215 IF MAP-CMPRMISE-YES-88 DTSCS26 +02216 IF LCCM-ENTER-88 DTSCS26 +02217 MOVE MCMP-ESTB-ABSTIME TO AADJ-CMP-ESTB-ABSTIME DTSCS26 +02218 END-IF DTSCS26 +02219 ELSE DTSCS26 +02220 MOVE ZERO TO AADJ-CMP-ESTB-ABSTIME DTSCS26 +02221 END-IF. DTSCS26 02222 DTSCS26 -02223 S001-FROM-ABS-DAY. DTSCS26 -02224 SET L001-FROM-ABS-DAY TO TRUE. DTSCS26 -02225 GO TO S001-DATE. DTSCS26 -02226 DTSCS26 -02227 S001-DATE. DTSCS26 -02228 EXEC CICS LINK DTSCS26 -02229 PROGRAM('DTSCU001') DTSCS26 -02230 COMMAREA(L001-COMM-AREA) DTSCS26 -02231 END-EXEC. DTSCS26 -02232 S001-EXIT. DTSCS26 -02233 EXIT. DTSCS26 +02223 SET AADJ-NOT-PROCESSED-88 TO TRUE. DTSCS26 +02224 P8920-EXIT. DTSCS26 +02225 EXIT. DTSCS26 +02226 /*****************************************************************DTSCS26 +02227 * LINKS TO UTILITY MODULES DTSCS26 +02228 ******************************************************************DTSCS26 +02229 DTSCS26 +02230 DTSCS26 +02231 S001-FROM-FED-8. DTSCS26 +02232 SET L001-FROM-FED-8 TO TRUE. DTSCS26 +02233 GO TO S001-DATE. DTSCS26 02234 DTSCS26 -02235 DTSCS26 -02236 DTSCS26 -02237 S011-AMT-FROM-SCREEN. DTSCS26 -02238 MOVE -999999999.98 TO L011-MIN-AMT DTSCS26 -02239 MOVE +999999999.99 TO L011-MAX-AMT DTSCS26 -02240 GO TO S011-MONEY-FROM-SCREEN. DTSCS26 -02241 DTSCS26 -02242 S011-MONEY-FROM-SCREEN. DTSCS26 -02243 EXEC CICS LINK DTSCS26 -02244 PROGRAM('DTSCU011') DTSCS26 -02245 COMMAREA(L011-COMM-AREA) DTSCS26 -02246 END-EXEC. DTSCS26 -02247 S011-EXIT. DTSCS26 -02248 EXIT. DTSCS26 -02249 DTSCS26 -02250 DTSCS26 -02251 DTSCS26 -02252 S012-RATE-FROM-SCREEN. DTSCS26 -02253 EXEC CICS LINK DTSCS26 -02254 PROGRAM('DTSCU012') DTSCS26 -02255 COMMAREA(L012-COMM-AREA) DTSCS26 -02256 END-EXEC. DTSCS26 -02257 S012-EXIT. DTSCS26 -02258 EXIT. DTSCS26 -02259 DTSCS26 -02260 DTSCS26 +02235 S001-FROM-ABS-DAY. DTSCS26 +02236 SET L001-FROM-ABS-DAY TO TRUE. DTSCS26 +02237 GO TO S001-DATE. DTSCS26 +02238 DTSCS26 +02239 S001-DATE. DTSCS26 +02240 EXEC CICS LINK DTSCS26 +02241 PROGRAM('DTSCU001') DTSCS26 +02242 COMMAREA(L001-COMM-AREA) DTSCS26 +02243 END-EXEC. DTSCS26 +02244 S001-EXIT. DTSCS26 +02245 EXIT. DTSCS26 +02246 DTSCS26 +02247 DTSCS26 +02248 DTSCS26 +02249 S011-AMT-FROM-SCREEN. DTSCS26 +02250 MOVE -999999999.98 TO L011-MIN-AMT DTSCS26 +02251 MOVE +999999999.99 TO L011-MAX-AMT DTSCS26 +02252 GO TO S011-MONEY-FROM-SCREEN. DTSCS26 +02253 DTSCS26 +02254 S011-MONEY-FROM-SCREEN. DTSCS26 +02255 EXEC CICS LINK DTSCS26 +02256 PROGRAM('DTSCU011') DTSCS26 +02257 COMMAREA(L011-COMM-AREA) DTSCS26 +02258 END-EXEC. DTSCS26 +02259 S011-EXIT. DTSCS26 +02260 EXIT. DTSCS26 02261 DTSCS26 -02262 S015-DATE-FROM-SCREEN. DTSCS26 -02263 EXEC CICS LINK DTSCS26 -02264 PROGRAM('DTSCU015') DTSCS26 -02265 COMMAREA(L015-COMM-AREA) DTSCS26 -02266 END-EXEC. DTSCS26 -02267 S015-EXIT. DTSCS26 -02268 EXIT. DTSCS26 -02269 DTSCS26 -02270 DTSCS26 +02262 DTSCS26 +02263 DTSCS26 +02264 S012-RATE-FROM-SCREEN. DTSCS26 +02265 EXEC CICS LINK DTSCS26 +02266 PROGRAM('DTSCU012') DTSCS26 +02267 COMMAREA(L012-COMM-AREA) DTSCS26 +02268 END-EXEC. DTSCS26 +02269 S012-EXIT. DTSCS26 +02270 EXIT. DTSCS26 02271 DTSCS26 -02272 S018-EMP-NO-FROM-SCREEN. DTSCS26 -02273 EXEC CICS LINK DTSCS26 -02274 PROGRAM('DTSCU018') DTSCS26 -02275 COMMAREA(L018-COMM-AREA) DTSCS26 -02276 END-EXEC. DTSCS26 -02277 S018-EXIT. DTSCS26 -02278 EXIT. DTSCS26 -02279 DTSCS26 -02280 DTSCS26 +02272 DTSCS26 +02273 DTSCS26 +02274 S015-DATE-FROM-SCREEN. DTSCS26 +02275 EXEC CICS LINK DTSCS26 +02276 PROGRAM('DTSCU015') DTSCS26 +02277 COMMAREA(L015-COMM-AREA) DTSCS26 +02278 END-EXEC. DTSCS26 +02279 S015-EXIT. DTSCS26 +02280 EXIT. DTSCS26 02281 DTSCS26 -02282 S019-BATCH-NO-FROM-SCREEN. DTSCS26 -02283 EXEC CICS LINK DTSCS26 -02284 PROGRAM('DTSCU019') DTSCS26 -02285 COMMAREA(L019-COMM-AREA) DTSCS26 -02286 END-EXEC. DTSCS26 -02287 S019-EXIT. DTSCS26 -02288 EXIT. DTSCS26 -02289 DTSCS26 -02290 DTSCS26 +02282 DTSCS26 +02283 DTSCS26 +02284 S018-EMP-NO-FROM-SCREEN. DTSCS26 +02285 EXEC CICS LINK DTSCS26 +02286 PROGRAM('DTSCU018') DTSCS26 +02287 COMMAREA(L018-COMM-AREA) DTSCS26 +02288 END-EXEC. DTSCS26 +02289 S018-EXIT. DTSCS26 +02290 EXIT. DTSCS26 02291 DTSCS26 -02292 S029-YRQ-FROM-SCREEN. DTSCS26 -02293 EXEC CICS LINK DTSCS26 -02294 PROGRAM ('DTSCU029') DTSCS26 -02295 COMMAREA (L029-COMM-AREA) DTSCS26 -02296 END-EXEC. DTSCS26 -02297 S029-EXIT. DTSCS26 -02298 EXIT. DTSCS26 -02299 DTSCS26 -02300 DTSCS26 +02292 DTSCS26 +02293 DTSCS26 +02294 S019-BATCH-NO-FROM-SCREEN. DTSCS26 +02295 EXEC CICS LINK DTSCS26 +02296 PROGRAM('DTSCU019') DTSCS26 +02297 COMMAREA(L019-COMM-AREA) DTSCS26 +02298 END-EXEC. DTSCS26 +02299 S019-EXIT. DTSCS26 +02300 EXIT. DTSCS26 02301 DTSCS26 -02302 S032-AADJ-APPLIC-IND. DTSCS26 -02303 SET L032-AADJ-APPLIC-IND TO TRUE. DTSCS26 -02304 GO TO S032-LINK. DTSCS26 -02305 DTSCS26 -02306 S032-AADJ-ADJ-TYPE. DTSCS26 -02307 SET L032-AADJ-ADJ-TYPE TO TRUE. DTSCS26 -02308 GO TO S032-LINK. DTSCS26 -02309 DTSCS26 -02310 S032-AADJ-RESPONSIBLE-ACTIVITY. DTSCS26 -02311 SET L032-AADJ-RESPONSIBLE-ACTIVITY TO TRUE. DTSCS26 -02312 GO TO S032-LINK. DTSCS26 +02302 DTSCS26 +02303 DTSCS26 +02304 S029-YRQ-FROM-SCREEN. DTSCS26 +02305 EXEC CICS LINK DTSCS26 +02306 PROGRAM ('DTSCU029') DTSCS26 +02307 COMMAREA (L029-COMM-AREA) DTSCS26 +02308 END-EXEC. DTSCS26 +02309 S029-EXIT. DTSCS26 +02310 EXIT. DTSCS26 +02311 DTSCS26 +02312 DTSCS26 02313 DTSCS26 -02314 S032-LINK. DTSCS26 -02315 EXEC CICS LINK DTSCS26 -02316 PROGRAM ('DTSCU032') DTSCS26 -02317 COMMAREA (L032-COMM-AREA) DTSCS26 -02318 END-EXEC. DTSCS26 -02319 S032-EXIT. DTSCS26 -02320 EXIT. DTSCS26 +02314 S032-AADJ-APPLIC-IND. DTSCS26 +02315 SET L032-AADJ-APPLIC-IND TO TRUE. DTSCS26 +02316 GO TO S032-LINK. DTSCS26 +02317 DTSCS26 +02318 S032-AADJ-ADJ-TYPE. DTSCS26 +02319 SET L032-AADJ-ADJ-TYPE TO TRUE. DTSCS26 +02320 GO TO S032-LINK. DTSCS26 02321 DTSCS26 -02322 DTSCS26 -02323 DTSCS26 -02324 S056-DISP1-LEFT. DTSCS26 -02325 SET L056-DISP1-LEFT-88 TO TRUE. DTSCS26 -02326 DTSCS26 +02322 S032-AADJ-RESPONSIBLE-ACTIVITY. DTSCS26 +02323 SET L032-AADJ-RESPONSIBLE-ACTIVITY TO TRUE. DTSCS26 +02324 GO TO S032-LINK. DTSCS26 +02325 DTSCS26 +02326 S032-LINK. DTSCS26 02327 EXEC CICS LINK DTSCS26 -02328 PROGRAM ('DTSCU056') DTSCS26 -02329 COMMAREA (L056-COMM-AREA) DTSCS26 +02328 PROGRAM ('DTSCU032') DTSCS26 +02329 COMMAREA (L032-COMM-AREA) DTSCS26 02330 END-EXEC. DTSCS26 -02331 S056-EXIT. DTSCS26 +02331 S032-EXIT. DTSCS26 02332 EXIT. DTSCS26 02333 DTSCS26 02334 DTSCS26 -02335 DTSCS26 -02336 S082-OP-ID-LOOKUP. DTSCS26 -02337 EXEC CICS LINK DTSCS26 -02338 PROGRAM ('DTSCU082') DTSCS26 -02339 COMMAREA (L082-COMM-AREA) DTSCS26 -02340 END-EXEC. DTSCS26 -02341 DTSCS26 -02342 IF L082-FILE-CLOSED DTSCS26 -02343 MOVE L082-MSG-AREA TO LCCM-MSG-AREA DTSCS26 -02344 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS26 -02345 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS26 -02346 GO TO MAINLINE-EXIT. DTSCS26 -02347 S082-EXIT. DTSCS26 -02348 EXIT. DTSCS26 -02349 DTSCS26 -02350 S221-WRITE-R906. DTSCS26 -02351 MOVE AADJ-EMP-NO TO L221-EMP-NO. DTSCS26 -02352 MOVE LCCM-SCR-ABSTIME TO L221-SCR-ABSTIME. DTSCS26 -02353 MOVE LCCM-TASK-ID TO L221-UPDATE-TASK-ID. DTSCS26 -02354 MOVE LCCM-OP-ID TO L221-UPDATE-OP-ID. DTSCS26 -02355 MOVE LCCM-CICS-TERM-ID TO L221-UPDATE-TERMID. DTSCS26 -02356 MOVE LCCM-TASK-NETNAME TO L221-UPDATE-NETNAME. DTSCS26 -02357 MOVE LCCM-TASK-START-DATE TO L221-UPDATE-START-DATE. DTSCS26 -02358 MOVE LCCM-TASK-START-TIME TO L221-UPDATE-START-TIME. DTSCS26 -02359 MOVE WRK-SCR-ID TO L221-UPDATE-SCR-ID. DTSCS26 -02360 MOVE AADJ-BATCH-NO TO L221-BATCH-NO. DTSCS26 -02361 MOVE AADJ-ITEM-NO TO L221-ITEM-NO. DTSCS26 -02362 DTSCS26 -02363 SET L221-R906-ONLY TO TRUE. DTSCS26 -02364 DTSCS26 -02365 EXEC CICS LINK DTSCS26 -02366 PROGRAM ('DTSCU221') DTSCS26 -02367 COMMAREA (L221-COMM-AREA) DTSCS26 -02368 END-EXEC. DTSCS26 -02369 DTSCS26 -02370 IF L221-FILE-CLOSED DTSCS26 -02371 MOVE L221-MSG-AREA TO LCCM-MSG-AREA DTSCS26 -02372 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS26 -02373 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS26 -02374 GO TO MAINLINE-EXIT. DTSCS26 -02375 DTSCS26 -02376 IF L221-NOT-OK DTSCS26 -02377 MOVE L221-MSG-AREA TO LCCM-MSG-AREA. DTSCS26 -02378 DTSCS26 -02379 S221-EXIT. DTSCS26 -02380 EXIT. DTSCS26 -02381 DTSCS26 -02382 S371-DELETE. DTSCS26 -02383 EXEC CICS LINK DTSCS26 -02384 PROGRAM ('DTSCU371') DTSCS26 -02385 COMMAREA (L371-COMM-AREA) DTSCS26 -02386 END-EXEC. DTSCS26 -02387 DTSCS26 -02388 IF L371-FILE-CLOSED DTSCS26 -02389 MOVE L371-MSG-AREA TO LCCM-MSG-AREA DTSCS26 -02390 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS26 -02391 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS26 -02392 GO TO MAINLINE-EXIT. DTSCS26 -02393 S371-EXIT. DTSCS26 -02394 EXIT. DTSCS26 -02395 DTSCS26 -02396 DTSCS26 -02397 DTSCS26 -02398 S372-BATCH-INQUIRY. DTSCS26 -02399 SET L372-INQUIRE TO TRUE. DTSCS26 -02400 GO TO S372-LINK. DTSCS26 -02401 DTSCS26 -02402 S372-BATCH-UPDATE. DTSCS26 -02403 SET L372-UPDATE TO TRUE. DTSCS26 -02404 GO TO S372-LINK. DTSCS26 +02335 S084-APPROVAL. CL**3 +02336 EXEC CICS LINK CL**3 +02337 PROGRAM ('DTSCU084') CL**3 +02338 COMMAREA (L084-COMM-AREA) CL**3 +02339 END-EXEC. CL**3 +02340 CL**3 +02341 IF L084-FILE-CLOSED-88 CL**3 +02342 SET LCCM-REQ-SCR-SF-88 TO TRUE CL**3 +02343 SET LCCM-LINK-SCREEN-88 TO TRUE CL**3 +02344 GO TO MAINLINE-EXIT. CL**3 +02345 S084-EXIT. CL**3 +02346 EXIT. CL**3 +02347 DTSCS26 +02348 S056-DISP1-LEFT. DTSCS26 +02349 SET L056-DISP1-LEFT-88 TO TRUE. DTSCS26 +02350 DTSCS26 +02351 EXEC CICS LINK DTSCS26 +02352 PROGRAM ('DTSCU056') DTSCS26 +02353 COMMAREA (L056-COMM-AREA) DTSCS26 +02354 END-EXEC. DTSCS26 +02355 S056-EXIT. DTSCS26 +02356 EXIT. DTSCS26 +02357 DTSCS26 +02358 DTSCS26 +02359 DTSCS26 +02360 S082-OP-ID-LOOKUP. DTSCS26 +02361 EXEC CICS LINK DTSCS26 +02362 PROGRAM ('DTSCU082') DTSCS26 +02363 COMMAREA (L082-COMM-AREA) DTSCS26 +02364 END-EXEC. DTSCS26 +02365 DTSCS26 +02366 IF L082-FILE-CLOSED DTSCS26 +02367 MOVE L082-MSG-AREA TO LCCM-MSG-AREA DTSCS26 +02368 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS26 +02369 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS26 +02370 GO TO MAINLINE-EXIT. DTSCS26 +02371 S082-EXIT. DTSCS26 +02372 EXIT. DTSCS26 +02373 DTSCS26 +02374 S221-WRITE-R906. DTSCS26 +02375 MOVE AADJ-EMP-NO TO L221-EMP-NO. DTSCS26 +02376 MOVE LCCM-SCR-ABSTIME TO L221-SCR-ABSTIME. DTSCS26 +02377 MOVE LCCM-TASK-ID TO L221-UPDATE-TASK-ID. DTSCS26 +02378 MOVE LCCM-OP-ID TO L221-UPDATE-OP-ID. DTSCS26 +02379 MOVE LCCM-CICS-TERM-ID TO L221-UPDATE-TERMID. DTSCS26 +02380 MOVE LCCM-TASK-NETNAME TO L221-UPDATE-NETNAME. DTSCS26 +02381 MOVE LCCM-TASK-START-DATE TO L221-UPDATE-START-DATE. DTSCS26 +02382 MOVE LCCM-TASK-START-TIME TO L221-UPDATE-START-TIME. DTSCS26 +02383 MOVE WRK-SCR-ID TO L221-UPDATE-SCR-ID. DTSCS26 +02384 MOVE AADJ-BATCH-NO TO L221-BATCH-NO. DTSCS26 +02385 MOVE AADJ-ITEM-NO TO L221-ITEM-NO. DTSCS26 +02386 DTSCS26 +02387 SET L221-R906-ONLY TO TRUE. DTSCS26 +02388 DTSCS26 +02389 EXEC CICS LINK DTSCS26 +02390 PROGRAM ('DTSCU221') DTSCS26 +02391 COMMAREA (L221-COMM-AREA) DTSCS26 +02392 END-EXEC. DTSCS26 +02393 DTSCS26 +02394 IF L221-FILE-CLOSED DTSCS26 +02395 MOVE L221-MSG-AREA TO LCCM-MSG-AREA DTSCS26 +02396 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS26 +02397 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS26 +02398 GO TO MAINLINE-EXIT. DTSCS26 +02399 DTSCS26 +02400 IF L221-NOT-OK DTSCS26 +02401 MOVE L221-MSG-AREA TO LCCM-MSG-AREA. DTSCS26 +02402 DTSCS26 +02403 S221-EXIT. DTSCS26 +02404 EXIT. DTSCS26 02405 DTSCS26 -02406 S372-LINK. DTSCS26 +02406 S371-DELETE. DTSCS26 02407 EXEC CICS LINK DTSCS26 -02408 PROGRAM ('DTSCU372') DTSCS26 -02409 COMMAREA (L372-COMM-AREA) DTSCS26 +02408 PROGRAM ('DTSCU371') DTSCS26 +02409 COMMAREA (L371-COMM-AREA) DTSCS26 02410 END-EXEC. DTSCS26 02411 DTSCS26 -02412 IF L372-FILE-CLOSED DTSCS26 -02413 MOVE L372-MSG-AREA TO LCCM-MSG-AREA DTSCS26 +02412 IF L371-FILE-CLOSED DTSCS26 +02413 MOVE L371-MSG-AREA TO LCCM-MSG-AREA DTSCS26 02414 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS26 02415 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS26 02416 GO TO MAINLINE-EXIT. DTSCS26 -02417 S372-EXIT. DTSCS26 +02417 S371-EXIT. DTSCS26 02418 EXIT. DTSCS26 02419 DTSCS26 02420 DTSCS26 02421 DTSCS26 -02422 S381-LOOKUP-LIABILITY. DTSCS26 -02423 EXEC CICS LINK DTSCS26 -02424 PROGRAM ('DTSCU381') DTSCS26 -02425 COMMAREA (L381-COMM-AREA) DTSCS26 -02426 END-EXEC. DTSCS26 -02427 DTSCS26 -02428 IF L381-FILE-CLOSED-88 DTSCS26 -02429 MOVE L381-MSG-AREA TO LCCM-MSG-AREA DTSCS26 -02430 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS26 -02431 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS26 -02432 GO TO MAINLINE-EXIT. DTSCS26 -02433 S381-EXIT. DTSCS26 -02434 EXIT. DTSCS26 +02422 S372-BATCH-INQUIRY. DTSCS26 +02423 SET L372-INQUIRE TO TRUE. DTSCS26 +02424 GO TO S372-LINK. DTSCS26 +02425 DTSCS26 +02426 S372-BATCH-UPDATE. DTSCS26 +02427 SET L372-UPDATE TO TRUE. DTSCS26 +02428 GO TO S372-LINK. DTSCS26 +02429 DTSCS26 +02430 S372-LINK. DTSCS26 +02431 EXEC CICS LINK DTSCS26 +02432 PROGRAM ('DTSCU372') DTSCS26 +02433 COMMAREA (L372-COMM-AREA) DTSCS26 +02434 END-EXEC. DTSCS26 02435 DTSCS26 -02436 DTSCS26 -02437 DTSCS26 -02438 S410-FILING-SCHEDULE. DTSCS26 -02439 SET L410-MODE-INPUT-YRQ-88 TO TRUE. DTSCS26 -02440 DTSCS26 -02441 EXEC CICS LINK DTSCS26 -02442 PROGRAM ('DTSCU410') DTSCS26 -02443 COMMAREA (L410-COMM-AREA) DTSCS26 -02444 END-EXEC. DTSCS26 -02445 S410-EXIT. DTSCS26 -02446 EXIT. DTSCS26 -02447 DTSCS26 -02448 S803-REQ-SCR-ID-EDIT. DTSCS26 -02449 EXEC CICS LINK DTSCS26 -02450 PROGRAM ('DTSCU803') DTSCS26 -02451 COMMAREA (DFHCOMMAREA) DTSCS26 -02452 END-EXEC. DTSCS26 -02453 S803-EXIT. DTSCS26 -02454 EXIT. DTSCS26 -02455 DTSCS26 -02456 DTSCS26 -02457 DTSCS26 -02458 S804-INVALID-KEY. DTSCS26 -02459 EXEC CICS LINK DTSCS26 -02460 PROGRAM ('DTSCU804') DTSCS26 -02461 COMMAREA (DFHCOMMAREA) DTSCS26 -02462 END-EXEC. DTSCS26 -02463 S804-EXIT. DTSCS26 -02464 EXIT. DTSCS26 -02465 DTSCS26 -02466 DTSCS26 -02467 DTSCS26 -02468 S805-MSG-AREA. DTSCS26 -02469 MOVE LCCM-MSG-AREA TO L805-MSG-AREA DTSCS26 -02470 DTSCS26 -02471 EXEC CICS LINK DTSCS26 -02472 PROGRAM ('DTSCU805') DTSCS26 -02473 COMMAREA (L805-COMM-AREA) DTSCS26 -02474 END-EXEC. DTSCS26 -02475 DTSCS26 -02476 MOVE L805-S-MSG-AREA TO MAP-MSG-AREA. DTSCS26 -02477 S805-EXIT. DTSCS26 +02436 IF L372-FILE-CLOSED DTSCS26 +02437 MOVE L372-MSG-AREA TO LCCM-MSG-AREA DTSCS26 +02438 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS26 +02439 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS26 +02440 GO TO MAINLINE-EXIT. DTSCS26 +02441 S372-EXIT. DTSCS26 +02442 EXIT. DTSCS26 +02443 DTSCS26 +02444 DTSCS26 +02445 DTSCS26 +02446 S381-LOOKUP-LIABILITY. DTSCS26 +02447 EXEC CICS LINK DTSCS26 +02448 PROGRAM ('DTSCU381') DTSCS26 +02449 COMMAREA (L381-COMM-AREA) DTSCS26 +02450 END-EXEC. DTSCS26 +02451 DTSCS26 +02452 IF L381-FILE-CLOSED-88 DTSCS26 +02453 MOVE L381-MSG-AREA TO LCCM-MSG-AREA DTSCS26 +02454 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS26 +02455 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS26 +02456 GO TO MAINLINE-EXIT. DTSCS26 +02457 S381-EXIT. DTSCS26 +02458 EXIT. DTSCS26 +02459 DTSCS26 +02460 DTSCS26 +02461 DTSCS26 +02462 S410-FILING-SCHEDULE. DTSCS26 +02463 SET L410-MODE-INPUT-YRQ-88 TO TRUE. DTSCS26 +02464 DTSCS26 +02465 EXEC CICS LINK DTSCS26 +02466 PROGRAM ('DTSCU410') DTSCS26 +02467 COMMAREA (L410-COMM-AREA) DTSCS26 +02468 END-EXEC. DTSCS26 +02469 S410-EXIT. DTSCS26 +02470 EXIT. DTSCS26 +02471 DTSCS26 +02472 S803-REQ-SCR-ID-EDIT. DTSCS26 +02473 EXEC CICS LINK DTSCS26 +02474 PROGRAM ('DTSCU803') DTSCS26 +02475 COMMAREA (DFHCOMMAREA) DTSCS26 +02476 END-EXEC. DTSCS26 +02477 S803-EXIT. DTSCS26 02478 EXIT. DTSCS26 02479 DTSCS26 02480 DTSCS26 02481 DTSCS26 -02482 S810-READ. DTSCS26 -02483 SET L810-READ-88 TO TRUE. DTSCS26 -02484 GO TO S810-IO. DTSCS26 -02485 DTSCS26 -02486 S810-START-BROWSE. DTSCS26 -02487 SET L810-START-BROWSE-88 TO TRUE. DTSCS26 -02488 GO TO S810-IO. DTSCS26 +02482 S804-INVALID-KEY. DTSCS26 +02483 EXEC CICS LINK DTSCS26 +02484 PROGRAM ('DTSCU804') DTSCS26 +02485 COMMAREA (DFHCOMMAREA) DTSCS26 +02486 END-EXEC. DTSCS26 +02487 S804-EXIT. DTSCS26 +02488 EXIT. DTSCS26 02489 DTSCS26 -02490 S810-READ-NEXT. DTSCS26 -02491 SET L810-READ-NEXT-88 TO TRUE. DTSCS26 -02492 GO TO S810-IO. DTSCS26 -02493 DTSCS26 -02494 S810-IO. DTSCS26 -02495 DTSCS26 -02496 EXEC CICS LINK DTSCS26 -02497 PROGRAM ('DTSCU810') DTSCS26 -02498 COMMAREA (L810-COMM-AREA) DTSCS26 -02499 END-EXEC. DTSCS26 -02500 DTSCS26 -02501 IF L810-FILE-CLOSED-88 DTSCS26 -02502 MOVE L810-MSG-AREA TO LCCM-MSG-AREA DTSCS26 -02503 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS26 -02504 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS26 -02505 GO TO MAINLINE-EXIT. DTSCS26 -02506 S810-EXIT. DTSCS26 -02507 EXIT. DTSCS26 -02508 DTSCS26 +02490 DTSCS26 +02491 DTSCS26 +02492 S805-MSG-AREA. DTSCS26 +02493 MOVE LCCM-MSG-AREA TO L805-MSG-AREA DTSCS26 +02494 DTSCS26 +02495 EXEC CICS LINK DTSCS26 +02496 PROGRAM ('DTSCU805') DTSCS26 +02497 COMMAREA (L805-COMM-AREA) DTSCS26 +02498 END-EXEC. DTSCS26 +02499 DTSCS26 +02500 MOVE L805-S-MSG-AREA TO MAP-MSG-AREA. DTSCS26 +02501 S805-EXIT. DTSCS26 +02502 EXIT. DTSCS26 +02503 DTSCS26 +02504 DTSCS26 +02505 DTSCS26 +02506 S810-READ. DTSCS26 +02507 SET L810-READ-88 TO TRUE. DTSCS26 +02508 GO TO S810-IO. DTSCS26 02509 DTSCS26 -02510 DTSCS26 -02511 S823-READ. DTSCS26 -02512 SET L823-READ-88 TO TRUE. DTSCS26 -02513 GO TO S823-IO. DTSCS26 -02514 DTSCS26 -02515 S823-START-BROWSE. DTSCS26 -02516 SET L823-START-BROWSE-88 TO TRUE. DTSCS26 -02517 GO TO S823-IO. DTSCS26 -02518 DTSCS26 -02519 S823-READ-NEXT. DTSCS26 -02520 SET L823-READ-NEXT-88 TO TRUE. DTSCS26 -02521 GO TO S823-IO. DTSCS26 -02522 DTSCS26 -02523 S823-READ-PREV. DTSCS26 -02524 SET L823-READ-PREV-88 TO TRUE. DTSCS26 -02525 GO TO S823-IO. DTSCS26 -02526 DTSCS26 -02527 S823-END-BROWSE. DTSCS26 -02528 SET L823-END-BROWSE-88 TO TRUE. DTSCS26 -02529 GO TO S823-IO. DTSCS26 -02530 DTSCS26 -02531 S823-REWRITE. DTSCS26 -02532 SET L823-REWRITE-88 TO TRUE. DTSCS26 -02533 GO TO S823-IO. DTSCS26 +02510 S810-START-BROWSE. DTSCS26 +02511 SET L810-START-BROWSE-88 TO TRUE. DTSCS26 +02512 GO TO S810-IO. DTSCS26 +02513 DTSCS26 +02514 S810-READ-NEXT. DTSCS26 +02515 SET L810-READ-NEXT-88 TO TRUE. DTSCS26 +02516 GO TO S810-IO. DTSCS26 +02517 DTSCS26 +02518 S810-IO. DTSCS26 +02519 DTSCS26 +02520 EXEC CICS LINK DTSCS26 +02521 PROGRAM ('DTSCU810') DTSCS26 +02522 COMMAREA (L810-COMM-AREA) DTSCS26 +02523 END-EXEC. DTSCS26 +02524 DTSCS26 +02525 IF L810-FILE-CLOSED-88 DTSCS26 +02526 MOVE L810-MSG-AREA TO LCCM-MSG-AREA DTSCS26 +02527 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS26 +02528 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS26 +02529 GO TO MAINLINE-EXIT. DTSCS26 +02530 S810-EXIT. DTSCS26 +02531 EXIT. DTSCS26 +02532 DTSCS26 +02533 DTSCS26 02534 DTSCS26 -02535 S823-WRITE. DTSCS26 -02536 SET L823-WRITE-88 TO TRUE. DTSCS26 +02535 S823-READ. DTSCS26 +02536 SET L823-READ-88 TO TRUE. DTSCS26 02537 GO TO S823-IO. DTSCS26 02538 DTSCS26 -02539 *S823-DELETE. DTSCS26 -02540 *****SET L823-DELETE-88 TO TRUE. DTSCS26 -02541 *****GO TO S823-IO. DTSCS26 +02539 S823-START-BROWSE. DTSCS26 +02540 SET L823-START-BROWSE-88 TO TRUE. DTSCS26 +02541 GO TO S823-IO. DTSCS26 02542 DTSCS26 -02543 S823-IO. DTSCS26 -02544 EXEC CICS LINK DTSCS26 -02545 PROGRAM ('DTSCU823') DTSCS26 -02546 COMMAREA (L823-COMM-AREA) DTSCS26 -02547 END-EXEC. DTSCS26 -02548 DTSCS26 -02549 IF L823-FILE-CLOSED-88 DTSCS26 -02550 MOVE L823-MSG-AREA TO LCCM-MSG-AREA DTSCS26 -02551 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS26 -02552 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS26 -02553 GO TO MAINLINE-EXIT. DTSCS26 -02554 S823-EXIT. DTSCS26 -02555 EXIT. DTSCS26 -02556 DTSCS26 -02557 S826-WRITE-ATH. DTSCS26 -02558 MOVE LOW-VALUES TO AATH-REC. DTSCS26 -02559 DTSCS26 -02560 MOVE WRK-BATCH-NO TO AATH-BATCH-NO. DTSCS26 -02561 MOVE WRK-ITEM-NO TO AATH-ITEM-NO. DTSCS26 -02562 IF WRK-AATH-ACTION-DEL-88 DTSCS26 -02563 SET AATH-ADJ-88 TO TRUE DTSCS26 -02564 ELSE DTSCS26 -02565 MOVE AADJ-DATA-AREA TO AATH-DATA-AREA DTSCS26 -02566 END-IF. DTSCS26 -02567 MOVE LCCM-OP-ID TO AATH-OP-ID. DTSCS26 -02568 MOVE ZERO TO AATH-DATE DTSCS26 -02569 AATH-TIME. DTSCS26 -02570 MOVE WRK-AATH-ACTION TO AATH-ACTION. DTSCS26 -02571 DTSCS26 -02572 EXEC CICS LINK DTSCS26 -02573 PROGRAM ('DTSCU826') DTSCS26 -02574 COMMAREA (L826-COMM-AREA) DTSCS26 -02575 END-EXEC. DTSCS26 -02576 DTSCS26 -02577 IF L826-FILE-CLOSED-88 DTSCS26 -02578 MOVE L826-MSG-AREA TO LCCM-MSG-AREA DTSCS26 -02579 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS26 -02580 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS26 -02581 GO TO MAINLINE-EXIT. DTSCS26 -02582 DTSCS26 -02583 S826-EXIT. DTSCS26 -02584 EXIT. DTSCS26 -02585 DTSCS26 -02586 DTSCS26 -02587 S851-SCREEN-PROCESSING. DTSCS26 -02588 EXEC CICS LINK DTSCS26 -02589 PROGRAM ('DTSCU851') DTSCS26 -02590 COMMAREA (L851-COMM-AREA) DTSCS26 -02591 END-EXEC. DTSCS26 -02592 S851-EXIT. DTSCS26 -02593 EXIT. DTSCS26 -02594 DTSCS26 +02543 S823-READ-NEXT. DTSCS26 +02544 SET L823-READ-NEXT-88 TO TRUE. DTSCS26 +02545 GO TO S823-IO. DTSCS26 +02546 DTSCS26 +02547 S823-READ-PREV. DTSCS26 +02548 SET L823-READ-PREV-88 TO TRUE. DTSCS26 +02549 GO TO S823-IO. DTSCS26 +02550 DTSCS26 +02551 S823-END-BROWSE. DTSCS26 +02552 SET L823-END-BROWSE-88 TO TRUE. DTSCS26 +02553 GO TO S823-IO. DTSCS26 +02554 DTSCS26 +02555 S823-REWRITE. DTSCS26 +02556 SET L823-REWRITE-88 TO TRUE. DTSCS26 +02557 GO TO S823-IO. DTSCS26 +02558 DTSCS26 +02559 S823-WRITE. DTSCS26 +02560 SET L823-WRITE-88 TO TRUE. DTSCS26 +02561 GO TO S823-IO. DTSCS26 +02562 DTSCS26 +02563 *S823-DELETE. DTSCS26 +02564 *****SET L823-DELETE-88 TO TRUE. DTSCS26 +02565 *****GO TO S823-IO. DTSCS26 +02566 DTSCS26 +02567 S823-IO. DTSCS26 +02568 EXEC CICS LINK DTSCS26 +02569 PROGRAM ('DTSCU823') DTSCS26 +02570 COMMAREA (L823-COMM-AREA) DTSCS26 +02571 END-EXEC. DTSCS26 +02572 DTSCS26 +02573 IF L823-FILE-CLOSED-88 DTSCS26 +02574 MOVE L823-MSG-AREA TO LCCM-MSG-AREA DTSCS26 +02575 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS26 +02576 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS26 +02577 GO TO MAINLINE-EXIT. DTSCS26 +02578 S823-EXIT. DTSCS26 +02579 EXIT. DTSCS26 +02580 DTSCS26 +02581 S826-WRITE-ATH. DTSCS26 +02582 MOVE LOW-VALUES TO AATH-REC. DTSCS26 +02583 DTSCS26 +02584 MOVE WRK-BATCH-NO TO AATH-BATCH-NO. DTSCS26 +02585 MOVE WRK-ITEM-NO TO AATH-ITEM-NO. DTSCS26 +02586 IF WRK-AATH-ACTION-DEL-88 DTSCS26 +02587 SET AATH-ADJ-88 TO TRUE DTSCS26 +02588 ELSE DTSCS26 +02589 MOVE AADJ-DATA-AREA TO AATH-DATA-AREA DTSCS26 +02590 END-IF. DTSCS26 +02591 MOVE LCCM-OP-ID TO AATH-OP-ID. DTSCS26 +02592 MOVE ZERO TO AATH-DATE DTSCS26 +02593 AATH-TIME. DTSCS26 +02594 MOVE WRK-AATH-ACTION TO AATH-ACTION. DTSCS26 02595 DTSCS26 -02596 DTSCS26 -02597 S899-ABEND. DTSCS26 -02598 EXEC CICS ABEND DTSCS26 -02599 ABCODE(WRK-ABEND-CD) DTSCS26 -02600 END-EXEC. DTSCS26 -02601 S899-EXIT. DTSCS26 -02602 EXIT. DTSCS26 -02603 DTSCS26 -02604 DTSCS26 -02605 DTSCS26 -02606 *SOUND-ALARM. DTSCS26 -02607 *****EXEC CICS DTSCS26 -02608 *********SEND DTSCS26 -02609 ************CONTROL DTSCS26 -02610 ************ALARM DTSCS26 -02611 *****END-EXEC. DTSCS26 -02612 *SOUND-EXIT. DTSCS26 -02613 *****EXIT. DTSCS26 -02614 /*****************************************************************DTSCS26 -02615 * EDIT THE INFORMATION ON THE SCREEN. *DTSCS26 -02616 ******************************************************************DTSCS26 -02617 DTSCS26 -02618 S1000-SCREEN-EDITS. DTSCS26 -02619 PERFORM S1001-INITIALIZE-WRK-AREA THRU S1001-EXIT. DTSCS26 +02596 EXEC CICS LINK DTSCS26 +02597 PROGRAM ('DTSCU826') DTSCS26 +02598 COMMAREA (L826-COMM-AREA) DTSCS26 +02599 END-EXEC. DTSCS26 +02600 DTSCS26 +02601 IF L826-FILE-CLOSED-88 DTSCS26 +02602 MOVE L826-MSG-AREA TO LCCM-MSG-AREA DTSCS26 +02603 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS26 +02604 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS26 +02605 GO TO MAINLINE-EXIT. DTSCS26 +02606 DTSCS26 +02607 S826-EXIT. DTSCS26 +02608 EXIT. DTSCS26 +02609 DTSCS26 +02610 DTSCS26 +02611 S851-SCREEN-PROCESSING. DTSCS26 +02612 EXEC CICS LINK DTSCS26 +02613 PROGRAM ('DTSCU851') DTSCS26 +02614 COMMAREA (L851-COMM-AREA) DTSCS26 +02615 END-EXEC. DTSCS26 +02616 S851-EXIT. DTSCS26 +02617 EXIT. DTSCS26 +02618 DTSCS26 +02619 DTSCS26 02620 DTSCS26 -02621 DTSCS26 -02622 PERFORM S1110-BATCH-NO THRU S1110-EXIT. DTSCS26 -02623 DTSCS26 -02624 *****PERFORM S1120-ITEM-NO THRU S1120-EXIT. DTSCS26 -02625 DTSCS26 -02626 PERFORM S1200-ADJ-TYPE THRU S1200-EXIT. DTSCS26 +02621 S899-ABEND. DTSCS26 +02622 EXEC CICS ABEND DTSCS26 +02623 ABCODE(WRK-ABEND-CD) DTSCS26 +02624 END-EXEC. DTSCS26 +02625 S899-EXIT. DTSCS26 +02626 EXIT. DTSCS26 02627 DTSCS26 -02628 PERFORM S1220-COMPROMISE THRU S1220-EXIT. DTSCS26 +02628 DTSCS26 02629 DTSCS26 -02630 PERFORM S1300-NAME-CHECK THRU S1300-EXIT. DTSCS26 -02631 DTSCS26 -02632 PERFORM S1400-EMP-NO THRU S1400-EXIT. DTSCS26 -02633 DTSCS26 -02634 PERFORM S1500-AMT THRU S1500-EXIT. DTSCS26 -02635 DTSCS26 -02636 PERFORM S1600-APPLIC-YRQ THRU S1600-EXIT. DTSCS26 -02637 DTSCS26 -02638 PERFORM S1700-APPLIC-IND THRU S1700-EXIT. DTSCS26 -02639 DTSCS26 -02640 PERFORM S1800-BATCH-ITEM THRU S1800-EXIT. DTSCS26 +02630 *SOUND-ALARM. DTSCS26 +02631 *****EXEC CICS DTSCS26 +02632 *********SEND DTSCS26 +02633 ************CONTROL DTSCS26 +02634 ************ALARM DTSCS26 +02635 *****END-EXEC. DTSCS26 +02636 *SOUND-EXIT. DTSCS26 +02637 *****EXIT. DTSCS26 +02638 /*****************************************************************DTSCS26 +02639 * EDIT THE INFORMATION ON THE SCREEN. *DTSCS26 +02640 ******************************************************************DTSCS26 02641 DTSCS26 -02642 PERFORM S1900-DATE-1 THRU S1900-EXIT. DTSCS26 -02643 DTSCS26 -02644 PERFORM S2000-DATE-2 THRU S2000-EXIT. DTSCS26 +02642 S1000-SCREEN-EDITS. DTSCS26 +02643 PERFORM S1001-INITIALIZE-WRK-AREA THRU S1001-EXIT. DTSCS26 +02644 DTSCS26 02645 DTSCS26 -02646 PERFORM S2100-INT-SPAN THRU S2100-EXIT. DTSCS26 +02646 PERFORM S1110-BATCH-NO THRU S1110-EXIT. DTSCS26 02647 DTSCS26 -02648 PERFORM S2200-INT-RATE THRU S2200-EXIT. DTSCS26 +02648 *****PERFORM S1120-ITEM-NO THRU S1120-EXIT. DTSCS26 02649 DTSCS26 -02650 PERFORM S2300-RECEIVED-DATE THRU S2300-EXIT. DTSCS26 -02651 DTSCS26 -02652 PERFORM S2400-RESPONSIBLE-ACTIVITY THRU S2400-EXIT. DTSCS26 +02650 PERFORM S1150-EMP-NO THRU S1150-EXIT. CL**5 +02651 CL**5 +02652 PERFORM S1200-ADJ-TYPE THRU S1200-EXIT. DTSCS26 02653 DTSCS26 -02654 PERFORM S2500-RESPONSIBLE-OP-ID THRU S2500-EXIT. DTSCS26 +02654 PERFORM S1220-COMPROMISE THRU S1220-EXIT. DTSCS26 02655 DTSCS26 -02656 PERFORM S2600-ENTRY-MODE THRU S2600-EXIT. DTSCS26 +02656 PERFORM S1300-NAME-CHECK THRU S1300-EXIT. DTSCS26 02657 DTSCS26 -02658 PERFORM S2700-DISREGARD-EDITS-IND THRU S2700-EXIT. DTSCS26 -02659 DTSCS26 -02660 IF LCCM-MSG DTSCS26 -02661 GO TO S1000-EXIT. DTSCS26 +02658 DTSCS26 +02659 PERFORM S1500-AMT THRU S1500-EXIT. DTSCS26 +02660 DTSCS26 +02661 PERFORM S1600-APPLIC-YRQ THRU S1600-EXIT. DTSCS26 02662 DTSCS26 -02663 DTSCS26 -02664 PERFORM S4000-CROSS-EDITS THRU S4000-EXIT. DTSCS26 -02665 S1000-EXIT. DTSCS26 -02666 EXIT. DTSCS26 -02667 EJECT DTSCS26 -02668 S1001-INITIALIZE-WRK-AREA. DTSCS26 -02669 MOVE +0 TO WRK-APPLIC-YRQ. DTSCS26 +02663 PERFORM S1700-APPLIC-IND THRU S1700-EXIT. DTSCS26 +02664 DTSCS26 +02665 PERFORM S1800-BATCH-ITEM THRU S1800-EXIT. DTSCS26 +02666 DTSCS26 +02667 PERFORM S1900-DATE-1 THRU S1900-EXIT. DTSCS26 +02668 DTSCS26 +02669 PERFORM S2000-DATE-2 THRU S2000-EXIT. DTSCS26 02670 DTSCS26 -02671 MOVE SPACES TO WRK-APPLIC-IND. DTSCS26 +02671 PERFORM S2100-INT-SPAN THRU S2100-EXIT. DTSCS26 02672 DTSCS26 -02673 MOVE NULL-DOC-NO TO WRK-APPLIC-DOC-NO. DTSCS26 +02673 PERFORM S2200-INT-RATE THRU S2200-EXIT. DTSCS26 02674 DTSCS26 -02675 SET WRK-AMT-INVALID-88 TO TRUE. DTSCS26 +02675 PERFORM S2300-RECEIVED-DATE THRU S2300-EXIT. DTSCS26 02676 DTSCS26 -02677 SET WRK-INT-NO-ENTRY-88 TO TRUE. DTSCS26 +02677 PERFORM S2400-RESPONSIBLE-ACTIVITY THRU S2400-EXIT. DTSCS26 02678 DTSCS26 -02679 MOVE +0 TO WRK-RECEIVED-DATE DTSCS26 -02680 WRK-DATE-1 DTSCS26 -02681 WRK-DATE-2. DTSCS26 -02682 S1001-EXIT. DTSCS26 -02683 EXIT. DTSCS26 +02679 PERFORM S2500-RESPONSIBLE-OP-ID THRU S2500-EXIT. DTSCS26 +02680 DTSCS26 +02681 PERFORM S2600-ENTRY-MODE THRU S2600-EXIT. DTSCS26 +02682 DTSCS26 +02683 PERFORM S2700-DISREGARD-EDITS-IND THRU S2700-EXIT. DTSCS26 02684 DTSCS26 -02685 DTSCS26 -02686 DTSCS26 -02687 S1100-EDIT-KEY. DTSCS26 -02688 PERFORM S1110-BATCH-NO THRU S1110-EXIT. DTSCS26 -02689 S1100-EXIT. DTSCS26 -02690 EXIT. DTSCS26 -02691 /*****************************************************************DTSCS26 -02692 * DTSCS26 -02693 ******************************************************************DTSCS26 -02694 S1110-BATCH-NO. DTSCS26 -02695 MOVE MAP-DOC-NO-AREA TO L019-S-DOC-NO. DTSCS26 -02696 DTSCS26 -02697 PERFORM S019-BATCH-NO-FROM-SCREEN THRU S019-EXIT. DTSCS26 -02698 DTSCS26 -02699 IF L019-NO-ENTRY DTSCS26 -02700 ********IF LCCM-ENTER-88 DTSCS26 -02701 ***********GO TO S1110-EXIT DTSCS26 -02702 ********ELSE DTSCS26 -02703 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS26 -02704 PERFORM S1111-ERROR THRU S1111-EXIT DTSCS26 -02705 GO TO S1110-EXIT. DTSCS26 -02706 DTSCS26 -02707 IF L019-NOT-VALID DTSCS26 -02708 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS26 -02709 PERFORM S1111-ERROR THRU S1111-EXIT DTSCS26 -02710 GO TO S1110-EXIT. DTSCS26 +02685 IF LCCM-MSG DTSCS26 +02686 GO TO S1000-EXIT. DTSCS26 +02687 DTSCS26 +02688 DTSCS26 +02689 PERFORM S4000-CROSS-EDITS THRU S4000-EXIT. DTSCS26 +02690 S1000-EXIT. DTSCS26 +02691 EXIT. DTSCS26 +02692 EJECT DTSCS26 +02693 S1001-INITIALIZE-WRK-AREA. DTSCS26 +02694 MOVE +0 TO WRK-APPLIC-YRQ. DTSCS26 +02695 DTSCS26 +02696 MOVE SPACES TO WRK-APPLIC-IND. DTSCS26 +02697 DTSCS26 +02698 MOVE NULL-DOC-NO TO WRK-APPLIC-DOC-NO. DTSCS26 +02699 DTSCS26 +02700 SET WRK-AMT-INVALID-88 TO TRUE. DTSCS26 +02701 DTSCS26 +02702 SET WRK-INT-NO-ENTRY-88 TO TRUE. DTSCS26 +02703 DTSCS26 +02704 MOVE +0 TO WRK-RECEIVED-DATE DTSCS26 +02705 WRK-DATE-1 DTSCS26 +02706 WRK-DATE-2. DTSCS26 +02707 S1001-EXIT. DTSCS26 +02708 EXIT. DTSCS26 +02709 DTSCS26 +02710 DTSCS26 02711 DTSCS26 -02712 MOVE L019-BATCH-NO TO WRK-BATCH-NO. DTSCS26 -02713 DTSCS26 -02714 MOVE L019-ITEM-NO TO WRK-ITEM-NO. DTSCS26 -02715 S1110-EXIT. DTSCS26 -02716 EXIT. DTSCS26 -02717 DTSCS26 -02718 DTSCS26 -02719 DTSCS26 -02720 S1111-ERROR. DTSCS26 -02721 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-BATCH-NO-A. DTSCS26 -02722 DTSCS26 -02723 IF LCCM-NO-MSG DTSCS26 -02724 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS26 -02725 MOVE CATB-CURSOR TO MAP-BATCH-NO-L DTSCS26 -02726 SET CURSOR-SET-YES TO TRUE. DTSCS26 -02727 S1111-EXIT. DTSCS26 -02728 EXIT. DTSCS26 -02729 DTSCS26 -02730 DTSCS26 +02712 S1100-EDIT-KEY. DTSCS26 +02713 PERFORM S1110-BATCH-NO THRU S1110-EXIT. DTSCS26 +02714 S1100-EXIT. DTSCS26 +02715 EXIT. DTSCS26 +02716 /*****************************************************************DTSCS26 +02717 * DTSCS26 +02718 ******************************************************************DTSCS26 +02719 S1110-BATCH-NO. DTSCS26 +02720 MOVE MAP-DOC-NO-AREA TO L019-S-DOC-NO. DTSCS26 +02721 DTSCS26 +02722 PERFORM S019-BATCH-NO-FROM-SCREEN THRU S019-EXIT. DTSCS26 +02723 DTSCS26 +02724 IF L019-NO-ENTRY DTSCS26 +02725 ********IF LCCM-ENTER-88 DTSCS26 +02726 ***********GO TO S1110-EXIT DTSCS26 +02727 ********ELSE DTSCS26 +02728 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS26 +02729 PERFORM S1111-ERROR THRU S1111-EXIT DTSCS26 +02730 GO TO S1110-EXIT. DTSCS26 02731 DTSCS26 -02732 S1112-ERROR. DTSCS26 -02733 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-ITEM-NO-A. DTSCS26 -02734 DTSCS26 -02735 IF LCCM-NO-MSG DTSCS26 -02736 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS26 -02737 MOVE CATB-CURSOR TO MAP-ITEM-NO-L DTSCS26 -02738 SET CURSOR-SET-YES TO TRUE. DTSCS26 -02739 S1112-EXIT. DTSCS26 -02740 EXIT. DTSCS26 -02741 DTSCS26 +02732 IF L019-NOT-VALID DTSCS26 +02733 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS26 +02734 PERFORM S1111-ERROR THRU S1111-EXIT DTSCS26 +02735 GO TO S1110-EXIT. DTSCS26 +02736 DTSCS26 +02737 MOVE L019-BATCH-NO TO WRK-BATCH-NO. DTSCS26 +02738 DTSCS26 +02739 MOVE L019-ITEM-NO TO WRK-ITEM-NO. DTSCS26 +02740 S1110-EXIT. DTSCS26 +02741 EXIT. DTSCS26 02742 DTSCS26 02743 DTSCS26 -02744 *S1120-ITEM-NO. DTSCS26 -02745 *****IF LCCM-ENTER-88 DTSCS26 -02746 ********IF MAP-ITEM-NO = SPACES OR LOW-VALUES DTSCS26 -02747 ************NEXT SENTENCE DTSCS26 -02748 ********ELSE DTSCS26 -02749 ************MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS26 -02750 ************PERFORM S1112-ERROR THRU S1112-EXIT. DTSCS26 -02751 *S1120-EXIT. DTSCS26 -02752 *****EXIT. DTSCS26 -02753 /*****************************************************************DTSCS26 -02754 * DTSCS26 -02755 ******************************************************************DTSCS26 -02756 S1200-ADJ-TYPE. DTSCS26 -02757 INSPECT MAP-ADJ-TYPE DTSCS26 -02758 CONVERTING LOW-VALUES TO SPACES. DTSCS26 +02744 DTSCS26 +02745 S1111-ERROR. DTSCS26 +02746 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-BATCH-NO-A. DTSCS26 +02747 DTSCS26 +02748 IF LCCM-NO-MSG DTSCS26 +02749 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS26 +02750 MOVE CATB-CURSOR TO MAP-BATCH-NO-L DTSCS26 +02751 SET CURSOR-SET-YES TO TRUE. DTSCS26 +02752 S1111-EXIT. DTSCS26 +02753 EXIT. DTSCS26 +02754 DTSCS26 +02755 DTSCS26 +02756 DTSCS26 +02757 S1112-ERROR. DTSCS26 +02758 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-ITEM-NO-A. DTSCS26 02759 DTSCS26 -02760 MOVE SPACES TO AADJ-ADJ-TYPE. DTSCS26 -02761 DTSCS26 -02762 IF MAP-ADJ-TYPE = SPACES DTSCS26 -02763 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 -02764 MOVE 'RPT/PAY/ADJ TYPE' TO WRK-MSG-TEXT DTSCS26 -02765 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS26 -02766 GO TO S1200-EXIT. DTSCS26 +02760 IF LCCM-NO-MSG DTSCS26 +02761 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS26 +02762 MOVE CATB-CURSOR TO MAP-ITEM-NO-L DTSCS26 +02763 SET CURSOR-SET-YES TO TRUE. DTSCS26 +02764 S1112-EXIT. DTSCS26 +02765 EXIT. DTSCS26 +02766 DTSCS26 02767 DTSCS26 -02768 MOVE MAP-ADJ-TYPE TO L032-CD-2. DTSCS26 -02769 DTSCS26 -02770 PERFORM S032-AADJ-ADJ-TYPE THRU S032-EXIT. DTSCS26 -02771 DTSCS26 -02772 IF L032-VALID DTSCS26 -02773 MOVE MAP-ADJ-TYPE TO AADJ-ADJ-TYPE DTSCS26 -02774 IF AADJ-WRITE-OFF-88 DTSCS26 -02775 OR AADJ-WRITE-OFF-REV-88 DTSCS26 -02776 IF SCR-ACCESS-SUPERVISOR DTSCS26 -02777 GO TO S1200-EXIT DTSCS26 -02778 ELSE DTSCS26 -02779 MOVE 'NOT AUTHORIZED FOR WRITE OFF' TO WRK-MSG-TEXT DTSCS26 -02780 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS26 -02781 GO TO S1200-EXIT DTSCS26 -02782 END-IF DTSCS26 -02783 ELSE DTSCS26 -02784 GO TO S1200-EXIT DTSCS26 -02785 END-IF. DTSCS26 -02786 DTSCS26 -02787 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER. DTSCS26 -02788 DTSCS26 -02789 MOVE 'RPT/PAY/ADJ TYPE' TO WRK-MSG-TEXT. DTSCS26 -02790 DTSCS26 -02791 PERFORM S1201-ERROR THRU S1201-EXIT. DTSCS26 -02792 S1200-EXIT. DTSCS26 -02793 EXIT. DTSCS26 -02794 DTSCS26 -02795 DTSCS26 -02796 DTSCS26 -02797 S1201-ERROR. DTSCS26 -02798 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ADJ-TYPE-A. DTSCS26 -02799 DTSCS26 -02800 IF LCCM-NO-MSG DTSCS26 -02801 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS26 -02802 MOVE CATB-CURSOR TO MAP-ADJ-TYPE-L DTSCS26 -02803 SET CURSOR-SET-YES TO TRUE. DTSCS26 -02804 S1201-EXIT. DTSCS26 -02805 EXIT. DTSCS26 -02806 DTSCS26 -02807 S1220-COMPROMISE. DTSCS26 -02808 IF LCCM-OP-IS-FLD-DESK-88 DTSCS26 -02809 OR LCCM-OP-IS-ACCOUNTING-DESK-88 DTSCS26 -02810 NEXT SENTENCE DTSCS26 -02811 ELSE DTSCS26 -02812 SET MAP-CMPRMISE-NO-88 TO TRUE DTSCS26 -02813 GO TO S1220-EXIT DTSCS26 -02814 END-IF. DTSCS26 -02815 DTSCS26 -02816 INSPECT MAP-CMPRMISE-IND DTSCS26 -02817 CONVERTING LOW-VALUES TO SPACES. DTSCS26 -02818 DTSCS26 -02819 IF MAP-CMPRMISE-IND = SPACES DTSCS26 -02820 SET MAP-CMPRMISE-NO-88 TO TRUE DTSCS26 -02821 ELSE DTSCS26 -02822 IF MAP-CMPRMISE-VALID-88 DTSCS26 -02823 NEXT SENTENCE DTSCS26 -02824 ELSE DTSCS26 -02825 MOVE MSG-E26E-AREA TO WRK-MSG-AREA DTSCS26 -02826 PERFORM S1221-ERROR THRU S1221-EXIT DTSCS26 -02827 END-IF DTSCS26 -02828 END-IF. DTSCS26 -02829 DTSCS26 -02830 S1220-EXIT. DTSCS26 -02831 EXIT. DTSCS26 -02832 DTSCS26 -02833 S1221-ERROR. DTSCS26 -02834 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-CMPRMISE-IND-A. DTSCS26 -02835 DTSCS26 -02836 IF LCCM-NO-MSG DTSCS26 -02837 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS26 -02838 MOVE CATB-CURSOR TO MAP-CMPRMISE-IND-L DTSCS26 -02839 SET CURSOR-SET-YES TO TRUE. DTSCS26 -02840 S1221-EXIT. DTSCS26 -02841 EXIT. DTSCS26 -02842 DTSCS26 -02843 /*****************************************************************DTSCS26 -02844 * DTSCS26 -02845 ******************************************************************DTSCS26 -02846 S1300-NAME-CHECK. DTSCS26 -02847 IF MAP-NAME-CHECK = LOW-VALUES OR SPACES DTSCS26 -02848 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 -02849 MOVE 'NAME' TO WRK-MSG-TEXT DTSCS26 -02850 PERFORM S1301-ERROR THRU S1301-EXIT DTSCS26 -02851 ELSE DTSCS26 -02852 NEXT SENTENCE. DTSCS26 -02853 S1300-EXIT. DTSCS26 -02854 EXIT. DTSCS26 -02855 DTSCS26 -02856 DTSCS26 +02768 DTSCS26 +02769 *S1120-ITEM-NO. DTSCS26 +02770 *****IF LCCM-ENTER-88 DTSCS26 +02771 ********IF MAP-ITEM-NO = SPACES OR LOW-VALUES DTSCS26 +02772 ************NEXT SENTENCE DTSCS26 +02773 ********ELSE DTSCS26 +02774 ************MOVE EMSG-FIELD-NOT-ALLOWED TO WRK-MSG-AREA DTSCS26 +02775 ************PERFORM S1112-ERROR THRU S1112-EXIT. DTSCS26 +02776 *S1120-EXIT. DTSCS26 +02777 *****EXIT. DTSCS26 +02778 S1150-EMP-NO. CL**5 +02779 SET WRK-PENDING-MCMP-NO-88 TO TRUE. CL**5 +02780 CL**5 +02781 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. CL**5 +02782 CL**5 +02783 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. CL**5 +02784 CL**5 +02785 IF L018-NO-ENTRY CL**5 +02786 OR L018-NOT-VALID CL**5 +02787 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER CL**5 +02788 MOVE 'EMP NO' TO WRK-MSG-TEXT CL**5 +02789 PERFORM S1401-ERROR THRU S1401-EXIT CL**5 +02790 GO TO S1150-EXIT. CL**5 +02791 CL**5 +02792 MOVE L018-EMP-NO TO WRK-EMP-NO. CL**5 +02793 CL**5 +02794 PERFORM S1410-READ-MPRF THRU S1410-EXIT. CL**5 +02795 CL**5 +02796 IF MAP-CMPRMISE-YES-88 CL**5 +02797 PERFORM S1420-FIND-MCMP THRU S1420-EXIT CL**5 +02798 END-IF. CL**5 +02799 CL**5 +02800 S1150-EXIT. CL**5 +02801 EXIT. CL**5 +02802 CL**5 +02803 /*****************************************************************DTSCS26 +02804 * DTSCS26 +02805 ******************************************************************DTSCS26 +02806 S1200-ADJ-TYPE. DTSCS26 +02807 INSPECT MAP-ADJ-TYPE DTSCS26 +02808 CONVERTING LOW-VALUES TO SPACES. DTSCS26 +02809 DTSCS26 +02810 MOVE SPACES TO AADJ-ADJ-TYPE. DTSCS26 +02811 DTSCS26 +02812 IF MAP-ADJ-TYPE = SPACES DTSCS26 +02813 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 +02814 MOVE 'RPT/PAY/ADJ TYPE' TO WRK-MSG-TEXT DTSCS26 +02815 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS26 +02816 GO TO S1200-EXIT. DTSCS26 +02817 DTSCS26 +02818 MOVE MAP-ADJ-TYPE TO L032-CD-2. DTSCS26 +02819 DTSCS26 +02820 PERFORM S032-AADJ-ADJ-TYPE THRU S032-EXIT. DTSCS26 +02821 DTSCS26 +02822 IF L032-VALID DTSCS26 +02823 MOVE MAP-ADJ-TYPE TO AADJ-ADJ-TYPE DTSCS26 +02824 IF AADJ-WRITE-OFF-88 CL**3 +02825 OR AADJ-WRITE-OFF-REV-88 CL**3 +02826 PERFORM S2111-WRITE-OFF THRU S2111-EXIT CL**4 +02827 IF L084-VALID-APPROVAL-88 CL**3 +02828 GO TO S1200-EXIT DTSCS26 +02829 ELSE DTSCS26 +02830 MOVE 'SUPERVISOR APPROVAL NEEDED ' TO WRK-MSG-TEXT CL**7 +02831 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS26 +02832 GO TO S1200-EXIT DTSCS26 +02833 END-IF DTSCS26 +02834 ELSE DTSCS26 +02835 GO TO S1200-EXIT DTSCS26 +02836 END-IF. DTSCS26 +02837 DTSCS26 +02838 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER. DTSCS26 +02839 DTSCS26 +02840 MOVE 'RPT/PAY/ADJ TYPE' TO WRK-MSG-TEXT. DTSCS26 +02841 DTSCS26 +02842 PERFORM S1201-ERROR THRU S1201-EXIT. DTSCS26 +02843 S1200-EXIT. DTSCS26 +02844 EXIT. DTSCS26 +02845 DTSCS26 +02846 DTSCS26 +02847 DTSCS26 +02848 S1201-ERROR. DTSCS26 +02849 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-ADJ-TYPE-A. DTSCS26 +02850 DTSCS26 +02851 IF LCCM-NO-MSG DTSCS26 +02852 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS26 +02853 MOVE CATB-CURSOR TO MAP-ADJ-TYPE-L DTSCS26 +02854 SET CURSOR-SET-YES TO TRUE. DTSCS26 +02855 S1201-EXIT. DTSCS26 +02856 EXIT. DTSCS26 02857 DTSCS26 -02858 S1301-ERROR. DTSCS26 -02859 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-NAME-CHECK-A. DTSCS26 -02860 DTSCS26 -02861 IF LCCM-NO-MSG DTSCS26 -02862 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS26 -02863 MOVE CATB-CURSOR TO MAP-NAME-CHECK-L DTSCS26 -02864 SET CURSOR-SET-YES TO TRUE. DTSCS26 -02865 S1301-EXIT. DTSCS26 -02866 EXIT. DTSCS26 -02867 /*****************************************************************DTSCS26 -02868 * DTSCS26 -02869 ******************************************************************DTSCS26 -02870 S1400-EMP-NO. DTSCS26 -02871 SET WRK-PENDING-MCMP-NO-88 TO TRUE. DTSCS26 -02872 DTSCS26 -02873 MOVE MAP-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS26 -02874 DTSCS26 -02875 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS26 -02876 DTSCS26 -02877 IF L018-NO-ENTRY DTSCS26 -02878 OR L018-NOT-VALID DTSCS26 -02879 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 -02880 MOVE 'EMP NO' TO WRK-MSG-TEXT DTSCS26 -02881 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS26 -02882 GO TO S1400-EXIT. DTSCS26 +02858 S1220-COMPROMISE. DTSCS26 +02859 IF LCCM-OP-IS-FLD-DESK-88 DTSCS26 +02860 OR LCCM-OP-IS-ACCOUNTING-DESK-88 DTSCS26 +02861 NEXT SENTENCE DTSCS26 +02862 ELSE DTSCS26 +02863 SET MAP-CMPRMISE-NO-88 TO TRUE DTSCS26 +02864 GO TO S1220-EXIT DTSCS26 +02865 END-IF. DTSCS26 +02866 DTSCS26 +02867 INSPECT MAP-CMPRMISE-IND DTSCS26 +02868 CONVERTING LOW-VALUES TO SPACES. DTSCS26 +02869 DTSCS26 +02870 IF MAP-CMPRMISE-IND = SPACES DTSCS26 +02871 SET MAP-CMPRMISE-NO-88 TO TRUE DTSCS26 +02872 ELSE DTSCS26 +02873 IF MAP-CMPRMISE-VALID-88 DTSCS26 +02874 NEXT SENTENCE DTSCS26 +02875 ELSE DTSCS26 +02876 MOVE MSG-E26E-AREA TO WRK-MSG-AREA DTSCS26 +02877 PERFORM S1221-ERROR THRU S1221-EXIT DTSCS26 +02878 END-IF DTSCS26 +02879 END-IF. DTSCS26 +02880 DTSCS26 +02881 S1220-EXIT. DTSCS26 +02882 EXIT. DTSCS26 02883 DTSCS26 -02884 MOVE L018-EMP-NO TO WRK-EMP-NO. DTSCS26 -02885 DTSCS26 -02886 PERFORM S1410-READ-MPRF THRU S1410-EXIT. DTSCS26 -02887 DTSCS26 -02888 IF MAP-CMPRMISE-YES-88 DTSCS26 -02889 PERFORM S1420-FIND-MCMP THRU S1420-EXIT DTSCS26 -02890 END-IF. DTSCS26 -02891 DTSCS26 -02892 S1400-EXIT. DTSCS26 -02893 EXIT. DTSCS26 -02894 DTSCS26 -02895 DTSCS26 -02896 DTSCS26 -02897 S1401-ERROR. DTSCS26 -02898 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-EMP-NO-1-A DTSCS26 -02899 MAP-EMP-NO-2-A. DTSCS26 -02900 DTSCS26 -02901 IF LCCM-NO-MSG DTSCS26 -02902 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS26 -02903 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L DTSCS26 -02904 SET CURSOR-SET-YES TO TRUE. DTSCS26 -02905 S1401-EXIT. DTSCS26 -02906 EXIT. DTSCS26 +02884 S1221-ERROR. DTSCS26 +02885 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-CMPRMISE-IND-A. DTSCS26 +02886 DTSCS26 +02887 IF LCCM-NO-MSG DTSCS26 +02888 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS26 +02889 MOVE CATB-CURSOR TO MAP-CMPRMISE-IND-L DTSCS26 +02890 SET CURSOR-SET-YES TO TRUE. DTSCS26 +02891 S1221-EXIT. DTSCS26 +02892 EXIT. DTSCS26 +02893 DTSCS26 +02894 /*****************************************************************DTSCS26 +02895 * DTSCS26 +02896 ******************************************************************DTSCS26 +02897 S1300-NAME-CHECK. DTSCS26 +02898 IF MAP-NAME-CHECK = LOW-VALUES OR SPACES DTSCS26 +02899 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 +02900 MOVE 'NAME' TO WRK-MSG-TEXT DTSCS26 +02901 PERFORM S1301-ERROR THRU S1301-EXIT DTSCS26 +02902 ELSE DTSCS26 +02903 NEXT SENTENCE. DTSCS26 +02904 S1300-EXIT. DTSCS26 +02905 EXIT. DTSCS26 +02906 DTSCS26 02907 DTSCS26 02908 DTSCS26 -02909 DTSCS26 -02910 S1410-READ-MPRF. DTSCS26 -02911 MOVE LOW-VALUES TO MPRF-KEY-AREA. DTSCS26 -02912 DTSCS26 -02913 MOVE WRK-EMP-NO TO MPRF-EMP-NO. DTSCS26 -02914 DTSCS26 -02915 SET MPRF-PRF-88 TO TRUE. DTSCS26 -02916 DTSCS26 -02917 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSCS26 -02918 DTSCS26 -02919 PERFORM S810-READ THRU S810-EXIT. DTSCS26 -02920 DTSCS26 -02921 IF L810-NO-REC-88 DTSCS26 -02922 MOVE EMSG-NO-EMPLOYER TO WRK-MSG-AREA DTSCS26 -02923 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS26 -02924 GO TO S1410-EXIT. DTSCS26 -02925 DTSCS26 -02926 MOVE MSKL-REC TO MPRF-REC. DTSCS26 -02927 DTSCS26 -02928 MOVE WRK-EMP-NO TO LCCM-EMP-NO. DTSCS26 -02929 DTSCS26 -02930 IF MPRF-PURGE-ALL-YES-88 DTSCS26 -02931 MOVE EMSG-EMP-MARKED-FOR-PURGE TO WRK-MSG-AREA DTSCS26 -02932 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS26 -02933 GO TO S1410-EXIT. DTSCS26 +02909 S1301-ERROR. DTSCS26 +02910 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-NAME-CHECK-A. DTSCS26 +02911 DTSCS26 +02912 IF LCCM-NO-MSG DTSCS26 +02913 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS26 +02914 MOVE CATB-CURSOR TO MAP-NAME-CHECK-L DTSCS26 +02915 SET CURSOR-SET-YES TO TRUE. DTSCS26 +02916 S1301-EXIT. DTSCS26 +02917 EXIT. DTSCS26 +02918 /*****************************************************************DTSCS26 +02919 * DTSCS26 +02920 ******************************************************************DTSCS26 +02921 CL**5 +02922 CL**5 +02923 S1401-ERROR. CL**5 +02924 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-EMP-NO-1-A CL**5 +02925 MAP-EMP-NO-2-A. CL**5 +02926 CL**5 +02927 IF LCCM-NO-MSG CL**5 +02928 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA CL**5 +02929 MOVE CATB-CURSOR TO MAP-EMP-NO-1-L CL**5 +02930 SET CURSOR-SET-YES TO TRUE. CL**5 +02931 S1401-EXIT. CL**5 +02932 EXIT. CL**5 +02933 CL**5 02934 DTSCS26 -02935 IF MAP-NAME-CHECK = LOW-VALUES OR SPACES DTSCS26 -02936 NEXT SENTENCE DTSCS26 -02937 ELSE DTSCS26 -02938 IF (MPRF-PRIMARY-NAME (1:4) = MAP-NAME-CHECK) DTSCS26 -02939 OR DTSCS26 -02940 (MPRF-ENTITY-NAME (1:4) = MAP-NAME-CHECK) DTSCS26 -02941 NEXT SENTENCE DTSCS26 -02942 ELSE DTSCS26 -02943 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 -02944 MOVE 'NAME' TO WRK-MSG-TEXT DTSCS26 -02945 PERFORM S1301-ERROR THRU S1301-EXIT DTSCS26 -02946 PERFORM S1401-ERROR THRU S1401-EXIT. DTSCS26 -02947 S1410-EXIT. DTSCS26 -02948 EXIT. DTSCS26 -02949 DTSCS26 -02950 S1420-FIND-MCMP. DTSCS26 -02951 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSCS26 -02952 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCS26 -02953 SET MSKL-CMP-88 TO TRUE. DTSCS26 -02954 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS26 -02955 IF L810-NO-REC-88 DTSCS26 -02956 MOVE MSG-E26F-AREA TO WRK-MSG-AREA DTSCS26 -02957 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS26 -02958 ELSE DTSCS26 -02959 PERFORM DTSCS26 -02960 UNTIL L810-NO-REC-88 DTSCS26 -02961 OR WRK-PENDING-MCMP-YES-88 DTSCS26 -02962 MOVE MSKL-REC TO MCMP-REC DTSCS26 -02963 IF MCMP-STATUS-PENDING-88 DTSCS26 -02964 SET WRK-PENDING-MCMP-YES-88 TO TRUE DTSCS26 -02965 ELSE DTSCS26 -02966 PERFORM S810-READ-NEXT THRU S810-EXIT DTSCS26 -02967 END-IF DTSCS26 -02968 END-PERFORM DTSCS26 -02969 IF WRK-PENDING-MCMP-NO-88 DTSCS26 -02970 MOVE MSG-E26F-AREA TO WRK-MSG-AREA DTSCS26 -02971 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS26 -02972 END-IF DTSCS26 -02973 END-IF. DTSCS26 -02974 DTSCS26 -02975 S1420-EXIT. DTSCS26 -02976 EXIT. DTSCS26 -02977 DTSCS26 -02978 /*****************************************************************DTSCS26 -02979 * DTSCS26 -02980 ******************************************************************DTSCS26 -02981 S1500-AMT. DTSCS26 -02982 MOVE MAP-AMT-AREA TO L011-S-AMT-AREA DTSCS26 -02983 DTSCS26 -02984 PERFORM S011-AMT-FROM-SCREEN THRU S011-EXIT. DTSCS26 -02985 DTSCS26 -02986 IF L011-NO-ENTRY DTSCS26 -02987 MOVE +0 TO WRK-AMT DTSCS26 -02988 MAP-AMT-N DTSCS26 -02989 ELSE DTSCS26 -02990 IF L011-EXCEEDS-MIN-MAX DTSCS26 -02991 OR L011-NOT-VALID DTSCS26 -02992 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 -02993 MOVE 'REMIT/CHECK/ADJ AMT' TO WRK-MSG-TEXT DTSCS26 -02994 PERFORM S1501-ERROR THRU S1501-EXIT DTSCS26 -02995 GO TO S1500-EXIT DTSCS26 -02996 ELSE DTSCS26 -02997 MOVE L011-AMT TO MAP-AMT-N DTSCS26 -02998 WRK-AMT. DTSCS26 -02999 DTSCS26 -03000 PERFORM S1510-AMT-ADJ-TYPE-EDITS THRU S1510-EXIT. DTSCS26 -03001 S1500-EXIT. DTSCS26 +02935 DTSCS26 +02936 S1410-READ-MPRF. DTSCS26 +02937 MOVE LOW-VALUES TO MPRF-KEY-AREA. DTSCS26 +02938 DTSCS26 +02939 MOVE WRK-EMP-NO TO MPRF-EMP-NO. DTSCS26 +02940 DTSCS26 +02941 SET MPRF-PRF-88 TO TRUE. DTSCS26 +02942 DTSCS26 +02943 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSCS26 +02944 DTSCS26 +02945 PERFORM S810-READ THRU S810-EXIT. DTSCS26 +02946 DTSCS26 +02947 IF L810-NO-REC-88 DTSCS26 +02948 MOVE EMSG-NO-EMPLOYER TO WRK-MSG-AREA DTSCS26 +02949 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS26 +02950 GO TO S1410-EXIT. DTSCS26 +02951 DTSCS26 +02952 MOVE MSKL-REC TO MPRF-REC. DTSCS26 +02953 DTSCS26 +02954 MOVE WRK-EMP-NO TO LCCM-EMP-NO. DTSCS26 +02955 DTSCS26 +02956 IF MPRF-PURGE-ALL-YES-88 DTSCS26 +02957 MOVE EMSG-EMP-MARKED-FOR-PURGE TO WRK-MSG-AREA DTSCS26 +02958 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS26 +02959 GO TO S1410-EXIT. DTSCS26 +02960 DTSCS26 +02961 IF MAP-NAME-CHECK = LOW-VALUES OR SPACES DTSCS26 +02962 NEXT SENTENCE DTSCS26 +02963 ELSE DTSCS26 +02964 IF (MPRF-PRIMARY-NAME (1:4) = MAP-NAME-CHECK) DTSCS26 +02965 OR DTSCS26 +02966 (MPRF-ENTITY-NAME (1:4) = MAP-NAME-CHECK) DTSCS26 +02967 NEXT SENTENCE DTSCS26 +02968 ELSE DTSCS26 +02969 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 +02970 MOVE 'NAME' TO WRK-MSG-TEXT DTSCS26 +02971 PERFORM S1301-ERROR THRU S1301-EXIT DTSCS26 +02972 PERFORM S1401-ERROR THRU S1401-EXIT. DTSCS26 +02973 S1410-EXIT. DTSCS26 +02974 EXIT. DTSCS26 +02975 DTSCS26 +02976 S1420-FIND-MCMP. DTSCS26 +02977 MOVE LOW-VALUES TO MSKL-KEY-AREA. DTSCS26 +02978 MOVE WRK-EMP-NO TO MSKL-EMP-NO. DTSCS26 +02979 SET MSKL-CMP-88 TO TRUE. DTSCS26 +02980 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS26 +02981 IF L810-NO-REC-88 DTSCS26 +02982 MOVE MSG-E26F-AREA TO WRK-MSG-AREA DTSCS26 +02983 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS26 +02984 ELSE DTSCS26 +02985 PERFORM DTSCS26 +02986 UNTIL L810-NO-REC-88 DTSCS26 +02987 OR WRK-PENDING-MCMP-YES-88 DTSCS26 +02988 MOVE MSKL-REC TO MCMP-REC DTSCS26 +02989 IF MCMP-STATUS-PENDING-88 DTSCS26 +02990 SET WRK-PENDING-MCMP-YES-88 TO TRUE DTSCS26 +02991 ELSE DTSCS26 +02992 PERFORM S810-READ-NEXT THRU S810-EXIT DTSCS26 +02993 END-IF DTSCS26 +02994 END-PERFORM DTSCS26 +02995 IF WRK-PENDING-MCMP-NO-88 DTSCS26 +02996 MOVE MSG-E26F-AREA TO WRK-MSG-AREA DTSCS26 +02997 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS26 +02998 END-IF DTSCS26 +02999 END-IF. DTSCS26 +03000 DTSCS26 +03001 S1420-EXIT. DTSCS26 03002 EXIT. DTSCS26 03003 DTSCS26 -03004 DTSCS26 -03005 DTSCS26 -03006 S1501-ERROR. DTSCS26 -03007 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-AMT-A. DTSCS26 -03008 DTSCS26 -03009 IF LCCM-NO-MSG DTSCS26 -03010 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS26 -03011 MOVE CATB-CURSOR TO MAP-AMT-L DTSCS26 -03012 SET CURSOR-SET-YES TO TRUE. DTSCS26 -03013 S1501-EXIT. DTSCS26 -03014 EXIT. DTSCS26 -03015 DTSCS26 -03016 DTSCS26 -03017 DTSCS26 -03018 S1510-AMT-ADJ-TYPE-EDITS. DTSCS26 -03019 IF AADJ-ADJ-TYPE = SPACES DTSCS26 -03020 GO TO S1510-EXIT. DTSCS26 -03021 DTSCS26 -03022 IF AADJ-CHARGE-88 OR AADJ-WAIVE-88 OR AADJ-TOLER-88 DTSCS26 -03023 IF WRK-AMT = +0 DTSCS26 -03024 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 -03025 MOVE 'REMIT/ADJ AMT}{RPT/PAY/ADJ TYPE' DTSCS26 -03026 TO WRK-MSG-TEXT DTSCS26 -03027 PERFORM S1501-ERROR THRU S1501-EXIT DTSCS26 -03028 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS26 -03029 ELSE DTSCS26 -03030 NEXT SENTENCE DTSCS26 -03031 ELSE DTSCS26 -03032 IF WRK-AMT = +0 DTSCS26 -03033 NEXT SENTENCE DTSCS26 -03034 ELSE DTSCS26 -03035 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 -03036 MOVE 'REMIT/ADJ AMT}{RPT/PAY/ADJ TYPE' DTSCS26 -03037 TO WRK-MSG-TEXT DTSCS26 -03038 PERFORM S1501-ERROR THRU S1501-EXIT DTSCS26 -03039 PERFORM S1201-ERROR THRU S1201-EXIT. DTSCS26 -03040 S1510-EXIT. DTSCS26 -03041 EXIT. DTSCS26 -03042 /*****************************************************************DTSCS26 -03043 * DTSCS26 -03044 ******************************************************************DTSCS26 -03045 S1600-APPLIC-YRQ. DTSCS26 -03046 MOVE MAP-APPLIC-YRQ-AREA TO L029-S-YRQ-AREA. DTSCS26 +03004 /*****************************************************************DTSCS26 +03005 * DTSCS26 +03006 ******************************************************************DTSCS26 +03007 S1500-AMT. DTSCS26 +03008 MOVE MAP-AMT-AREA TO L011-S-AMT-AREA DTSCS26 +03009 DTSCS26 +03010 PERFORM S011-AMT-FROM-SCREEN THRU S011-EXIT. DTSCS26 +03011 DTSCS26 +03012 IF L011-NO-ENTRY DTSCS26 +03013 MOVE +0 TO WRK-AMT DTSCS26 +03014 MAP-AMT-N DTSCS26 +03015 ELSE DTSCS26 +03016 IF L011-EXCEEDS-MIN-MAX DTSCS26 +03017 OR L011-NOT-VALID DTSCS26 +03018 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 +03019 MOVE 'REMIT/CHECK/ADJ AMT' TO WRK-MSG-TEXT DTSCS26 +03020 PERFORM S1501-ERROR THRU S1501-EXIT DTSCS26 +03021 GO TO S1500-EXIT DTSCS26 +03022 ELSE DTSCS26 +03023 MOVE L011-AMT TO MAP-AMT-N DTSCS26 +03024 WRK-AMT. DTSCS26 +03025 DTSCS26 +03026 PERFORM S1510-AMT-ADJ-TYPE-EDITS THRU S1510-EXIT. DTSCS26 +03027 S1500-EXIT. DTSCS26 +03028 EXIT. DTSCS26 +03029 DTSCS26 +03030 DTSCS26 +03031 DTSCS26 +03032 S1501-ERROR. DTSCS26 +03033 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-AMT-A. DTSCS26 +03034 DTSCS26 +03035 IF LCCM-NO-MSG DTSCS26 +03036 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS26 +03037 MOVE CATB-CURSOR TO MAP-AMT-L DTSCS26 +03038 SET CURSOR-SET-YES TO TRUE. DTSCS26 +03039 S1501-EXIT. DTSCS26 +03040 EXIT. DTSCS26 +03041 DTSCS26 +03042 DTSCS26 +03043 DTSCS26 +03044 S1510-AMT-ADJ-TYPE-EDITS. DTSCS26 +03045 IF AADJ-ADJ-TYPE = SPACES DTSCS26 +03046 GO TO S1510-EXIT. DTSCS26 03047 DTSCS26 -03048 PERFORM S029-YRQ-FROM-SCREEN THRU S029-EXIT. DTSCS26 -03049 DTSCS26 -03050 IF L029-NO-ENTRY DTSCS26 -03051 NEXT SENTENCE DTSCS26 -03052 ELSE DTSCS26 -03053 IF L029-NOT-VALID DTSCS26 -03054 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 -03055 MOVE 'YEAR/QUARTER' TO WRK-MSG-TEXT DTSCS26 -03056 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS26 -03057 GO TO S1600-EXIT. DTSCS26 -03058 DTSCS26 -03059 MOVE L029-YRQ TO WRK-APPLIC-YRQ DTSCS26 -03060 LCCM-YRQ. DTSCS26 -03061 DTSCS26 -03062 PERFORM S1610-YRQ-ADJ-TYPE-EDITS THRU S1610-EXIT. DTSCS26 -03063 S1600-EXIT. DTSCS26 -03064 EXIT. DTSCS26 -03065 DTSCS26 -03066 DTSCS26 -03067 DTSCS26 -03068 S1601-ERROR. DTSCS26 -03069 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-APPLIC-YRQ-YR-A DTSCS26 -03070 MAP-APPLIC-YRQ-Q-A. DTSCS26 -03071 DTSCS26 -03072 IF LCCM-NO-MSG DTSCS26 -03073 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS26 -03074 MOVE CATB-CURSOR TO MAP-APPLIC-YRQ-YR-L DTSCS26 -03075 SET CURSOR-SET-YES TO TRUE. DTSCS26 -03076 S1601-EXIT. DTSCS26 -03077 EXIT. DTSCS26 -03078 DTSCS26 -03079 DTSCS26 -03080 DTSCS26 -03081 S1610-YRQ-ADJ-TYPE-EDITS. DTSCS26 -03082 IF AADJ-ADJ-TYPE = SPACES DTSCS26 -03083 GO TO S1610-EXIT. DTSCS26 -03084 DTSCS26 -03085 IF (AADJ-WRITE-OFF-88 OR AADJ-WRITE-OFF-REV-88) DTSCS26 -03086 OR DTSCS26 -03087 ((AADJ-TOLER-88) AND (MAP-APPLIC-IND = 'CR')) DTSCS26 -03088 IF WRK-APPLIC-YRQ = +0 DTSCS26 -03089 NEXT SENTENCE DTSCS26 -03090 ELSE DTSCS26 -03091 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 -03092 MOVE 'YEAR/QUARTER}{RPT/PAY/ADJ TYPE' DTSCS26 -03093 TO WRK-MSG-TEXT DTSCS26 -03094 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS26 -03095 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS26 -03096 ELSE DTSCS26 -03097 IF WRK-APPLIC-YRQ = +0 DTSCS26 -03098 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 -03099 MOVE 'YEAR/QUARTER}{RPT/PAY/ADJ TYPE' DTSCS26 -03100 TO WRK-MSG-TEXT DTSCS26 -03101 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS26 -03102 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS26 -03103 ELSE DTSCS26 -03104 NEXT SENTENCE. DTSCS26 +03048 IF AADJ-CHARGE-88 OR AADJ-WAIVE-88 OR AADJ-TOLER-88 DTSCS26 +03049 OR AADJ-WRITE-OFF-88 CL*10 +03050 IF WRK-AMT = +0 DTSCS26 +03051 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 +03052 MOVE 'REMIT/ADJ AMT}{RPT/PAY/ADJ TYPE' DTSCS26 +03053 TO WRK-MSG-TEXT DTSCS26 +03054 PERFORM S1501-ERROR THRU S1501-EXIT DTSCS26 +03055 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS26 +03056 ELSE DTSCS26 +03057 NEXT SENTENCE DTSCS26 +03058 ELSE DTSCS26 +03059 IF WRK-AMT = +0 DTSCS26 +03060 NEXT SENTENCE DTSCS26 +03061 ELSE DTSCS26 +03062 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 +03063 MOVE 'REMIT/ADJ AMT}{RPT/PAY/ADJ TYPE' DTSCS26 +03064 TO WRK-MSG-TEXT DTSCS26 +03065 PERFORM S1501-ERROR THRU S1501-EXIT DTSCS26 +03066 PERFORM S1201-ERROR THRU S1201-EXIT. DTSCS26 +03067 S1510-EXIT. DTSCS26 +03068 EXIT. DTSCS26 +03069 /*****************************************************************DTSCS26 +03070 * DTSCS26 +03071 ******************************************************************DTSCS26 +03072 S1600-APPLIC-YRQ. DTSCS26 +03073 MOVE MAP-APPLIC-YRQ-AREA TO L029-S-YRQ-AREA. DTSCS26 +03074 DTSCS26 +03075 PERFORM S029-YRQ-FROM-SCREEN THRU S029-EXIT. DTSCS26 +03076 DTSCS26 +03077 IF L029-NO-ENTRY DTSCS26 +03078 NEXT SENTENCE DTSCS26 +03079 ELSE DTSCS26 +03080 IF L029-NOT-VALID DTSCS26 +03081 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 +03082 MOVE 'YEAR/QUARTER' TO WRK-MSG-TEXT DTSCS26 +03083 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS26 +03084 GO TO S1600-EXIT. DTSCS26 +03085 DTSCS26 +03086 MOVE L029-YRQ TO WRK-APPLIC-YRQ DTSCS26 +03087 LCCM-YRQ. DTSCS26 +03088 DTSCS26 +03089 PERFORM S1610-YRQ-ADJ-TYPE-EDITS THRU S1610-EXIT. DTSCS26 +03090 S1600-EXIT. DTSCS26 +03091 EXIT. DTSCS26 +03092 DTSCS26 +03093 DTSCS26 +03094 DTSCS26 +03095 S1601-ERROR. DTSCS26 +03096 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-APPLIC-YRQ-YR-A DTSCS26 +03097 MAP-APPLIC-YRQ-Q-A. DTSCS26 +03098 DTSCS26 +03099 IF LCCM-NO-MSG DTSCS26 +03100 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS26 +03101 MOVE CATB-CURSOR TO MAP-APPLIC-YRQ-YR-L DTSCS26 +03102 SET CURSOR-SET-YES TO TRUE. DTSCS26 +03103 S1601-EXIT. DTSCS26 +03104 EXIT. DTSCS26 03105 DTSCS26 -03106 IF MAP-CMPRMISE-YES-88 DTSCS26 -03107 PERFORM S1611-CHK-QTRS THRU S1611-EXIT DTSCS26 -03108 END-IF. DTSCS26 -03109 DTSCS26 -03110 S1610-EXIT. DTSCS26 -03111 EXIT. DTSCS26 -03112 DTSCS26 -03113 S1611-CHK-QTRS. DTSCS26 -03114 SET WRK-YRQ-NOT-FOUND-88 TO TRUE. DTSCS26 -03115 PERFORM DTSCS26 -03116 VARYING MCMP-COV-IDX DTSCS26 -03117 FROM +1 BY +1 DTSCS26 -03118 UNTIL MCMP-COV-IDX > MCMP-COV-CNT DTSCS26 -03119 IF WRK-APPLIC-YRQ = MCMP-COVERED-YRQ (MCMP-COV-IDX) DTSCS26 -03120 SET WRK-YRQ-OK-88 TO TRUE DTSCS26 -03121 END-IF DTSCS26 -03122 END-PERFORM. DTSCS26 -03123 DTSCS26 -03124 IF WRK-YRQ-NOT-FOUND-88 DTSCS26 -03125 MOVE MSG-E26G-AREA TO WRK-MSG-AREA DTSCS26 -03126 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS26 -03127 END-IF. DTSCS26 -03128 DTSCS26 -03129 S1611-EXIT. DTSCS26 -03130 EXIT. DTSCS26 -03131 /*****************************************************************DTSCS26 -03132 * DTSCS26 -03133 ******************************************************************DTSCS26 -03134 S1700-APPLIC-IND. DTSCS26 -03135 INSPECT MAP-APPLIC-IND DTSCS26 -03136 CONVERTING LOW-VALUES TO SPACES. DTSCS26 -03137 DTSCS26 -03138 IF MAP-APPLIC-IND = SPACES DTSCS26 -03139 NEXT SENTENCE DTSCS26 -03140 ELSE DTSCS26 -03141 MOVE MAP-APPLIC-IND TO L032-CD-2 DTSCS26 -03142 PERFORM S032-AADJ-APPLIC-IND THRU S032-EXIT DTSCS26 -03143 IF NOT L032-VALID DTSCS26 -03144 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS26 -03145 PERFORM S1701-ERROR THRU S1701-EXIT DTSCS26 -03146 GO TO S1700-EXIT. DTSCS26 -03147 DTSCS26 -03148 MOVE MAP-APPLIC-IND TO WRK-APPLIC-IND. DTSCS26 -03149 DTSCS26 -03150 PERFORM S1710-IND-ADJ-TYPE-EDITS THRU S1710-EXIT. DTSCS26 -03151 S1700-EXIT. DTSCS26 -03152 EXIT. DTSCS26 -03153 DTSCS26 -03154 DTSCS26 +03106 DTSCS26 +03107 DTSCS26 +03108 S1610-YRQ-ADJ-TYPE-EDITS. DTSCS26 +03109 IF AADJ-ADJ-TYPE = SPACES DTSCS26 +03110 GO TO S1610-EXIT. DTSCS26 +03111 DTSCS26 +03112 IF (AADJ-WRITE-OFF-88 OR AADJ-WRITE-OFF-REV-88) DTSCS26 +03113 OR DTSCS26 +03114 ((AADJ-TOLER-88) AND (MAP-APPLIC-IND = 'CR')) DTSCS26 +03115 IF WRK-APPLIC-YRQ = +0 DTSCS26 +03116 NEXT SENTENCE DTSCS26 +03117 ELSE DTSCS26 +03118 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 +03119 MOVE 'YEAR/QUARTER}{RPT/PAY/ADJ TYPE' DTSCS26 +03120 TO WRK-MSG-TEXT DTSCS26 +03121 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS26 +03122 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS26 +03123 ELSE DTSCS26 +03124 IF WRK-APPLIC-YRQ = +0 DTSCS26 +03125 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 +03126 MOVE 'YEAR/QUARTER}{RPT/PAY/ADJ TYPE' DTSCS26 +03127 TO WRK-MSG-TEXT DTSCS26 +03128 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS26 +03129 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS26 +03130 ELSE DTSCS26 +03131 NEXT SENTENCE. DTSCS26 +03132 DTSCS26 +03133 IF MAP-CMPRMISE-YES-88 DTSCS26 +03134 PERFORM S1611-CHK-QTRS THRU S1611-EXIT DTSCS26 +03135 END-IF. DTSCS26 +03136 DTSCS26 +03137 S1610-EXIT. DTSCS26 +03138 EXIT. DTSCS26 +03139 DTSCS26 +03140 S1611-CHK-QTRS. DTSCS26 +03141 SET WRK-YRQ-NOT-FOUND-88 TO TRUE. DTSCS26 +03142 PERFORM DTSCS26 +03143 VARYING MCMP-COV-IDX DTSCS26 +03144 FROM +1 BY +1 DTSCS26 +03145 UNTIL MCMP-COV-IDX > MCMP-COV-CNT DTSCS26 +03146 IF WRK-APPLIC-YRQ = MCMP-COVERED-YRQ (MCMP-COV-IDX) DTSCS26 +03147 SET WRK-YRQ-OK-88 TO TRUE DTSCS26 +03148 END-IF DTSCS26 +03149 END-PERFORM. DTSCS26 +03150 DTSCS26 +03151 IF WRK-YRQ-NOT-FOUND-88 DTSCS26 +03152 MOVE MSG-E26G-AREA TO WRK-MSG-AREA DTSCS26 +03153 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS26 +03154 END-IF. DTSCS26 03155 DTSCS26 -03156 S1701-ERROR. DTSCS26 -03157 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-APPLIC-IND-A. DTSCS26 -03158 DTSCS26 -03159 IF LCCM-NO-MSG DTSCS26 -03160 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS26 -03161 MOVE CATB-CURSOR TO MAP-APPLIC-IND-L DTSCS26 -03162 SET CURSOR-SET-YES TO TRUE. DTSCS26 -03163 S1701-EXIT. DTSCS26 -03164 EXIT. DTSCS26 -03165 DTSCS26 -03166 DTSCS26 -03167 DTSCS26 -03168 S1710-IND-ADJ-TYPE-EDITS. DTSCS26 -03169 IF AADJ-ADJ-TYPE = SPACES DTSCS26 -03170 GO TO S1710-EXIT. DTSCS26 -03171 DTSCS26 -03172 IF AADJ-CHARGE-88 DTSCS26 -03173 IF MAP-APPLIC-IND = 'UI' OR 'I ' OR 'LP' OR 'NP' OR 'MP' DTSCS26 -03174 OR 'SU' DTSCS26 -03175 NEXT SENTENCE DTSCS26 -03176 ELSE DTSCS26 -03177 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 -03178 MOVE 'RPT/PAY/ADJ TYPE' TO WRK-MSG-TEXT DTSCS26 -03179 PERFORM S1701-ERROR THRU S1701-EXIT DTSCS26 -03180 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS26 -03181 ELSE DTSCS26 -03182 IF AADJ-WAIVE-88 DTSCS26 -03183 IF MAP-APPLIC-IND = 'I ' OR 'LP' OR 'NP' OR 'MP' DTSCS26 -03184 NEXT SENTENCE DTSCS26 -03185 ELSE DTSCS26 -03186 IF MAP-APPLIC-IND = 'UI' DTSCS26 -03187 AND MAP-CMPRMISE-YES-88 DTSCS26 -03188 NEXT SENTENCE DTSCS26 -03189 ELSE DTSCS26 -03190 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 -03191 MOVE 'RPT/PAY/ADJ TYPE' TO WRK-MSG-TEXT DTSCS26 -03192 PERFORM S1701-ERROR THRU S1701-EXIT DTSCS26 -03193 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS26 -03194 END-IF DTSCS26 -03195 END-IF DTSCS26 -03196 ELSE DTSCS26 -03197 IF AADJ-TOLER-88 DTSCS26 -03198 IF MAP-APPLIC-IND = SPACES DTSCS26 -03199 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 -03200 MOVE 'RPT/PAY/ADJ TYPE' TO WRK-MSG-TEXT DTSCS26 -03201 PERFORM S1701-ERROR THRU S1701-EXIT DTSCS26 -03202 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS26 +03156 S1611-EXIT. DTSCS26 +03157 EXIT. DTSCS26 +03158 /*****************************************************************DTSCS26 +03159 * DTSCS26 +03160 ******************************************************************DTSCS26 +03161 S1700-APPLIC-IND. DTSCS26 +03162 INSPECT MAP-APPLIC-IND DTSCS26 +03163 CONVERTING LOW-VALUES TO SPACES. DTSCS26 +03164 DTSCS26 +03165 IF MAP-APPLIC-IND = SPACES DTSCS26 +03166 NEXT SENTENCE DTSCS26 +03167 ELSE DTSCS26 +03168 MOVE MAP-APPLIC-IND TO L032-CD-2 DTSCS26 +03169 PERFORM S032-AADJ-APPLIC-IND THRU S032-EXIT DTSCS26 +03170 IF NOT L032-VALID DTSCS26 +03171 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS26 +03172 PERFORM S1701-ERROR THRU S1701-EXIT DTSCS26 +03173 GO TO S1700-EXIT. DTSCS26 +03174 DTSCS26 +03175 MOVE MAP-APPLIC-IND TO WRK-APPLIC-IND. DTSCS26 +03176 DTSCS26 +03177 PERFORM S1710-IND-ADJ-TYPE-EDITS THRU S1710-EXIT. DTSCS26 +03178 S1700-EXIT. DTSCS26 +03179 EXIT. DTSCS26 +03180 DTSCS26 +03181 DTSCS26 +03182 DTSCS26 +03183 S1701-ERROR. DTSCS26 +03184 MOVE CATB-UNPROT-NORM-AN-MDTON TO MAP-APPLIC-IND-A. DTSCS26 +03185 DTSCS26 +03186 IF LCCM-NO-MSG DTSCS26 +03187 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS26 +03188 MOVE CATB-CURSOR TO MAP-APPLIC-IND-L DTSCS26 +03189 SET CURSOR-SET-YES TO TRUE. DTSCS26 +03190 S1701-EXIT. DTSCS26 +03191 EXIT. DTSCS26 +03192 DTSCS26 +03193 DTSCS26 +03194 DTSCS26 +03195 S1710-IND-ADJ-TYPE-EDITS. DTSCS26 +03196 IF AADJ-ADJ-TYPE = SPACES DTSCS26 +03197 GO TO S1710-EXIT. DTSCS26 +03198 DTSCS26 +03199 IF AADJ-CHARGE-88 DTSCS26 +03200 IF MAP-APPLIC-IND = 'UI' OR 'I ' OR 'LP' OR 'NP' OR 'MP' DTSCS26 +03201 OR 'SU' DTSCS26 +03202 NEXT SENTENCE DTSCS26 03203 ELSE DTSCS26 -03204 NEXT SENTENCE DTSCS26 -03205 ELSE DTSCS26 -03206 IF AADJ-AUTO-88 OR AADJ-MANUAL-88 OR AADJ-WAIVE-DATE-88 DTSCS26 -03207 IF MAP-APPLIC-IND = 'I ' OR 'LP' OR 'PI' DTSCS26 -03208 NEXT SENTENCE DTSCS26 -03209 ELSE DTSCS26 -03210 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 -03211 MOVE 'RPT/PAY/ADJ TYPE' TO WRK-MSG-TEXT DTSCS26 -03212 PERFORM S1701-ERROR THRU S1701-EXIT DTSCS26 -03213 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS26 -03214 ELSE DTSCS26 -03215 IF AADJ-INT-DATE-88 DTSCS26 -03216 IF MAP-APPLIC-IND = 'I ' DTSCS26 -03217 NEXT SENTENCE DTSCS26 -03218 ELSE DTSCS26 -03219 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 -03220 MOVE 'RPT/PAY/ADJ TYPE' TO WRK-MSG-TEXT DTSCS26 -03221 PERFORM S1701-ERROR THRU S1701-EXIT DTSCS26 -03222 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS26 +03204 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 +03205 MOVE 'RPT/PAY/ADJ TYPE' TO WRK-MSG-TEXT DTSCS26 +03206 PERFORM S1701-ERROR THRU S1701-EXIT DTSCS26 +03207 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS26 +03208 ELSE DTSCS26 +03209 IF AADJ-WAIVE-88 DTSCS26 +03210 IF MAP-APPLIC-IND = 'I ' OR 'LP' OR 'NP' OR 'MP' DTSCS26 +03211 NEXT SENTENCE DTSCS26 +03212 ELSE DTSCS26 +03213 IF MAP-APPLIC-IND = 'UI' DTSCS26 +03214 AND MAP-CMPRMISE-YES-88 DTSCS26 +03215 NEXT SENTENCE DTSCS26 +03216 ELSE DTSCS26 +03217 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 +03218 MOVE 'RPT/PAY/ADJ TYPE' TO WRK-MSG-TEXT DTSCS26 +03219 PERFORM S1701-ERROR THRU S1701-EXIT DTSCS26 +03220 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS26 +03221 END-IF DTSCS26 +03222 END-IF DTSCS26 03223 ELSE DTSCS26 -03224 IF MAP-APPLIC-IND = SPACE DTSCS26 -03225 NEXT SENTENCE DTSCS26 -03226 ELSE DTSCS26 -03227 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 -03228 MOVE 'RPT/PAY/ADJ TYPE' TO WRK-MSG-TEXT DTSCS26 -03229 PERFORM S1701-ERROR THRU S1701-EXIT DTSCS26 -03230 PERFORM S1201-ERROR THRU S1201-EXIT. DTSCS26 -03231 S1710-EXIT. DTSCS26 -03232 EXIT. DTSCS26 -03233 /*****************************************************************DTSCS26 -03234 * DTSCS26 -03235 ******************************************************************DTSCS26 -03236 S1800-BATCH-ITEM. DTSCS26 -03237 MOVE MAP-APPLIC-DOC-NO-AREA TO L019-S-DOC-NO. DTSCS26 -03238 DTSCS26 -03239 PERFORM S019-BATCH-NO-FROM-SCREEN THRU S019-EXIT. DTSCS26 -03240 DTSCS26 -03241 IF L019-NO-ENTRY DTSCS26 -03242 NEXT SENTENCE DTSCS26 -03243 ELSE DTSCS26 -03244 IF L019-NOT-VALID DTSCS26 -03245 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 -03246 MOVE 'APPLIC DOC NO' TO WRK-MSG-TEXT DTSCS26 -03247 PERFORM S1801-ERROR THRU S1801-EXIT DTSCS26 -03248 PERFORM S1802-ERROR THRU S1802-EXIT DTSCS26 -03249 GO TO S1800-EXIT DTSCS26 +03224 IF AADJ-TOLER-88 DTSCS26 +03225 IF MAP-APPLIC-IND = SPACES DTSCS26 +03226 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 +03227 MOVE 'RPT/PAY/ADJ TYPE' TO WRK-MSG-TEXT DTSCS26 +03228 PERFORM S1701-ERROR THRU S1701-EXIT DTSCS26 +03229 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS26 +03230 ELSE DTSCS26 +03231 NEXT SENTENCE DTSCS26 +03232 ELSE DTSCS26 +03233 IF AADJ-AUTO-88 OR AADJ-MANUAL-88 OR AADJ-WAIVE-DATE-88 DTSCS26 +03234 IF MAP-APPLIC-IND = 'I ' OR 'LP' OR 'PI' DTSCS26 +03235 NEXT SENTENCE DTSCS26 +03236 ELSE DTSCS26 +03237 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 +03238 MOVE 'RPT/PAY/ADJ TYPE' TO WRK-MSG-TEXT DTSCS26 +03239 PERFORM S1701-ERROR THRU S1701-EXIT DTSCS26 +03240 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS26 +03241 ELSE DTSCS26 +03242 IF AADJ-INT-DATE-88 DTSCS26 +03243 IF MAP-APPLIC-IND = 'I ' DTSCS26 +03244 NEXT SENTENCE DTSCS26 +03245 ELSE DTSCS26 +03246 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 +03247 MOVE 'RPT/PAY/ADJ TYPE' TO WRK-MSG-TEXT DTSCS26 +03248 PERFORM S1701-ERROR THRU S1701-EXIT DTSCS26 +03249 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS26 03250 ELSE DTSCS26 -03251 IF L019-ITEM-NO = +0 DTSCS26 -03252 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS26 -03253 PERFORM S1802-ERROR THRU S1802-EXIT DTSCS26 -03254 GO TO S1800-EXIT DTSCS26 -03255 ELSE DTSCS26 -03256 MOVE L019-DOC-NO TO WRK-APPLIC-DOC-NO. DTSCS26 -03257 DTSCS26 -03258 PERFORM S1810-DOC-NO-ADJ-TYPE-EDITS THRU S1810-EXIT. DTSCS26 -03259 S1800-EXIT. DTSCS26 -03260 EXIT. DTSCS26 -03261 DTSCS26 -03262 DTSCS26 -03263 DTSCS26 -03264 S1801-ERROR. DTSCS26 -03265 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-APPLIC-BATCH-NO-A. DTSCS26 -03266 DTSCS26 -03267 IF LCCM-NO-MSG DTSCS26 -03268 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS26 -03269 MOVE CATB-CURSOR TO MAP-APPLIC-BATCH-NO-L DTSCS26 -03270 SET CURSOR-SET-YES TO TRUE. DTSCS26 -03271 S1801-EXIT. DTSCS26 -03272 EXIT. DTSCS26 -03273 DTSCS26 -03274 DTSCS26 -03275 DTSCS26 -03276 S1802-ERROR. DTSCS26 -03277 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-APPLIC-ITEM-NO-A. DTSCS26 -03278 DTSCS26 -03279 IF LCCM-NO-MSG DTSCS26 -03280 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS26 -03281 MOVE CATB-CURSOR TO MAP-APPLIC-ITEM-NO-L DTSCS26 -03282 SET CURSOR-SET-YES TO TRUE. DTSCS26 -03283 S1802-EXIT. DTSCS26 -03284 EXIT. DTSCS26 -03285 DTSCS26 -03286 DTSCS26 -03287 DTSCS26 -03288 S1810-DOC-NO-ADJ-TYPE-EDITS. DTSCS26 -03289 IF AADJ-ADJ-TYPE = SPACES DTSCS26 -03290 GO TO S1810-EXIT. DTSCS26 -03291 DTSCS26 -03292 IF ((AADJ-TOLER-88) AND (WRK-APPLIC-IND = 'CR')) DTSCS26 -03293 IF WRK-APPLIC-DOC-NO = NULL-DOC-NO DTSCS26 -03294 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 -03295 MOVE 'RPT/PAY/ADJ TYPE}{APPLIC DOC NO' DTSCS26 -03296 TO WRK-MSG-TEXT DTSCS26 -03297 PERFORM S1801-ERROR THRU S1801-EXIT DTSCS26 -03298 PERFORM S1802-ERROR THRU S1802-EXIT DTSCS26 -03299 PERFORM S1701-ERROR THRU S1701-EXIT DTSCS26 -03300 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS26 -03301 ELSE DTSCS26 -03302 NEXT SENTENCE DTSCS26 -03303 ELSE DTSCS26 -03304 IF WRK-APPLIC-DOC-NO = NULL-DOC-NO DTSCS26 -03305 NEXT SENTENCE DTSCS26 -03306 ELSE DTSCS26 -03307 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 -03308 MOVE 'RPT/PAY/ADJ TYPE}{APPLIC DOC NO' DTSCS26 -03309 TO WRK-MSG-TEXT DTSCS26 -03310 PERFORM S1801-ERROR THRU S1801-EXIT DTSCS26 -03311 PERFORM S1802-ERROR THRU S1802-EXIT DTSCS26 -03312 PERFORM S1201-ERROR THRU S1201-EXIT. DTSCS26 -03313 S1810-EXIT. DTSCS26 -03314 EXIT. DTSCS26 -03315 /*****************************************************************DTSCS26 -03316 * DTSCS26 -03317 ******************************************************************DTSCS26 -03318 S1900-DATE-1. DTSCS26 -03319 IF (MAP-DATE-1-MO = '99') DTSCS26 -03320 AND (MAP-DATE-1-DA = '99') DTSCS26 -03321 AND (MAP-DATE-1-YR = '99') DTSCS26 -03322 MOVE ALL-NINES-DATE TO WRK-DATE-1 DTSCS26 -03323 ELSE DTSCS26 -03324 MOVE MAP-DATE-1-AREA TO L015-S-DATE-AREA DTSCS26 -03325 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT DTSCS26 -03326 IF L015-NO-ENTRY DTSCS26 -03327 NEXT SENTENCE DTSCS26 +03251 IF MAP-APPLIC-IND = SPACE DTSCS26 +03252 NEXT SENTENCE DTSCS26 +03253 ELSE DTSCS26 +03254 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 +03255 MOVE 'RPT/PAY/ADJ TYPE' TO WRK-MSG-TEXT DTSCS26 +03256 PERFORM S1701-ERROR THRU S1701-EXIT DTSCS26 +03257 PERFORM S1201-ERROR THRU S1201-EXIT. DTSCS26 +03258 S1710-EXIT. DTSCS26 +03259 EXIT. DTSCS26 +03260 /*****************************************************************DTSCS26 +03261 * DTSCS26 +03262 ******************************************************************DTSCS26 +03263 S1800-BATCH-ITEM. DTSCS26 +03264 MOVE MAP-APPLIC-DOC-NO-AREA TO L019-S-DOC-NO. DTSCS26 +03265 DTSCS26 +03266 PERFORM S019-BATCH-NO-FROM-SCREEN THRU S019-EXIT. DTSCS26 +03267 DTSCS26 +03268 IF L019-NO-ENTRY DTSCS26 +03269 NEXT SENTENCE DTSCS26 +03270 ELSE DTSCS26 +03271 IF L019-NOT-VALID DTSCS26 +03272 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 +03273 MOVE 'APPLIC DOC NO' TO WRK-MSG-TEXT DTSCS26 +03274 PERFORM S1801-ERROR THRU S1801-EXIT DTSCS26 +03275 PERFORM S1802-ERROR THRU S1802-EXIT DTSCS26 +03276 GO TO S1800-EXIT DTSCS26 +03277 ELSE DTSCS26 +03278 IF L019-ITEM-NO = +0 DTSCS26 +03279 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS26 +03280 PERFORM S1802-ERROR THRU S1802-EXIT DTSCS26 +03281 GO TO S1800-EXIT DTSCS26 +03282 ELSE DTSCS26 +03283 MOVE L019-DOC-NO TO WRK-APPLIC-DOC-NO. DTSCS26 +03284 DTSCS26 +03285 PERFORM S1810-DOC-NO-ADJ-TYPE-EDITS THRU S1810-EXIT. DTSCS26 +03286 S1800-EXIT. DTSCS26 +03287 EXIT. DTSCS26 +03288 DTSCS26 +03289 DTSCS26 +03290 DTSCS26 +03291 S1801-ERROR. DTSCS26 +03292 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-APPLIC-BATCH-NO-A. DTSCS26 +03293 DTSCS26 +03294 IF LCCM-NO-MSG DTSCS26 +03295 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS26 +03296 MOVE CATB-CURSOR TO MAP-APPLIC-BATCH-NO-L DTSCS26 +03297 SET CURSOR-SET-YES TO TRUE. DTSCS26 +03298 S1801-EXIT. DTSCS26 +03299 EXIT. DTSCS26 +03300 DTSCS26 +03301 DTSCS26 +03302 DTSCS26 +03303 S1802-ERROR. DTSCS26 +03304 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-APPLIC-ITEM-NO-A. DTSCS26 +03305 DTSCS26 +03306 IF LCCM-NO-MSG DTSCS26 +03307 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS26 +03308 MOVE CATB-CURSOR TO MAP-APPLIC-ITEM-NO-L DTSCS26 +03309 SET CURSOR-SET-YES TO TRUE. DTSCS26 +03310 S1802-EXIT. DTSCS26 +03311 EXIT. DTSCS26 +03312 DTSCS26 +03313 DTSCS26 +03314 DTSCS26 +03315 S1810-DOC-NO-ADJ-TYPE-EDITS. DTSCS26 +03316 IF AADJ-ADJ-TYPE = SPACES DTSCS26 +03317 GO TO S1810-EXIT. DTSCS26 +03318 DTSCS26 +03319 IF ((AADJ-TOLER-88) AND (WRK-APPLIC-IND = 'CR')) DTSCS26 +03320 IF WRK-APPLIC-DOC-NO = NULL-DOC-NO DTSCS26 +03321 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 +03322 MOVE 'RPT/PAY/ADJ TYPE}{APPLIC DOC NO' DTSCS26 +03323 TO WRK-MSG-TEXT DTSCS26 +03324 PERFORM S1801-ERROR THRU S1801-EXIT DTSCS26 +03325 PERFORM S1802-ERROR THRU S1802-EXIT DTSCS26 +03326 PERFORM S1701-ERROR THRU S1701-EXIT DTSCS26 +03327 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS26 03328 ELSE DTSCS26 -03329 IF L015-NOT-VALID DTSCS26 -03330 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS26 -03331 PERFORM S1901-ERROR THRU S1901-EXIT DTSCS26 -03332 GO TO S1900-EXIT DTSCS26 +03329 NEXT SENTENCE DTSCS26 +03330 ELSE DTSCS26 +03331 IF WRK-APPLIC-DOC-NO = NULL-DOC-NO DTSCS26 +03332 NEXT SENTENCE DTSCS26 03333 ELSE DTSCS26 -03334 MOVE L015-DATE TO WRK-DATE-1. DTSCS26 -03335 DTSCS26 -03336 PERFORM S1910-DATE-1-ADJ-TYPE-EDIT THRU S1910-EXIT. DTSCS26 -03337 S1900-EXIT. DTSCS26 -03338 EXIT. DTSCS26 -03339 DTSCS26 -03340 DTSCS26 -03341 DTSCS26 -03342 S1901-ERROR. DTSCS26 -03343 MOVE CATB-UNPROT-NORM-NUM-MDTON DTSCS26 -03344 TO MAP-DATE-1-MO-A DTSCS26 -03345 MAP-DATE-1-DA-A DTSCS26 -03346 MAP-DATE-1-YR-A. DTSCS26 -03347 DTSCS26 -03348 IF LCCM-NO-MSG DTSCS26 -03349 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS26 -03350 MOVE CATB-CURSOR TO MAP-DATE-1-MO-L DTSCS26 -03351 SET CURSOR-SET-YES TO TRUE. DTSCS26 -03352 S1901-EXIT. DTSCS26 -03353 EXIT. DTSCS26 -03354 DTSCS26 -03355 DTSCS26 -03356 DTSCS26 -03357 S1910-DATE-1-ADJ-TYPE-EDIT. DTSCS26 -03358 IF AADJ-ADJ-TYPE = SPACES DTSCS26 -03359 GO TO S1910-EXIT. DTSCS26 -03360 DTSCS26 -03361 IF AADJ-DUE-DATE-88 DTSCS26 -03362 NEXT SENTENCE DTSCS26 -03363 ELSE DTSCS26 -03364 IF AADJ-WAIVE-DATE-88 OR AADJ-INT-DATE-88 DTSCS26 -03365 IF WRK-DATE-1 = +0 DTSCS26 -03366 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 -03367 MOVE 'SPAN INFORMATION' TO WRK-MSG-TEXT DTSCS26 -03368 PERFORM S1901-ERROR THRU S1901-EXIT DTSCS26 -03369 ELSE DTSCS26 -03370 NEXT SENTENCE DTSCS26 -03371 ELSE DTSCS26 -03372 IF AADJ-WRITE-OFF-88 DTSCS26 -03373 IF WRK-DATE-1 = +0 DTSCS26 -03374 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS26 -03375 PERFORM S1901-ERROR THRU S1901-EXIT DTSCS26 -03376 ELSE DTSCS26 -03377 IF WRK-DATE-1 = ALL-NINES-DATE DTSCS26 -03378 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS26 -03379 PERFORM S1901-ERROR THRU S1901-EXIT DTSCS26 -03380 ELSE DTSCS26 -03381 NEXT SENTENCE DTSCS26 -03382 ELSE DTSCS26 -03383 IF WRK-DATE-1 = +0 DTSCS26 -03384 NEXT SENTENCE DTSCS26 -03385 ELSE DTSCS26 -03386 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 -03387 MOVE 'RPT/PAY/ADJ TYPE}{SPAN INFORMATION' DTSCS26 -03388 TO WRK-MSG-TEXT DTSCS26 -03389 PERFORM S1901-ERROR THRU S1901-EXIT DTSCS26 -03390 PERFORM S1201-ERROR THRU S1201-EXIT. DTSCS26 -03391 S1910-EXIT. DTSCS26 -03392 EXIT. DTSCS26 -03393 /*****************************************************************DTSCS26 -03394 * DTSCS26 -03395 ******************************************************************DTSCS26 -03396 S2000-DATE-2. DTSCS26 -03397 IF (MAP-DATE-2-MO = '99') DTSCS26 -03398 AND (MAP-DATE-2-DA = '99') DTSCS26 -03399 AND (MAP-DATE-2-YR = '99') DTSCS26 -03400 MOVE ALL-NINES-DATE TO WRK-DATE-2 DTSCS26 -03401 ELSE DTSCS26 -03402 MOVE MAP-DATE-2-AREA TO L015-S-DATE-AREA DTSCS26 -03403 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT DTSCS26 -03404 IF L015-NO-ENTRY DTSCS26 -03405 NEXT SENTENCE DTSCS26 -03406 ELSE DTSCS26 -03407 IF L015-NOT-VALID DTSCS26 -03408 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS26 -03409 PERFORM S2001-ERROR THRU S2001-EXIT DTSCS26 -03410 GO TO S2000-EXIT DTSCS26 -03411 ELSE DTSCS26 -03412 MOVE L015-DATE TO WRK-DATE-2. DTSCS26 -03413 DTSCS26 -03414 PERFORM S2010-DATE-2-ADJ-TYPE-EDIT THRU S2010-EXIT. DTSCS26 -03415 DTSCS26 -03416 PERFORM S2020-DATE-1-DATE-2-EDIT THRU S2020-EXIT. DTSCS26 -03417 S2000-EXIT. DTSCS26 -03418 EXIT. DTSCS26 -03419 DTSCS26 -03420 DTSCS26 -03421 DTSCS26 -03422 S2001-ERROR. DTSCS26 -03423 MOVE CATB-UNPROT-NORM-NUM-MDTON DTSCS26 -03424 TO MAP-DATE-2-MO-A DTSCS26 -03425 MAP-DATE-2-DA-A DTSCS26 -03426 MAP-DATE-2-YR-A. DTSCS26 -03427 DTSCS26 -03428 IF LCCM-NO-MSG DTSCS26 -03429 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS26 -03430 MOVE CATB-CURSOR TO MAP-DATE-2-MO-L DTSCS26 -03431 SET CURSOR-SET-YES TO TRUE. DTSCS26 -03432 S2001-EXIT. DTSCS26 -03433 EXIT. DTSCS26 -03434 DTSCS26 -03435 DTSCS26 -03436 DTSCS26 -03437 S2010-DATE-2-ADJ-TYPE-EDIT. DTSCS26 -03438 IF AADJ-ADJ-TYPE = SPACES DTSCS26 -03439 GO TO S2010-EXIT. DTSCS26 +03334 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 +03335 MOVE 'RPT/PAY/ADJ TYPE}{APPLIC DOC NO' DTSCS26 +03336 TO WRK-MSG-TEXT DTSCS26 +03337 PERFORM S1801-ERROR THRU S1801-EXIT DTSCS26 +03338 PERFORM S1802-ERROR THRU S1802-EXIT DTSCS26 +03339 PERFORM S1201-ERROR THRU S1201-EXIT. DTSCS26 +03340 S1810-EXIT. DTSCS26 +03341 EXIT. DTSCS26 +03342 /*****************************************************************DTSCS26 +03343 * DTSCS26 +03344 ******************************************************************DTSCS26 +03345 S1900-DATE-1. DTSCS26 +03346 IF (MAP-DATE-1-MO = '99') DTSCS26 +03347 AND (MAP-DATE-1-DA = '99') DTSCS26 +03348 AND (MAP-DATE-1-YR = '99') DTSCS26 +03349 MOVE ALL-NINES-DATE TO WRK-DATE-1 DTSCS26 +03350 ELSE DTSCS26 +03351 MOVE MAP-DATE-1-AREA TO L015-S-DATE-AREA DTSCS26 +03352 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT DTSCS26 +03353 IF L015-NO-ENTRY DTSCS26 +03354 NEXT SENTENCE DTSCS26 +03355 ELSE DTSCS26 +03356 IF L015-NOT-VALID DTSCS26 +03357 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS26 +03358 PERFORM S1901-ERROR THRU S1901-EXIT DTSCS26 +03359 GO TO S1900-EXIT DTSCS26 +03360 ELSE DTSCS26 +03361 MOVE L015-DATE TO WRK-DATE-1. DTSCS26 +03362 DTSCS26 +03363 PERFORM S1910-DATE-1-ADJ-TYPE-EDIT THRU S1910-EXIT. DTSCS26 +03364 S1900-EXIT. DTSCS26 +03365 EXIT. DTSCS26 +03366 DTSCS26 +03367 DTSCS26 +03368 DTSCS26 +03369 S1901-ERROR. DTSCS26 +03370 MOVE CATB-UNPROT-NORM-NUM-MDTON DTSCS26 +03371 TO MAP-DATE-1-MO-A DTSCS26 +03372 MAP-DATE-1-DA-A DTSCS26 +03373 MAP-DATE-1-YR-A. DTSCS26 +03374 DTSCS26 +03375 IF LCCM-NO-MSG DTSCS26 +03376 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS26 +03377 MOVE CATB-CURSOR TO MAP-DATE-1-MO-L DTSCS26 +03378 SET CURSOR-SET-YES TO TRUE. DTSCS26 +03379 S1901-EXIT. DTSCS26 +03380 EXIT. DTSCS26 +03381 DTSCS26 +03382 DTSCS26 +03383 DTSCS26 +03384 S1910-DATE-1-ADJ-TYPE-EDIT. DTSCS26 +03385 IF AADJ-ADJ-TYPE = SPACES DTSCS26 +03386 GO TO S1910-EXIT. DTSCS26 +03387 DTSCS26 +03388 IF AADJ-DUE-DATE-88 DTSCS26 +03389 NEXT SENTENCE DTSCS26 +03390 ELSE DTSCS26 +03391 IF AADJ-WAIVE-DATE-88 OR AADJ-INT-DATE-88 DTSCS26 +03392 IF WRK-DATE-1 = +0 DTSCS26 +03393 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 +03394 MOVE 'SPAN INFORMATION' TO WRK-MSG-TEXT DTSCS26 +03395 PERFORM S1901-ERROR THRU S1901-EXIT DTSCS26 +03396 ELSE DTSCS26 +03397 NEXT SENTENCE DTSCS26 +03398 ELSE DTSCS26 +03399 IF AADJ-WRITE-OFF-88 DTSCS26 +03400 IF WRK-DATE-1 = +0 DTSCS26 +03401 MOVE EMSG-FIELD-REQUIRED TO WRK-MSG-AREA DTSCS26 +03402 PERFORM S1901-ERROR THRU S1901-EXIT DTSCS26 +03403 ELSE DTSCS26 +03404 IF WRK-DATE-1 = ALL-NINES-DATE DTSCS26 +03405 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS26 +03406 PERFORM S1901-ERROR THRU S1901-EXIT DTSCS26 +03407 ELSE DTSCS26 +03408 NEXT SENTENCE DTSCS26 +03409 ELSE DTSCS26 +03410 IF WRK-DATE-1 = +0 DTSCS26 +03411 NEXT SENTENCE DTSCS26 +03412 ELSE DTSCS26 +03413 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 +03414 MOVE 'RPT/PAY/ADJ TYPE}{SPAN INFORMATION' DTSCS26 +03415 TO WRK-MSG-TEXT DTSCS26 +03416 PERFORM S1901-ERROR THRU S1901-EXIT DTSCS26 +03417 PERFORM S1201-ERROR THRU S1201-EXIT. DTSCS26 +03418 S1910-EXIT. DTSCS26 +03419 EXIT. DTSCS26 +03420 /*****************************************************************DTSCS26 +03421 * DTSCS26 +03422 ******************************************************************DTSCS26 +03423 S2000-DATE-2. DTSCS26 +03424 IF (MAP-DATE-2-MO = '99') DTSCS26 +03425 AND (MAP-DATE-2-DA = '99') DTSCS26 +03426 AND (MAP-DATE-2-YR = '99') DTSCS26 +03427 MOVE ALL-NINES-DATE TO WRK-DATE-2 DTSCS26 +03428 ELSE DTSCS26 +03429 MOVE MAP-DATE-2-AREA TO L015-S-DATE-AREA DTSCS26 +03430 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT DTSCS26 +03431 IF L015-NO-ENTRY DTSCS26 +03432 NEXT SENTENCE DTSCS26 +03433 ELSE DTSCS26 +03434 IF L015-NOT-VALID DTSCS26 +03435 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS26 +03436 PERFORM S2001-ERROR THRU S2001-EXIT DTSCS26 +03437 GO TO S2000-EXIT DTSCS26 +03438 ELSE DTSCS26 +03439 MOVE L015-DATE TO WRK-DATE-2. DTSCS26 03440 DTSCS26 -03441 IF AADJ-DUE-DATE-88 DTSCS26 -03442 NEXT SENTENCE DTSCS26 -03443 ELSE DTSCS26 -03444 IF AADJ-WAIVE-DATE-88 OR AADJ-INT-DATE-88 DTSCS26 -03445 IF WRK-DATE-2 = +0 DTSCS26 -03446 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 -03447 MOVE 'SPAN INFORMATION' TO WRK-MSG-TEXT DTSCS26 -03448 PERFORM S2001-ERROR THRU S2001-EXIT DTSCS26 -03449 ELSE DTSCS26 -03450 NEXT SENTENCE DTSCS26 -03451 ELSE DTSCS26 -03452 IF WRK-DATE-2 = +0 DTSCS26 -03453 NEXT SENTENCE DTSCS26 -03454 ELSE DTSCS26 -03455 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 -03456 MOVE 'RPT/PAY/ADJ TYPE}{SPAN INFORMATION' DTSCS26 -03457 TO WRK-MSG-TEXT DTSCS26 -03458 PERFORM S2001-ERROR THRU S2001-EXIT DTSCS26 -03459 PERFORM S1201-ERROR THRU S1201-EXIT. DTSCS26 -03460 S2010-EXIT. DTSCS26 -03461 EXIT. DTSCS26 +03441 PERFORM S2010-DATE-2-ADJ-TYPE-EDIT THRU S2010-EXIT. DTSCS26 +03442 DTSCS26 +03443 PERFORM S2020-DATE-1-DATE-2-EDIT THRU S2020-EXIT. DTSCS26 +03444 S2000-EXIT. DTSCS26 +03445 EXIT. DTSCS26 +03446 DTSCS26 +03447 DTSCS26 +03448 DTSCS26 +03449 S2001-ERROR. DTSCS26 +03450 MOVE CATB-UNPROT-NORM-NUM-MDTON DTSCS26 +03451 TO MAP-DATE-2-MO-A DTSCS26 +03452 MAP-DATE-2-DA-A DTSCS26 +03453 MAP-DATE-2-YR-A. DTSCS26 +03454 DTSCS26 +03455 IF LCCM-NO-MSG DTSCS26 +03456 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS26 +03457 MOVE CATB-CURSOR TO MAP-DATE-2-MO-L DTSCS26 +03458 SET CURSOR-SET-YES TO TRUE. DTSCS26 +03459 S2001-EXIT. DTSCS26 +03460 EXIT. DTSCS26 +03461 DTSCS26 03462 DTSCS26 03463 DTSCS26 -03464 DTSCS26 -03465 S2020-DATE-1-DATE-2-EDIT. DTSCS26 -03466 IF AADJ-ADJ-TYPE = SPACES DTSCS26 -03467 GO TO S2020-EXIT. DTSCS26 -03468 DTSCS26 -03469 IF (MAP-DATE-1-MO-A = CATB-UNPROT-NORM-NUM-MDTON) DTSCS26 -03470 OR DTSCS26 -03471 (MAP-DATE-2-MO-A = CATB-UNPROT-NORM-NUM-MDTON) DTSCS26 -03472 GO TO S2020-EXIT. DTSCS26 -03473 DTSCS26 -03474 IF AADJ-DUE-DATE-88 DTSCS26 -03475 IF ((WRK-DATE-1 = +0) AND (WRK-DATE-2 = +0)) DTSCS26 -03476 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 -03477 MOVE 'SPAN INFORMATION' TO WRK-MSG-TEXT DTSCS26 -03478 PERFORM S1901-ERROR THRU S1901-EXIT DTSCS26 -03479 PERFORM S2001-ERROR THRU S2001-EXIT DTSCS26 -03480 GO TO S2020-EXIT DTSCS26 +03464 S2010-DATE-2-ADJ-TYPE-EDIT. DTSCS26 +03465 IF AADJ-ADJ-TYPE = SPACES DTSCS26 +03466 GO TO S2010-EXIT. DTSCS26 +03467 DTSCS26 +03468 IF AADJ-DUE-DATE-88 DTSCS26 +03469 NEXT SENTENCE DTSCS26 +03470 ELSE DTSCS26 +03471 IF AADJ-WAIVE-DATE-88 OR AADJ-INT-DATE-88 DTSCS26 +03472 IF WRK-DATE-2 = +0 DTSCS26 +03473 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 +03474 MOVE 'SPAN INFORMATION' TO WRK-MSG-TEXT DTSCS26 +03475 PERFORM S2001-ERROR THRU S2001-EXIT DTSCS26 +03476 ELSE DTSCS26 +03477 NEXT SENTENCE DTSCS26 +03478 ELSE DTSCS26 +03479 IF WRK-DATE-2 = +0 DTSCS26 +03480 NEXT SENTENCE DTSCS26 03481 ELSE DTSCS26 -03482 GO TO S2020-EXIT. DTSCS26 -03483 DTSCS26 -03484 IF AADJ-WAIVE-DATE-88 OR AADJ-INT-DATE-88 DTSCS26 -03485 NEXT SENTENCE DTSCS26 -03486 ELSE DTSCS26 -03487 GO TO S2020-EXIT. DTSCS26 -03488 DTSCS26 -03489 IF WRK-DATE-2 < WRK-DATE-1 DTSCS26 -03490 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 -03491 MOVE 'SPAN INFORMATION' TO WRK-MSG-TEXT DTSCS26 -03492 PERFORM S1901-ERROR THRU S1901-EXIT DTSCS26 -03493 PERFORM S2001-ERROR THRU S2001-EXIT DTSCS26 +03482 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 +03483 MOVE 'RPT/PAY/ADJ TYPE}{SPAN INFORMATION' DTSCS26 +03484 TO WRK-MSG-TEXT DTSCS26 +03485 PERFORM S2001-ERROR THRU S2001-EXIT DTSCS26 +03486 PERFORM S1201-ERROR THRU S1201-EXIT. DTSCS26 +03487 S2010-EXIT. DTSCS26 +03488 EXIT. DTSCS26 +03489 DTSCS26 +03490 DTSCS26 +03491 DTSCS26 +03492 S2020-DATE-1-DATE-2-EDIT. DTSCS26 +03493 IF AADJ-ADJ-TYPE = SPACES DTSCS26 03494 GO TO S2020-EXIT. DTSCS26 03495 DTSCS26 -03496 IF WRK-DATE-1 = ALL-NINES-DATE DTSCS26 -03497 IF WRK-DATE-2 = ALL-NINES-DATE DTSCS26 -03498 NEXT SENTENCE DTSCS26 -03499 ELSE DTSCS26 -03500 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 -03501 MOVE 'SPAN INFORMATION' TO WRK-MSG-TEXT DTSCS26 -03502 PERFORM S1901-ERROR THRU S1901-EXIT DTSCS26 -03503 PERFORM S2001-ERROR THRU S2001-EXIT DTSCS26 -03504 GO TO S2020-EXIT DTSCS26 -03505 ELSE DTSCS26 -03506 IF WRK-DATE-2 = ALL-NINES-DATE DTSCS26 -03507 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 -03508 MOVE 'SPAN INFORMATION' TO WRK-MSG-TEXT DTSCS26 -03509 PERFORM S1901-ERROR THRU S1901-EXIT DTSCS26 -03510 PERFORM S2001-ERROR THRU S2001-EXIT DTSCS26 -03511 GO TO S2020-EXIT DTSCS26 -03512 ELSE DTSCS26 -03513 NEXT SENTENCE. DTSCS26 -03514 S2020-EXIT. DTSCS26 -03515 EXIT. DTSCS26 -03516 /*****************************************************************DTSCS26 -03517 * DTSCS26 -03518 ******************************************************************DTSCS26 -03519 S2100-INT-SPAN. DTSCS26 -03520 IF MAP-INT-SPAN-IND = LOW-VALUES DTSCS26 -03521 MOVE SPACES TO MAP-INT-SPAN-IND. DTSCS26 +03496 IF (MAP-DATE-1-MO-A = CATB-UNPROT-NORM-NUM-MDTON) DTSCS26 +03497 OR DTSCS26 +03498 (MAP-DATE-2-MO-A = CATB-UNPROT-NORM-NUM-MDTON) DTSCS26 +03499 GO TO S2020-EXIT. DTSCS26 +03500 DTSCS26 +03501 IF AADJ-DUE-DATE-88 DTSCS26 +03502 IF ((WRK-DATE-1 = +0) AND (WRK-DATE-2 = +0)) DTSCS26 +03503 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 +03504 MOVE 'SPAN INFORMATION' TO WRK-MSG-TEXT DTSCS26 +03505 PERFORM S1901-ERROR THRU S1901-EXIT DTSCS26 +03506 PERFORM S2001-ERROR THRU S2001-EXIT DTSCS26 +03507 GO TO S2020-EXIT DTSCS26 +03508 ELSE DTSCS26 +03509 GO TO S2020-EXIT. DTSCS26 +03510 DTSCS26 +03511 IF AADJ-WAIVE-DATE-88 OR AADJ-INT-DATE-88 DTSCS26 +03512 NEXT SENTENCE DTSCS26 +03513 ELSE DTSCS26 +03514 GO TO S2020-EXIT. DTSCS26 +03515 DTSCS26 +03516 IF WRK-DATE-2 < WRK-DATE-1 DTSCS26 +03517 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 +03518 MOVE 'SPAN INFORMATION' TO WRK-MSG-TEXT DTSCS26 +03519 PERFORM S1901-ERROR THRU S1901-EXIT DTSCS26 +03520 PERFORM S2001-ERROR THRU S2001-EXIT DTSCS26 +03521 GO TO S2020-EXIT. DTSCS26 03522 DTSCS26 -03523 IF MAP-INT-SPAN-IND = SPACES DTSCS26 -03524 NEXT SENTENCE DTSCS26 -03525 ELSE DTSCS26 -03526 IF NOT MAP-INT-SPAN-IND-VALID DTSCS26 -03527 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 -03528 MOVE 'SPAN INFORMATION' TO WRK-MSG-TEXT DTSCS26 -03529 PERFORM S2101-ERROR THRU S2101-EXIT DTSCS26 -03530 GO TO S2100-EXIT. DTSCS26 -03531 DTSCS26 -03532 PERFORM S2110-INT-SPAN-ADJ-TYPE-EDIT THRU S2110-EXIT. DTSCS26 -03533 S2100-EXIT. DTSCS26 -03534 EXIT. DTSCS26 -03535 DTSCS26 -03536 DTSCS26 -03537 DTSCS26 -03538 S2101-ERROR. DTSCS26 -03539 MOVE CATB-UNPROT-NORM-AN-MDTON DTSCS26 -03540 TO MAP-INT-SPAN-IND-A. DTSCS26 -03541 DTSCS26 -03542 IF LCCM-NO-MSG DTSCS26 -03543 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS26 -03544 MOVE CATB-CURSOR TO MAP-INT-SPAN-IND-L DTSCS26 -03545 SET CURSOR-SET-YES TO TRUE. DTSCS26 -03546 S2101-EXIT. DTSCS26 -03547 EXIT. DTSCS26 -03548 DTSCS26 +03523 IF WRK-DATE-1 = ALL-NINES-DATE DTSCS26 +03524 IF WRK-DATE-2 = ALL-NINES-DATE DTSCS26 +03525 NEXT SENTENCE DTSCS26 +03526 ELSE DTSCS26 +03527 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 +03528 MOVE 'SPAN INFORMATION' TO WRK-MSG-TEXT DTSCS26 +03529 PERFORM S1901-ERROR THRU S1901-EXIT DTSCS26 +03530 PERFORM S2001-ERROR THRU S2001-EXIT DTSCS26 +03531 GO TO S2020-EXIT DTSCS26 +03532 ELSE DTSCS26 +03533 IF WRK-DATE-2 = ALL-NINES-DATE DTSCS26 +03534 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 +03535 MOVE 'SPAN INFORMATION' TO WRK-MSG-TEXT DTSCS26 +03536 PERFORM S1901-ERROR THRU S1901-EXIT DTSCS26 +03537 PERFORM S2001-ERROR THRU S2001-EXIT DTSCS26 +03538 GO TO S2020-EXIT DTSCS26 +03539 ELSE DTSCS26 +03540 NEXT SENTENCE. DTSCS26 +03541 S2020-EXIT. DTSCS26 +03542 EXIT. DTSCS26 +03543 /*****************************************************************DTSCS26 +03544 * DTSCS26 +03545 ******************************************************************DTSCS26 +03546 S2100-INT-SPAN. DTSCS26 +03547 IF MAP-INT-SPAN-IND = LOW-VALUES DTSCS26 +03548 MOVE SPACES TO MAP-INT-SPAN-IND. DTSCS26 03549 DTSCS26 -03550 DTSCS26 -03551 S2110-INT-SPAN-ADJ-TYPE-EDIT. DTSCS26 -03552 IF AADJ-ADJ-TYPE = SPACES DTSCS26 -03553 GO TO S2110-EXIT. DTSCS26 -03554 DTSCS26 -03555 IF AADJ-INT-DATE-88 DTSCS26 -03556 IF MAP-INT-SPAN-IND = SPACES DTSCS26 -03557 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 -03558 MOVE 'RPT/PAY/ADJ TYPE}{SPAN INFORMATION' DTSCS26 -03559 TO WRK-MSG-TEXT DTSCS26 -03560 PERFORM S2101-ERROR THRU S2101-EXIT DTSCS26 -03561 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS26 -03562 ELSE DTSCS26 -03563 NEXT SENTENCE DTSCS26 -03564 ELSE DTSCS26 -03565 IF MAP-INT-SPAN-IND = SPACE DTSCS26 -03566 NEXT SENTENCE DTSCS26 -03567 ELSE DTSCS26 -03568 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 -03569 MOVE 'RPT/PAY/ADJ TYPE}{SPAN INFORMATION' DTSCS26 -03570 TO WRK-MSG-TEXT DTSCS26 -03571 PERFORM S2101-ERROR THRU S2101-EXIT DTSCS26 -03572 PERFORM S1201-ERROR THRU S1201-EXIT. DTSCS26 -03573 S2110-EXIT. DTSCS26 +03550 IF MAP-INT-SPAN-IND = SPACES DTSCS26 +03551 NEXT SENTENCE DTSCS26 +03552 ELSE DTSCS26 +03553 IF NOT MAP-INT-SPAN-IND-VALID DTSCS26 +03554 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 +03555 MOVE 'SPAN INFORMATION' TO WRK-MSG-TEXT DTSCS26 +03556 PERFORM S2101-ERROR THRU S2101-EXIT DTSCS26 +03557 GO TO S2100-EXIT. DTSCS26 +03558 DTSCS26 +03559 PERFORM S2110-INT-SPAN-ADJ-TYPE-EDIT THRU S2110-EXIT. DTSCS26 +03560 S2100-EXIT. DTSCS26 +03561 EXIT. DTSCS26 +03562 DTSCS26 +03563 DTSCS26 +03564 DTSCS26 +03565 S2101-ERROR. DTSCS26 +03566 MOVE CATB-UNPROT-NORM-AN-MDTON DTSCS26 +03567 TO MAP-INT-SPAN-IND-A. DTSCS26 +03568 DTSCS26 +03569 IF LCCM-NO-MSG DTSCS26 +03570 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS26 +03571 MOVE CATB-CURSOR TO MAP-INT-SPAN-IND-L DTSCS26 +03572 SET CURSOR-SET-YES TO TRUE. DTSCS26 +03573 S2101-EXIT. DTSCS26 03574 EXIT. DTSCS26 -03575 /*****************************************************************DTSCS26 -03576 * DTSCS26 -03577 ******************************************************************DTSCS26 -03578 S2200-INT-RATE. DTSCS26 -03579 MOVE MAP-INT-RATE-AREA TO L012-S-RATE-AREA. DTSCS26 -03580 DTSCS26 -03581 PERFORM S012-RATE-FROM-SCREEN THRU S012-EXIT. DTSCS26 -03582 DTSCS26 -03583 IF L012-NO-ENTRY DTSCS26 -03584 NEXT SENTENCE DTSCS26 -03585 ELSE DTSCS26 -03586 IF L012-NOT-VALID DTSCS26 -03587 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 -03588 MOVE 'SPAN INFORMATION' TO WRK-MSG-TEXT DTSCS26 -03589 PERFORM S2201-ERROR THRU S2201-EXIT DTSCS26 -03590 GO TO S2200-EXIT DTSCS26 +03575 DTSCS26 +03576 DTSCS26 +03577 DTSCS26 +03578 S2110-INT-SPAN-ADJ-TYPE-EDIT. DTSCS26 +03579 IF AADJ-ADJ-TYPE = SPACES DTSCS26 +03580 GO TO S2110-EXIT. DTSCS26 +03581 DTSCS26 +03582 IF AADJ-INT-DATE-88 DTSCS26 +03583 IF MAP-INT-SPAN-IND = SPACES DTSCS26 +03584 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 +03585 MOVE 'RPT/PAY/ADJ TYPE}{SPAN INFORMATION' DTSCS26 +03586 TO WRK-MSG-TEXT DTSCS26 +03587 PERFORM S2101-ERROR THRU S2101-EXIT DTSCS26 +03588 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS26 +03589 ELSE DTSCS26 +03590 NEXT SENTENCE DTSCS26 03591 ELSE DTSCS26 -03592 MOVE L012-RATE TO L056-RATE DTSCS26 -03593 PERFORM S056-DISP1-LEFT THRU S056-EXIT DTSCS26 -03594 MOVE L056-DISP-RATE TO MAP-INT-RATE DTSCS26 -03595 MOVE L012-RATE TO WRK-INT-RATE. DTSCS26 -03596 DTSCS26 -03597 PERFORM S2210-INT-RATE-ADJ-TYPE-EDIT THRU S2210-EXIT. DTSCS26 -03598 S2200-EXIT. DTSCS26 -03599 EXIT. DTSCS26 -03600 DTSCS26 -03601 DTSCS26 -03602 DTSCS26 -03603 S2201-ERROR. DTSCS26 -03604 MOVE CATB-UNPROT-NORM-NUM-MDTON DTSCS26 -03605 TO MAP-INT-RATE-A. DTSCS26 -03606 DTSCS26 -03607 IF LCCM-NO-MSG DTSCS26 -03608 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS26 -03609 MOVE CATB-CURSOR TO MAP-INT-RATE-L DTSCS26 -03610 SET CURSOR-SET-YES TO TRUE. DTSCS26 -03611 S2201-EXIT. DTSCS26 -03612 EXIT. DTSCS26 -03613 DTSCS26 -03614 DTSCS26 -03615 DTSCS26 -03616 S2210-INT-RATE-ADJ-TYPE-EDIT. DTSCS26 -03617 IF AADJ-ADJ-TYPE = SPACES DTSCS26 -03618 GO TO S2210-EXIT. DTSCS26 +03592 IF MAP-INT-SPAN-IND = SPACE DTSCS26 +03593 NEXT SENTENCE DTSCS26 +03594 ELSE DTSCS26 +03595 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 +03596 MOVE 'RPT/PAY/ADJ TYPE}{SPAN INFORMATION' DTSCS26 +03597 TO WRK-MSG-TEXT DTSCS26 +03598 PERFORM S2101-ERROR THRU S2101-EXIT DTSCS26 +03599 PERFORM S1201-ERROR THRU S1201-EXIT. DTSCS26 +03600 S2110-EXIT. DTSCS26 +03601 EXIT. DTSCS26 +03602 /***************************************************************** CL**3 +03603 * CL**3 +03604 ****************************************************************** CL**3 +03605 S2111-WRITE-OFF. CL**3 +03606 MOVE WRK-EMP-NO TO L084-EMP-NO. CL**3 +03607 MOVE LCCM-CURR-RUN-DATE TO L084-CURR-RUN-DATE. CL**3 +03608 SET L084-WRITE-OFF-88 TO TRUE. CL**3 +03609 PERFORM S084-APPROVAL THRU S084-EXIT. CL**3 +03610 S2111-EXIT. CL**3 +03611 EXIT. CL**3 +03612 /*****************************************************************DTSCS26 +03613 * DTSCS26 +03614 ******************************************************************DTSCS26 +03615 S2200-INT-RATE. DTSCS26 +03616 MOVE MAP-INT-RATE-AREA TO L012-S-RATE-AREA. DTSCS26 +03617 DTSCS26 +03618 PERFORM S012-RATE-FROM-SCREEN THRU S012-EXIT. DTSCS26 03619 DTSCS26 -03620 IF AADJ-INT-DATE-88 DTSCS26 -03621 IF WRK-DATE-1 = ALL-NINES-DATE DTSCS26 -03622 IF WRK-INT-NO-ENTRY-88 DTSCS26 -03623 NEXT SENTENCE DTSCS26 -03624 ELSE DTSCS26 -03625 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 -03626 MOVE 'SPAN INFORMATION' TO WRK-MSG-TEXT DTSCS26 -03627 PERFORM S2201-ERROR THRU S2201-EXIT DTSCS26 -03628 PERFORM S1901-ERROR THRU S1901-EXIT DTSCS26 -03629 ELSE DTSCS26 -03630 IF WRK-INT-NO-ENTRY-88 DTSCS26 -03631 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 -03632 MOVE 'RPT/PAY/ADJ TYPE}{SPAN INFORMATION' DTSCS26 -03633 TO WRK-MSG-TEXT DTSCS26 -03634 PERFORM S2201-ERROR THRU S2201-EXIT DTSCS26 -03635 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS26 -03636 ELSE DTSCS26 -03637 NEXT SENTENCE DTSCS26 -03638 ELSE DTSCS26 -03639 IF WRK-INT-NO-ENTRY-88 DTSCS26 -03640 NEXT SENTENCE DTSCS26 -03641 ELSE DTSCS26 -03642 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 -03643 MOVE 'SPAN INFORMATION' TO WRK-MSG-TEXT DTSCS26 -03644 PERFORM S2201-ERROR THRU S2201-EXIT DTSCS26 -03645 PERFORM S1901-ERROR THRU S1901-EXIT. DTSCS26 -03646 S2210-EXIT. DTSCS26 -03647 EXIT. DTSCS26 -03648 /*****************************************************************DTSCS26 -03649 * DTSCS26 -03650 ******************************************************************DTSCS26 -03651 S2300-RECEIVED-DATE. DTSCS26 -03652 MOVE MAP-RECEIVED-DATE-AREA TO L015-S-DATE-AREA. DTSCS26 -03653 DTSCS26 -03654 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS26 -03655 DTSCS26 -03656 IF L015-NO-ENTRY DTSCS26 -03657 NEXT SENTENCE DTSCS26 -03658 ELSE DTSCS26 -03659 IF L015-NOT-VALID DTSCS26 -03660 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 -03661 MOVE 'RECEIVED DATE' TO WRK-MSG-TEXT DTSCS26 -03662 PERFORM S2301-ERROR THRU S2301-EXIT DTSCS26 -03663 ELSE DTSCS26 -03664 MOVE L015-DATE TO WRK-RECEIVED-DATE. DTSCS26 -03665 S2300-EXIT. DTSCS26 -03666 EXIT. DTSCS26 -03667 DTSCS26 -03668 DTSCS26 -03669 DTSCS26 -03670 S2301-ERROR. DTSCS26 -03671 MOVE CATB-UNPROT-NORM-NUM-MDTON DTSCS26 -03672 TO MAP-RECEIVED-DATE-MO-A DTSCS26 -03673 MAP-RECEIVED-DATE-DA-A DTSCS26 -03674 MAP-RECEIVED-DATE-YR-A. DTSCS26 -03675 DTSCS26 -03676 IF LCCM-NO-MSG DTSCS26 -03677 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS26 -03678 MOVE CATB-CURSOR TO MAP-RECEIVED-DATE-MO-L DTSCS26 -03679 SET CURSOR-SET-YES TO TRUE. DTSCS26 -03680 S2301-EXIT. DTSCS26 -03681 EXIT. DTSCS26 -03682 /*****************************************************************DTSCS26 -03683 * DTSCS26 -03684 ******************************************************************DTSCS26 -03685 S2400-RESPONSIBLE-ACTIVITY. DTSCS26 -03686 IF MAP-RESPONSIBLE-ACTIVITY = SPACES OR LOW-VALUES DTSCS26 -03687 SET MAP-RESP-ACTIVITY-VOL-88 TO TRUE. DTSCS26 -03688 DTSCS26 -03689 IF MAP-RESP-ACTIVITY-VOL-88 DTSCS26 -03690 GO TO S2400-EXIT. DTSCS26 -03691 DTSCS26 -03692 MOVE MAP-RESPONSIBLE-ACTIVITY TO L032-CD-3. DTSCS26 -03693 DTSCS26 -03694 PERFORM S032-AADJ-RESPONSIBLE-ACTIVITY THRU S032-EXIT. DTSCS26 -03695 DTSCS26 -03696 IF L032-VALID DTSCS26 -03697 NEXT SENTENCE DTSCS26 -03698 ELSE DTSCS26 -03699 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 -03700 MOVE 'RESPONSIBLE ACTIVITY' TO WRK-MSG-TEXT DTSCS26 -03701 PERFORM S2401-ERROR THRU S2401-EXIT DTSCS26 -03702 GO TO S2400-EXIT. DTSCS26 -03703 S2400-EXIT. DTSCS26 -03704 EXIT. DTSCS26 +03620 IF L012-NO-ENTRY DTSCS26 +03621 NEXT SENTENCE DTSCS26 +03622 ELSE DTSCS26 +03623 IF L012-NOT-VALID DTSCS26 +03624 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 +03625 MOVE 'SPAN INFORMATION' TO WRK-MSG-TEXT DTSCS26 +03626 PERFORM S2201-ERROR THRU S2201-EXIT DTSCS26 +03627 GO TO S2200-EXIT DTSCS26 +03628 ELSE DTSCS26 +03629 MOVE L012-RATE TO L056-RATE DTSCS26 +03630 PERFORM S056-DISP1-LEFT THRU S056-EXIT DTSCS26 +03631 MOVE L056-DISP-RATE TO MAP-INT-RATE DTSCS26 +03632 MOVE L012-RATE TO WRK-INT-RATE. DTSCS26 +03633 DTSCS26 +03634 PERFORM S2210-INT-RATE-ADJ-TYPE-EDIT THRU S2210-EXIT. DTSCS26 +03635 S2200-EXIT. DTSCS26 +03636 EXIT. DTSCS26 +03637 DTSCS26 +03638 DTSCS26 +03639 DTSCS26 +03640 S2201-ERROR. DTSCS26 +03641 MOVE CATB-UNPROT-NORM-NUM-MDTON DTSCS26 +03642 TO MAP-INT-RATE-A. DTSCS26 +03643 DTSCS26 +03644 IF LCCM-NO-MSG DTSCS26 +03645 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS26 +03646 MOVE CATB-CURSOR TO MAP-INT-RATE-L DTSCS26 +03647 SET CURSOR-SET-YES TO TRUE. DTSCS26 +03648 S2201-EXIT. DTSCS26 +03649 EXIT. DTSCS26 +03650 DTSCS26 +03651 DTSCS26 +03652 DTSCS26 +03653 S2210-INT-RATE-ADJ-TYPE-EDIT. DTSCS26 +03654 IF AADJ-ADJ-TYPE = SPACES DTSCS26 +03655 GO TO S2210-EXIT. DTSCS26 +03656 DTSCS26 +03657 IF AADJ-INT-DATE-88 DTSCS26 +03658 IF WRK-DATE-1 = ALL-NINES-DATE DTSCS26 +03659 IF WRK-INT-NO-ENTRY-88 DTSCS26 +03660 NEXT SENTENCE DTSCS26 +03661 ELSE DTSCS26 +03662 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 +03663 MOVE 'SPAN INFORMATION' TO WRK-MSG-TEXT DTSCS26 +03664 PERFORM S2201-ERROR THRU S2201-EXIT DTSCS26 +03665 PERFORM S1901-ERROR THRU S1901-EXIT DTSCS26 +03666 ELSE DTSCS26 +03667 IF WRK-INT-NO-ENTRY-88 DTSCS26 +03668 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 +03669 MOVE 'RPT/PAY/ADJ TYPE}{SPAN INFORMATION' DTSCS26 +03670 TO WRK-MSG-TEXT DTSCS26 +03671 PERFORM S2201-ERROR THRU S2201-EXIT DTSCS26 +03672 PERFORM S1201-ERROR THRU S1201-EXIT DTSCS26 +03673 ELSE DTSCS26 +03674 NEXT SENTENCE DTSCS26 +03675 ELSE DTSCS26 +03676 IF WRK-INT-NO-ENTRY-88 DTSCS26 +03677 NEXT SENTENCE DTSCS26 +03678 ELSE DTSCS26 +03679 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 +03680 MOVE 'SPAN INFORMATION' TO WRK-MSG-TEXT DTSCS26 +03681 PERFORM S2201-ERROR THRU S2201-EXIT DTSCS26 +03682 PERFORM S1901-ERROR THRU S1901-EXIT. DTSCS26 +03683 S2210-EXIT. DTSCS26 +03684 EXIT. DTSCS26 +03685 /*****************************************************************DTSCS26 +03686 * DTSCS26 +03687 ******************************************************************DTSCS26 +03688 S2300-RECEIVED-DATE. DTSCS26 +03689 MOVE MAP-RECEIVED-DATE-AREA TO L015-S-DATE-AREA. DTSCS26 +03690 DTSCS26 +03691 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS26 +03692 DTSCS26 +03693 IF L015-NO-ENTRY DTSCS26 +03694 NEXT SENTENCE DTSCS26 +03695 ELSE DTSCS26 +03696 IF L015-NOT-VALID DTSCS26 +03697 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 +03698 MOVE 'RECEIVED DATE' TO WRK-MSG-TEXT DTSCS26 +03699 PERFORM S2301-ERROR THRU S2301-EXIT DTSCS26 +03700 ELSE DTSCS26 +03701 MOVE L015-DATE TO WRK-RECEIVED-DATE. DTSCS26 +03702 S2300-EXIT. DTSCS26 +03703 EXIT. DTSCS26 +03704 DTSCS26 03705 DTSCS26 03706 DTSCS26 -03707 DTSCS26 -03708 S2401-ERROR. DTSCS26 -03709 MOVE CATB-UNPROT-NORM-AN-MDTON DTSCS26 -03710 TO MAP-RESPONSIBLE-ACTIVITY-A. DTSCS26 -03711 DTSCS26 -03712 IF LCCM-NO-MSG DTSCS26 -03713 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS26 -03714 MOVE CATB-CURSOR TO MAP-RESPONSIBLE-ACTIVITY-L DTSCS26 -03715 SET CURSOR-SET-YES TO TRUE. DTSCS26 -03716 S2401-EXIT. DTSCS26 -03717 EXIT. DTSCS26 -03718 /*****************************************************************DTSCS26 -03719 * DTSCS26 -03720 ******************************************************************DTSCS26 -03721 S2500-RESPONSIBLE-OP-ID. DTSCS26 -03722 IF MAP-RESPONSIBLE-OP-ID = SPACES OR LOW-VALUES DTSCS26 -03723 MOVE SPACES TO MAP-RESPONSIBLE-OP-ID DTSCS26 -03724 GO TO S2500-EXIT. DTSCS26 +03707 S2301-ERROR. DTSCS26 +03708 MOVE CATB-UNPROT-NORM-NUM-MDTON DTSCS26 +03709 TO MAP-RECEIVED-DATE-MO-A DTSCS26 +03710 MAP-RECEIVED-DATE-DA-A DTSCS26 +03711 MAP-RECEIVED-DATE-YR-A. DTSCS26 +03712 DTSCS26 +03713 IF LCCM-NO-MSG DTSCS26 +03714 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS26 +03715 MOVE CATB-CURSOR TO MAP-RECEIVED-DATE-MO-L DTSCS26 +03716 SET CURSOR-SET-YES TO TRUE. DTSCS26 +03717 S2301-EXIT. DTSCS26 +03718 EXIT. DTSCS26 +03719 /*****************************************************************DTSCS26 +03720 * DTSCS26 +03721 ******************************************************************DTSCS26 +03722 S2400-RESPONSIBLE-ACTIVITY. DTSCS26 +03723 IF MAP-RESPONSIBLE-ACTIVITY = SPACES OR LOW-VALUES DTSCS26 +03724 SET MAP-RESP-ACTIVITY-VOL-88 TO TRUE. DTSCS26 03725 DTSCS26 03726 IF MAP-RESP-ACTIVITY-VOL-88 DTSCS26 -03727 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 -03728 MOVE 'RESPONSIBLE ACT/OPID' TO WRK-MSG-TEXT DTSCS26 -03729 PERFORM S2401-ERROR THRU S2401-EXIT DTSCS26 -03730 PERFORM S2501-ERROR THRU S2501-EXIT DTSCS26 -03731 GO TO S2500-EXIT. DTSCS26 +03727 GO TO S2400-EXIT. DTSCS26 +03728 DTSCS26 +03729 MOVE MAP-RESPONSIBLE-ACTIVITY TO L032-CD-3. DTSCS26 +03730 DTSCS26 +03731 PERFORM S032-AADJ-RESPONSIBLE-ACTIVITY THRU S032-EXIT. DTSCS26 03732 DTSCS26 -03733 MOVE MAP-RESPONSIBLE-OP-ID TO L082-OP-ID. DTSCS26 -03734 DTSCS26 -03735 PERFORM S082-OP-ID-LOOKUP THRU S082-EXIT. DTSCS26 -03736 DTSCS26 -03737 IF L082-NOT-VALID-OP DTSCS26 -03738 OR L082-INTERNAL-88 DTSCS26 -03739 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 -03740 MOVE 'RESPONSIBLE OPID' TO WRK-MSG-TEXT DTSCS26 -03741 PERFORM S2501-ERROR THRU S2501-EXIT DTSCS26 -03742 GO TO S2500-EXIT. DTSCS26 -03743 S2500-EXIT. DTSCS26 -03744 EXIT. DTSCS26 -03745 DTSCS26 -03746 DTSCS26 -03747 DTSCS26 -03748 S2501-ERROR. DTSCS26 -03749 MOVE CATB-UNPROT-NORM-AN-MDTON DTSCS26 -03750 TO MAP-RESPONSIBLE-OP-ID-A. DTSCS26 -03751 DTSCS26 -03752 IF LCCM-NO-MSG DTSCS26 -03753 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS26 -03754 MOVE CATB-CURSOR TO MAP-RESPONSIBLE-OP-ID-L DTSCS26 -03755 SET CURSOR-SET-YES TO TRUE. DTSCS26 -03756 S2501-EXIT. DTSCS26 -03757 EXIT. DTSCS26 -03758 /*****************************************************************DTSCS26 -03759 * DTSCS26 -03760 ******************************************************************DTSCS26 -03761 S2600-ENTRY-MODE. DTSCS26 -03762 IF MAP-ENTRY-MODE = LOW-VALUES OR SPACES DTSCS26 -03763 SET MAP-ENTRY-MODE-DEFAULT-88 TO TRUE DTSCS26 -03764 MOVE MAP-ENTRY-MODE TO LCCM-ENTRY-MODE DTSCS26 -03765 ELSE DTSCS26 -03766 IF MAP-ENTRY-MODE-VALID DTSCS26 -03767 MOVE MAP-ENTRY-MODE TO LCCM-ENTRY-MODE DTSCS26 -03768 ELSE DTSCS26 -03769 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS26 -03770 PERFORM S2601-ERROR THRU S2601-EXIT. DTSCS26 -03771 S2600-EXIT. DTSCS26 -03772 EXIT. DTSCS26 +03733 IF L032-VALID DTSCS26 +03734 NEXT SENTENCE DTSCS26 +03735 ELSE DTSCS26 +03736 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 +03737 MOVE 'RESPONSIBLE ACTIVITY' TO WRK-MSG-TEXT DTSCS26 +03738 PERFORM S2401-ERROR THRU S2401-EXIT DTSCS26 +03739 GO TO S2400-EXIT. DTSCS26 +03740 S2400-EXIT. DTSCS26 +03741 EXIT. DTSCS26 +03742 DTSCS26 +03743 DTSCS26 +03744 DTSCS26 +03745 S2401-ERROR. DTSCS26 +03746 MOVE CATB-UNPROT-NORM-AN-MDTON DTSCS26 +03747 TO MAP-RESPONSIBLE-ACTIVITY-A. DTSCS26 +03748 DTSCS26 +03749 IF LCCM-NO-MSG DTSCS26 +03750 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS26 +03751 MOVE CATB-CURSOR TO MAP-RESPONSIBLE-ACTIVITY-L DTSCS26 +03752 SET CURSOR-SET-YES TO TRUE. DTSCS26 +03753 S2401-EXIT. DTSCS26 +03754 EXIT. DTSCS26 +03755 /*****************************************************************DTSCS26 +03756 * DTSCS26 +03757 ******************************************************************DTSCS26 +03758 S2500-RESPONSIBLE-OP-ID. DTSCS26 +03759 IF MAP-RESPONSIBLE-OP-ID = SPACES OR LOW-VALUES DTSCS26 +03760 MOVE SPACES TO MAP-RESPONSIBLE-OP-ID DTSCS26 +03761 GO TO S2500-EXIT. DTSCS26 +03762 DTSCS26 +03763 IF MAP-RESP-ACTIVITY-VOL-88 DTSCS26 +03764 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 +03765 MOVE 'RESPONSIBLE ACT/OPID' TO WRK-MSG-TEXT DTSCS26 +03766 PERFORM S2401-ERROR THRU S2401-EXIT DTSCS26 +03767 PERFORM S2501-ERROR THRU S2501-EXIT DTSCS26 +03768 GO TO S2500-EXIT. DTSCS26 +03769 DTSCS26 +03770 MOVE MAP-RESPONSIBLE-OP-ID TO L082-OP-ID. DTSCS26 +03771 DTSCS26 +03772 PERFORM S082-OP-ID-LOOKUP THRU S082-EXIT. DTSCS26 03773 DTSCS26 -03774 DTSCS26 -03775 DTSCS26 -03776 S2601-ERROR. DTSCS26 -03777 MOVE CATB-UNPROT-NORM-NUM-MDTON DTSCS26 -03778 TO MAP-ENTRY-MODE-A. DTSCS26 -03779 DTSCS26 -03780 IF LCCM-NO-MSG DTSCS26 -03781 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS26 -03782 MOVE CATB-CURSOR TO MAP-ENTRY-MODE-L DTSCS26 -03783 SET CURSOR-SET-YES TO TRUE. DTSCS26 -03784 S2601-EXIT. DTSCS26 -03785 EXIT. DTSCS26 -03786 /*****************************************************************DTSCS26 -03787 * DTSCS26 -03788 ******************************************************************DTSCS26 -03789 S2700-DISREGARD-EDITS-IND. DTSCS26 -03790 IF MAP-DISREGARD-EDITS-IND = LOW-VALUES OR SPACES DTSCS26 -03791 SET MAP-DISREGARD-EDITS-NO-88 TO TRUE DTSCS26 -03792 ELSE DTSCS26 -03793 IF MAP-DISREGARD-EDITS-VALID-88 DTSCS26 -03794 NEXT SENTENCE DTSCS26 -03795 ELSE DTSCS26 -03796 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 -03797 MOVE 'DISREGARD EDITS' TO WRK-MSG-TEXT DTSCS26 -03798 PERFORM S2701-ERROR THRU S2701-EXIT. DTSCS26 -03799 S2700-EXIT. DTSCS26 -03800 EXIT. DTSCS26 -03801 DTSCS26 -03802 DTSCS26 -03803 DTSCS26 -03804 S2701-ERROR. DTSCS26 -03805 MOVE CATB-UNPROT-NORM-AN-MDTON DTSCS26 -03806 TO MAP-DISREGARD-EDITS-IND-A. DTSCS26 -03807 DTSCS26 -03808 IF LCCM-NO-MSG DTSCS26 -03809 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS26 -03810 MOVE CATB-CURSOR TO MAP-DISREGARD-EDITS-IND-L DTSCS26 -03811 SET CURSOR-SET-YES TO TRUE. DTSCS26 -03812 S2701-EXIT. DTSCS26 -03813 EXIT. DTSCS26 -03814 /*****************************************************************DTSCS26 -03815 * *DTSCS26 -03816 ******************************************************************DTSCS26 -03817 S4000-CROSS-EDITS. DTSCS26 -03818 MOVE MAP-ADJ-TYPE TO AADJ-ADJ-TYPE. DTSCS26 -03819 DTSCS26 -03820 MOVE WRK-APPLIC-IND TO AADJ-APPLIC-IND. DTSCS26 -03821 DTSCS26 -03822 MOVE WRK-APPLIC-DOC-NO TO AADJ-APPLIC-DOC-NO. DTSCS26 -03823 DTSCS26 -03824 MOVE WRK-AMT TO AADJ-AMT. DTSCS26 -03825 DTSCS26 -03826 MOVE WRK-DATE-1 TO AADJ-DATE-1. DTSCS26 -03827 DTSCS26 -03828 MOVE WRK-DATE-2 TO AADJ-DATE-2. DTSCS26 -03829 DTSCS26 -03830 DTSCS26 -03831 IF AADJ-CHARGE-88 DTSCS26 -03832 PERFORM S4100-CHARGE-EDIT THRU S4100-EXIT DTSCS26 -03833 ELSE DTSCS26 -03834 IF AADJ-WAIVE-88 DTSCS26 -03835 PERFORM S4200-WAIVE-EDIT THRU S4200-EXIT DTSCS26 -03836 ELSE DTSCS26 -03837 IF AADJ-TOLER-88 DTSCS26 -03838 PERFORM S4300-TOLER-EDIT THRU S4300-EXIT DTSCS26 -03839 ELSE DTSCS26 -03840 IF AADJ-AUTO-88 DTSCS26 -03841 PERFORM S4400-AUTO-EDIT THRU S4400-EXIT DTSCS26 -03842 ELSE DTSCS26 -03843 IF AADJ-MANUAL-88 DTSCS26 -03844 PERFORM S4500-MANUAL-EDIT THRU S4500-EXIT DTSCS26 -03845 ELSE DTSCS26 -03846 IF AADJ-DUE-DATE-88 DTSCS26 -03847 PERFORM S4600-DUE-DATE-EDIT THRU S4600-EXIT DTSCS26 -03848 ELSE DTSCS26 -03849 IF AADJ-WAIVE-DATE-88 DTSCS26 -03850 PERFORM S4700-WAIVE-DATE-EDIT THRU S4700-EXIT DTSCS26 -03851 ELSE DTSCS26 -03852 IF AADJ-INT-DATE-88 DTSCS26 -03853 PERFORM S4800-INT-DATE-EDIT THRU S4800-EXIT DTSCS26 -03854 ELSE DTSCS26 -03855 IF AADJ-WRITE-OFF-88 DTSCS26 -03856 PERFORM S6100-WRITE-OFF-EDIT THRU S6100-EXIT DTSCS26 -03857 ELSE DTSCS26 -03858 IF AADJ-WRITE-OFF-REV-88 DTSCS26 -03859 PERFORM S6200-WRITE-OFF-REV-EDIT THRU S6200-EXIT DTSCS26 -03860 ELSE DTSCS26 -03861 IF AADJ-WAGE-RPT-88 DTSCS26 -03862 PERFORM S4900-WAGE-RPT-EDIT THRU S4900-EXIT DTSCS26 -03863 ELSE DTSCS26 -03864 GO TO S899-ABEND. DTSCS26 -03865 DTSCS26 +03774 IF L082-NOT-VALID-OP DTSCS26 +03775 OR L082-INTERNAL-88 DTSCS26 +03776 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 +03777 MOVE 'RESPONSIBLE OPID' TO WRK-MSG-TEXT DTSCS26 +03778 PERFORM S2501-ERROR THRU S2501-EXIT DTSCS26 +03779 GO TO S2500-EXIT. DTSCS26 +03780 S2500-EXIT. DTSCS26 +03781 EXIT. DTSCS26 +03782 DTSCS26 +03783 DTSCS26 +03784 DTSCS26 +03785 S2501-ERROR. DTSCS26 +03786 MOVE CATB-UNPROT-NORM-AN-MDTON DTSCS26 +03787 TO MAP-RESPONSIBLE-OP-ID-A. DTSCS26 +03788 DTSCS26 +03789 IF LCCM-NO-MSG DTSCS26 +03790 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS26 +03791 MOVE CATB-CURSOR TO MAP-RESPONSIBLE-OP-ID-L DTSCS26 +03792 SET CURSOR-SET-YES TO TRUE. DTSCS26 +03793 S2501-EXIT. DTSCS26 +03794 EXIT. DTSCS26 +03795 /*****************************************************************DTSCS26 +03796 * DTSCS26 +03797 ******************************************************************DTSCS26 +03798 S2600-ENTRY-MODE. DTSCS26 +03799 IF MAP-ENTRY-MODE = LOW-VALUES OR SPACES DTSCS26 +03800 SET MAP-ENTRY-MODE-DEFAULT-88 TO TRUE DTSCS26 +03801 MOVE MAP-ENTRY-MODE TO LCCM-ENTRY-MODE DTSCS26 +03802 ELSE DTSCS26 +03803 IF MAP-ENTRY-MODE-VALID DTSCS26 +03804 MOVE MAP-ENTRY-MODE TO LCCM-ENTRY-MODE DTSCS26 +03805 ELSE DTSCS26 +03806 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS26 +03807 PERFORM S2601-ERROR THRU S2601-EXIT. DTSCS26 +03808 S2600-EXIT. DTSCS26 +03809 EXIT. DTSCS26 +03810 DTSCS26 +03811 DTSCS26 +03812 DTSCS26 +03813 S2601-ERROR. DTSCS26 +03814 MOVE CATB-UNPROT-NORM-NUM-MDTON DTSCS26 +03815 TO MAP-ENTRY-MODE-A. DTSCS26 +03816 DTSCS26 +03817 IF LCCM-NO-MSG DTSCS26 +03818 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS26 +03819 MOVE CATB-CURSOR TO MAP-ENTRY-MODE-L DTSCS26 +03820 SET CURSOR-SET-YES TO TRUE. DTSCS26 +03821 S2601-EXIT. DTSCS26 +03822 EXIT. DTSCS26 +03823 /*****************************************************************DTSCS26 +03824 * DTSCS26 +03825 ******************************************************************DTSCS26 +03826 S2700-DISREGARD-EDITS-IND. DTSCS26 +03827 IF MAP-DISREGARD-EDITS-IND = LOW-VALUES OR SPACES DTSCS26 +03828 SET MAP-DISREGARD-EDITS-NO-88 TO TRUE DTSCS26 +03829 ELSE DTSCS26 +03830 IF MAP-DISREGARD-EDITS-VALID-88 DTSCS26 +03831 NEXT SENTENCE DTSCS26 +03832 ELSE DTSCS26 +03833 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 +03834 MOVE 'DISREGARD EDITS' TO WRK-MSG-TEXT DTSCS26 +03835 PERFORM S2701-ERROR THRU S2701-EXIT. DTSCS26 +03836 S2700-EXIT. DTSCS26 +03837 EXIT. DTSCS26 +03838 DTSCS26 +03839 DTSCS26 +03840 DTSCS26 +03841 S2701-ERROR. DTSCS26 +03842 MOVE CATB-UNPROT-NORM-AN-MDTON DTSCS26 +03843 TO MAP-DISREGARD-EDITS-IND-A. DTSCS26 +03844 DTSCS26 +03845 IF LCCM-NO-MSG DTSCS26 +03846 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS26 +03847 MOVE CATB-CURSOR TO MAP-DISREGARD-EDITS-IND-L DTSCS26 +03848 SET CURSOR-SET-YES TO TRUE. DTSCS26 +03849 S2701-EXIT. DTSCS26 +03850 EXIT. DTSCS26 +03851 /*****************************************************************DTSCS26 +03852 * *DTSCS26 +03853 ******************************************************************DTSCS26 +03854 S4000-CROSS-EDITS. DTSCS26 +03855 MOVE MAP-ADJ-TYPE TO AADJ-ADJ-TYPE. DTSCS26 +03856 DTSCS26 +03857 MOVE WRK-APPLIC-IND TO AADJ-APPLIC-IND. DTSCS26 +03858 DTSCS26 +03859 MOVE WRK-APPLIC-DOC-NO TO AADJ-APPLIC-DOC-NO. DTSCS26 +03860 DTSCS26 +03861 MOVE WRK-AMT TO AADJ-AMT. DTSCS26 +03862 DTSCS26 +03863 MOVE WRK-DATE-1 TO AADJ-DATE-1. DTSCS26 +03864 DTSCS26 +03865 MOVE WRK-DATE-2 TO AADJ-DATE-2. DTSCS26 03866 DTSCS26 -03867 PERFORM S6300-RCV-DATE-EDITS THRU S6300-EXIT. DTSCS26 -03868 DTSCS26 -03869 DTSCS26 -03870 PERFORM S6700-LAST-ARCHIVED-YRQ-EDIT THRU S6700-EXIT. DTSCS26 -03871 DTSCS26 -03872 DTSCS26 -03873 PERFORM S6800-NEVER-SUBJECT-EDIT THRU S6800-EXIT. DTSCS26 -03874 DTSCS26 -03875 IF AADJ-WRITE-OFF-88 OR AADJ-WRITE-OFF-REV-88 DTSCS26 -03876 NEXT SENTENCE DTSCS26 -03877 ELSE DTSCS26 -03878 PERFORM S6900-WRITTEN-OFF-EDIT THRU S6900-EXIT. DTSCS26 -03879 S4000-EXIT. DTSCS26 -03880 EXIT. DTSCS26 -03881 EJECT DTSCS26 -03882 S4100-CHARGE-EDIT. DTSCS26 -03883 PERFORM S7100-READ-APPLIC-YRQ THRU S7100-EXIT. DTSCS26 -03884 IF LCCM-MSG DTSCS26 -03885 GO TO S4100-EXIT DTSCS26 -03886 END-IF. DTSCS26 -03887 DTSCS26 -03888 IF WRK-MQTR-EXISTS-IND = 'N' DTSCS26 -03889 PERFORM S4110-NO-MQTR-REC THRU S4110-EXIT DTSCS26 -03890 ELSE DTSCS26 -03891 PERFORM S4120-MQTR-REC THRU S4120-EXIT. DTSCS26 -03892 S4100-EXIT. DTSCS26 -03893 EXIT. DTSCS26 -03894 DTSCS26 -03895 DTSCS26 -03896 DTSCS26 -03897 S4110-NO-MQTR-REC. DTSCS26 -03898 IF AADJ-AMT > +0 DTSCS26 -03899 NEXT SENTENCE DTSCS26 +03867 DTSCS26 +03868 IF AADJ-CHARGE-88 DTSCS26 +03869 PERFORM S4100-CHARGE-EDIT THRU S4100-EXIT DTSCS26 +03870 ELSE DTSCS26 +03871 IF AADJ-WAIVE-88 DTSCS26 +03872 PERFORM S4200-WAIVE-EDIT THRU S4200-EXIT DTSCS26 +03873 ELSE DTSCS26 +03874 IF AADJ-TOLER-88 DTSCS26 +03875 PERFORM S4300-TOLER-EDIT THRU S4300-EXIT DTSCS26 +03876 ELSE DTSCS26 +03877 IF AADJ-AUTO-88 DTSCS26 +03878 PERFORM S4400-AUTO-EDIT THRU S4400-EXIT DTSCS26 +03879 ELSE DTSCS26 +03880 IF AADJ-MANUAL-88 DTSCS26 +03881 PERFORM S4500-MANUAL-EDIT THRU S4500-EXIT DTSCS26 +03882 ELSE DTSCS26 +03883 IF AADJ-DUE-DATE-88 DTSCS26 +03884 PERFORM S4600-DUE-DATE-EDIT THRU S4600-EXIT DTSCS26 +03885 ELSE DTSCS26 +03886 IF AADJ-WAIVE-DATE-88 DTSCS26 +03887 PERFORM S4700-WAIVE-DATE-EDIT THRU S4700-EXIT DTSCS26 +03888 ELSE DTSCS26 +03889 IF AADJ-INT-DATE-88 DTSCS26 +03890 PERFORM S4800-INT-DATE-EDIT THRU S4800-EXIT DTSCS26 +03891 ELSE DTSCS26 +03892 IF AADJ-WRITE-OFF-88 DTSCS26 +03893 PERFORM S6100-WRITE-OFF-EDIT THRU S6100-EXIT DTSCS26 +03894 ELSE DTSCS26 +03895 IF AADJ-WRITE-OFF-REV-88 DTSCS26 +03896 PERFORM S6200-WRITE-OFF-REV-EDIT THRU S6200-EXIT DTSCS26 +03897 ELSE DTSCS26 +03898 IF AADJ-WAGE-RPT-88 DTSCS26 +03899 PERFORM S4900-WAGE-RPT-EDIT THRU S4900-EXIT DTSCS26 03900 ELSE DTSCS26 -03901 MOVE MSG-E263-AREA TO WRK-MSG-AREA DTSCS26 -03902 PERFORM S1501-ERROR THRU S1501-EXIT DTSCS26 -03903 GO TO S4110-EXIT. DTSCS26 -03904 DTSCS26 -03905 IF WRK-APPLIC-YRQ = LCCM-PICKUP-YRQ DTSCS26 -03906 GO TO S4110-EXIT. DTSCS26 -03907 DTSCS26 -03908 IF AADJ-UI-88 OR AADJ-NSF-PEN-88 OR AADJ-MISC-PEN-88 DTSCS26 -03909 OR AADJ-LATE-PEN-88 DTSCS26 -03910 NEXT SENTENCE DTSCS26 -03911 ELSE DTSCS26 -03912 MOVE MSG-E263-AREA TO WRK-MSG-AREA DTSCS26 -03913 PERFORM S1701-ERROR THRU S1701-EXIT DTSCS26 -03914 GO TO S4110-EXIT. DTSCS26 -03915 DTSCS26 -03916 IF AADJ-UI-88 DTSCS26 -03917 IF MPRF-CLASS-SELF-INS-88 DTSCS26 -03918 NEXT SENTENCE DTSCS26 -03919 ELSE DTSCS26 -03920 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 -03921 MOVE 'RPT/PAY/ADJ TYPE' TO WRK-MSG-TEXT DTSCS26 -03922 PERFORM S1701-ERROR THRU S1701-EXIT DTSCS26 -03923 GO TO S4110-EXIT. DTSCS26 -03924 S4110-EXIT. DTSCS26 -03925 EXIT. DTSCS26 -03926 DTSCS26 -03927 DTSCS26 -03928 DTSCS26 -03929 S4120-MQTR-REC. DTSCS26 -03930 IF WRK-APPLIC-YRQ = LCCM-PICKUP-YRQ DTSCS26 -03931 NEXT SENTENCE DTSCS26 -03932 ELSE DTSCS26 -03933 IF AADJ-UI-88 OR AADJ-INT-88 OR AADJ-LATE-PEN-88 DTSCS26 -03934 OR AADJ-NSF-PEN-88 OR AADJ-MISC-PEN-88 DTSCS26 -03935 OR AADJ-SUR-88 DTSCS26 +03901 GO TO S899-ABEND. DTSCS26 +03902 DTSCS26 +03903 DTSCS26 +03904 PERFORM S6300-RCV-DATE-EDITS THRU S6300-EXIT. DTSCS26 +03905 DTSCS26 +03906 DTSCS26 +03907 PERFORM S6700-LAST-ARCHIVED-YRQ-EDIT THRU S6700-EXIT. DTSCS26 +03908 DTSCS26 +03909 DTSCS26 +03910 PERFORM S6800-NEVER-SUBJECT-EDIT THRU S6800-EXIT. DTSCS26 +03911 DTSCS26 +03912 IF AADJ-WRITE-OFF-88 OR AADJ-WRITE-OFF-REV-88 DTSCS26 +03913 NEXT SENTENCE DTSCS26 +03914 ELSE DTSCS26 +03915 PERFORM S6900-WRITTEN-OFF-EDIT THRU S6900-EXIT. DTSCS26 +03916 S4000-EXIT. DTSCS26 +03917 EXIT. DTSCS26 +03918 EJECT DTSCS26 +03919 S4100-CHARGE-EDIT. DTSCS26 +03920 PERFORM S7100-READ-APPLIC-YRQ THRU S7100-EXIT. DTSCS26 +03921 IF LCCM-MSG DTSCS26 +03922 GO TO S4100-EXIT DTSCS26 +03923 END-IF. DTSCS26 +03924 DTSCS26 +03925 IF WRK-MQTR-EXISTS-IND = 'N' DTSCS26 +03926 PERFORM S4110-NO-MQTR-REC THRU S4110-EXIT DTSCS26 +03927 ELSE DTSCS26 +03928 PERFORM S4120-MQTR-REC THRU S4120-EXIT. DTSCS26 +03929 S4100-EXIT. DTSCS26 +03930 EXIT. DTSCS26 +03931 DTSCS26 +03932 DTSCS26 +03933 DTSCS26 +03934 S4110-NO-MQTR-REC. DTSCS26 +03935 IF AADJ-AMT > +0 DTSCS26 03936 NEXT SENTENCE DTSCS26 03937 ELSE DTSCS26 03938 MOVE MSG-E263-AREA TO WRK-MSG-AREA DTSCS26 -03939 PERFORM S1701-ERROR THRU S1701-EXIT DTSCS26 -03940 GO TO S4120-EXIT. DTSCS26 +03939 PERFORM S1501-ERROR THRU S1501-EXIT DTSCS26 +03940 GO TO S4110-EXIT. DTSCS26 03941 DTSCS26 -03942 DTSCS26 -03943 MOVE AADJ-AMT TO WRK-CHARGED-AMT. DTSCS26 +03942 IF WRK-APPLIC-YRQ = LCCM-PICKUP-YRQ DTSCS26 +03943 GO TO S4110-EXIT. DTSCS26 03944 DTSCS26 -03945 PERFORM S4121-MQTR-ACCT-SCAN THRU S4121-EXIT DTSCS26 -03946 VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSCS26 -03947 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT. DTSCS26 -03948 DTSCS26 -03949 IF WRK-CHARGED-AMT < +0 DTSCS26 -03950 MOVE MSG-E263-AREA TO WRK-MSG-AREA DTSCS26 -03951 PERFORM S1701-ERROR THRU S1701-EXIT DTSCS26 -03952 GO TO S4120-EXIT. DTSCS26 -03953 DTSCS26 -03954 DTSCS26 -03955 IF MPRF-CLASS-SELF-INS-88 DTSCS26 -03956 PERFORM S4122-SELF-INS-EDIT THRU S4122-EXIT DTSCS26 -03957 ELSE DTSCS26 -03958 PERFORM S4123-TAXED-EDIT THRU S4123-EXIT. DTSCS26 -03959 S4120-EXIT. DTSCS26 -03960 EXIT. DTSCS26 -03961 DTSCS26 -03962 DTSCS26 +03945 IF AADJ-UI-88 OR AADJ-NSF-PEN-88 OR AADJ-MISC-PEN-88 DTSCS26 +03946 OR AADJ-LATE-PEN-88 DTSCS26 +03947 NEXT SENTENCE DTSCS26 +03948 ELSE DTSCS26 +03949 MOVE MSG-E263-AREA TO WRK-MSG-AREA DTSCS26 +03950 PERFORM S1701-ERROR THRU S1701-EXIT DTSCS26 +03951 GO TO S4110-EXIT. DTSCS26 +03952 DTSCS26 +03953 IF AADJ-UI-88 DTSCS26 +03954 IF MPRF-CLASS-SELF-INS-88 DTSCS26 +03955 NEXT SENTENCE DTSCS26 +03956 ELSE DTSCS26 +03957 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 +03958 MOVE 'RPT/PAY/ADJ TYPE' TO WRK-MSG-TEXT DTSCS26 +03959 PERFORM S1701-ERROR THRU S1701-EXIT DTSCS26 +03960 GO TO S4110-EXIT. DTSCS26 +03961 S4110-EXIT. DTSCS26 +03962 EXIT. DTSCS26 03963 DTSCS26 -03964 S4121-MQTR-ACCT-SCAN. DTSCS26 -03965 IF MQTR-ACCT-IND (MQTR-ACCT-IDX) = AADJ-APPLIC-IND DTSCS26 -03966 ADD MQTR-CHARGED-AMT (MQTR-ACCT-IDX) DTSCS26 -03967 TO WRK-CHARGED-AMT. DTSCS26 -03968 S4121-EXIT. DTSCS26 -03969 EXIT. DTSCS26 -03970 DTSCS26 -03971 DTSCS26 -03972 DTSCS26 -03973 S4122-SELF-INS-EDIT. DTSCS26 -03974 IF WRK-CHARGED-AMT = +0 DTSCS26 -03975 GO TO S4122-EXIT. DTSCS26 -03976 DTSCS26 -03977 IF WRK-APPLIC-YRQ = LCCM-PICKUP-YRQ DTSCS26 -03978 GO TO S4122-EXIT. DTSCS26 +03964 DTSCS26 +03965 DTSCS26 +03966 S4120-MQTR-REC. DTSCS26 +03967 IF WRK-APPLIC-YRQ = LCCM-PICKUP-YRQ DTSCS26 +03968 NEXT SENTENCE DTSCS26 +03969 ELSE DTSCS26 +03970 IF AADJ-UI-88 OR AADJ-INT-88 OR AADJ-LATE-PEN-88 DTSCS26 +03971 OR AADJ-NSF-PEN-88 OR AADJ-MISC-PEN-88 DTSCS26 +03972 OR AADJ-SUR-88 DTSCS26 +03973 NEXT SENTENCE DTSCS26 +03974 ELSE DTSCS26 +03975 MOVE MSG-E263-AREA TO WRK-MSG-AREA DTSCS26 +03976 PERFORM S1701-ERROR THRU S1701-EXIT DTSCS26 +03977 GO TO S4120-EXIT. DTSCS26 +03978 DTSCS26 03979 DTSCS26 -03980 MOVE +0 TO WRK-CHARGED-AMT. DTSCS26 +03980 MOVE AADJ-AMT TO WRK-CHARGED-AMT. DTSCS26 03981 DTSCS26 -03982 PERFORM DTSCS26 -03983 VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSCS26 -03984 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT DTSCS26 -03985 IF MQTR-ACCT-TAX-88 (MQTR-ACCT-IDX) DTSCS26 -03986 MOVE MQTR-CHARGED-AMT (MQTR-ACCT-IDX) DTSCS26 -03987 TO WRK-CHARGED-AMT DTSCS26 -03988 END-IF DTSCS26 -03989 END-PERFORM. DTSCS26 +03982 PERFORM S4121-MQTR-ACCT-SCAN THRU S4121-EXIT DTSCS26 +03983 VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSCS26 +03984 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT. DTSCS26 +03985 DTSCS26 +03986 IF WRK-CHARGED-AMT < +0 DTSCS26 +03987 MOVE MSG-E263-AREA TO WRK-MSG-AREA DTSCS26 +03988 PERFORM S1701-ERROR THRU S1701-EXIT DTSCS26 +03989 GO TO S4120-EXIT. DTSCS26 03990 DTSCS26 -03991 IF WRK-CHARGED-AMT = +0 DTSCS26 -03992 IF AADJ-INT-88 DTSCS26 -03993 MOVE MSG-E263-AREA TO WRK-MSG-AREA DTSCS26 -03994 PERFORM S1701-ERROR THRU S1701-EXIT DTSCS26 -03995 GO TO S4122-EXIT. DTSCS26 -03996 S4122-EXIT. DTSCS26 +03991 DTSCS26 +03992 IF MPRF-CLASS-SELF-INS-88 DTSCS26 +03993 PERFORM S4122-SELF-INS-EDIT THRU S4122-EXIT DTSCS26 +03994 ELSE DTSCS26 +03995 PERFORM S4123-TAXED-EDIT THRU S4123-EXIT. DTSCS26 +03996 S4120-EXIT. DTSCS26 03997 EXIT. DTSCS26 03998 DTSCS26 03999 DTSCS26 04000 DTSCS26 -04001 S4123-TAXED-EDIT. DTSCS26 -04002 IF WRK-APPLIC-YRQ = LCCM-PICKUP-YRQ DTSCS26 -04003 GO TO S4123-EXIT. DTSCS26 -04004 DTSCS26 -04005 IF AADJ-UI-88 DTSCS26 -04006 OR AADJ-SUR-88 DTSCS26 -04007 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 -04008 MOVE 'RPT/PAY/ADJ TYPE' TO WRK-MSG-TEXT DTSCS26 -04009 PERFORM S1701-ERROR THRU S1701-EXIT DTSCS26 -04010 GO TO S4123-EXIT. DTSCS26 -04011 DTSCS26 -04012 IF WRK-CHARGED-AMT = +0 DTSCS26 -04013 GO TO S4123-EXIT. DTSCS26 -04014 DTSCS26 -04015 MOVE +0 TO WRK-CHARGED-AMT. DTSCS26 +04001 S4121-MQTR-ACCT-SCAN. DTSCS26 +04002 IF MQTR-ACCT-IND (MQTR-ACCT-IDX) = AADJ-APPLIC-IND DTSCS26 +04003 ADD MQTR-CHARGED-AMT (MQTR-ACCT-IDX) DTSCS26 +04004 TO WRK-CHARGED-AMT. DTSCS26 +04005 S4121-EXIT. DTSCS26 +04006 EXIT. DTSCS26 +04007 DTSCS26 +04008 DTSCS26 +04009 DTSCS26 +04010 S4122-SELF-INS-EDIT. DTSCS26 +04011 IF WRK-CHARGED-AMT = +0 DTSCS26 +04012 GO TO S4122-EXIT. DTSCS26 +04013 DTSCS26 +04014 IF WRK-APPLIC-YRQ = LCCM-PICKUP-YRQ DTSCS26 +04015 GO TO S4122-EXIT. DTSCS26 04016 DTSCS26 -04017 PERFORM DTSCS26 -04018 VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSCS26 -04019 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT DTSCS26 -04020 IF MQTR-ACCT-TAX-88 (MQTR-ACCT-IDX) DTSCS26 -04021 MOVE MQTR-CHARGED-AMT (MQTR-ACCT-IDX) DTSCS26 -04022 TO WRK-CHARGED-AMT DTSCS26 -04023 END-IF DTSCS26 -04024 END-PERFORM. DTSCS26 -04025 DTSCS26 -04026 IF WRK-CHARGED-AMT = +0 DTSCS26 -04027 IF AADJ-INT-88 DTSCS26 -04028 MOVE MSG-E263-AREA TO WRK-MSG-AREA DTSCS26 -04029 PERFORM S1701-ERROR THRU S1701-EXIT DTSCS26 -04030 GO TO S4123-EXIT. DTSCS26 -04031 S4123-EXIT. DTSCS26 -04032 EXIT. DTSCS26 -04033 EJECT DTSCS26 -04034 S4200-WAIVE-EDIT. DTSCS26 -04035 PERFORM S7100-READ-APPLIC-YRQ THRU S7100-EXIT. DTSCS26 -04036 IF LCCM-MSG DTSCS26 -04037 GO TO S4200-EXIT DTSCS26 -04038 END-IF. DTSCS26 -04039 DTSCS26 -04040 IF WRK-MQTR-EXISTS-IND = 'N' DTSCS26 -04041 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 -04042 MOVE 'YEAR/QUARTER' TO WRK-MSG-TEXT DTSCS26 -04043 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS26 -04044 GO TO S4200-EXIT. DTSCS26 -04045 DTSCS26 -04046 MOVE +0 TO ACCT-SUB. DTSCS26 -04047 DTSCS26 -04048 PERFORM S4210-MQTR-ACCT-SCAN THRU S4210-EXIT DTSCS26 -04049 VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSCS26 -04050 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT. DTSCS26 +04017 MOVE +0 TO WRK-CHARGED-AMT. DTSCS26 +04018 DTSCS26 +04019 PERFORM DTSCS26 +04020 VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSCS26 +04021 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT DTSCS26 +04022 IF MQTR-ACCT-TAX-88 (MQTR-ACCT-IDX) DTSCS26 +04023 MOVE MQTR-CHARGED-AMT (MQTR-ACCT-IDX) DTSCS26 +04024 TO WRK-CHARGED-AMT DTSCS26 +04025 END-IF DTSCS26 +04026 END-PERFORM. DTSCS26 +04027 DTSCS26 +04028 IF WRK-CHARGED-AMT = +0 DTSCS26 +04029 IF AADJ-INT-88 DTSCS26 +04030 MOVE MSG-E263-AREA TO WRK-MSG-AREA DTSCS26 +04031 PERFORM S1701-ERROR THRU S1701-EXIT DTSCS26 +04032 GO TO S4122-EXIT. DTSCS26 +04033 S4122-EXIT. DTSCS26 +04034 EXIT. DTSCS26 +04035 DTSCS26 +04036 DTSCS26 +04037 DTSCS26 +04038 S4123-TAXED-EDIT. DTSCS26 +04039 IF WRK-APPLIC-YRQ = LCCM-PICKUP-YRQ DTSCS26 +04040 GO TO S4123-EXIT. DTSCS26 +04041 DTSCS26 +04042 IF AADJ-UI-88 DTSCS26 +04043 OR AADJ-SUR-88 DTSCS26 +04044 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 +04045 MOVE 'RPT/PAY/ADJ TYPE' TO WRK-MSG-TEXT DTSCS26 +04046 PERFORM S1701-ERROR THRU S1701-EXIT DTSCS26 +04047 GO TO S4123-EXIT. DTSCS26 +04048 DTSCS26 +04049 IF WRK-CHARGED-AMT = +0 DTSCS26 +04050 GO TO S4123-EXIT. DTSCS26 04051 DTSCS26 -04052 IF ACCT-SUB = +0 DTSCS26 -04053 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 -04054 MOVE 'WAIVE' TO WRK-MSG-TEXT DTSCS26 -04055 PERFORM S1501-ERROR THRU S1501-EXIT DTSCS26 -04056 GO TO S4200-EXIT. DTSCS26 -04057 DTSCS26 -04058 COMPUTE WRK-WAIVED-AMT DTSCS26 -04059 = MQTR-WAIVED-AMT (ACCT-SUB) + AADJ-AMT. DTSCS26 -04060 DTSCS26 -04061 IF (WRK-WAIVED-AMT < +0) DTSCS26 -04062 OR DTSCS26 -04063 (WRK-WAIVED-AMT > MQTR-CHARGED-AMT (ACCT-SUB)) DTSCS26 -04064 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 -04065 MOVE 'WAIVE' TO WRK-MSG-TEXT DTSCS26 -04066 PERFORM S1501-ERROR THRU S1501-EXIT DTSCS26 -04067 GO TO S4200-EXIT. DTSCS26 -04068 S4200-EXIT. DTSCS26 +04052 MOVE +0 TO WRK-CHARGED-AMT. DTSCS26 +04053 DTSCS26 +04054 PERFORM DTSCS26 +04055 VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSCS26 +04056 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT DTSCS26 +04057 IF MQTR-ACCT-TAX-88 (MQTR-ACCT-IDX) DTSCS26 +04058 MOVE MQTR-CHARGED-AMT (MQTR-ACCT-IDX) DTSCS26 +04059 TO WRK-CHARGED-AMT DTSCS26 +04060 END-IF DTSCS26 +04061 END-PERFORM. DTSCS26 +04062 DTSCS26 +04063 IF WRK-CHARGED-AMT = +0 DTSCS26 +04064 IF AADJ-INT-88 DTSCS26 +04065 MOVE MSG-E263-AREA TO WRK-MSG-AREA DTSCS26 +04066 PERFORM S1701-ERROR THRU S1701-EXIT DTSCS26 +04067 GO TO S4123-EXIT. DTSCS26 +04068 S4123-EXIT. DTSCS26 04069 EXIT. DTSCS26 -04070 DTSCS26 -04071 DTSCS26 -04072 DTSCS26 -04073 S4210-MQTR-ACCT-SCAN. DTSCS26 -04074 IF MQTR-ACCT-IND (MQTR-ACCT-IDX) = AADJ-APPLIC-IND DTSCS26 -04075 SET ACCT-SUB TO MQTR-ACCT-IDX. DTSCS26 -04076 S4210-EXIT. DTSCS26 -04077 EXIT. DTSCS26 -04078 EJECT DTSCS26 -04079 S4300-TOLER-EDIT. DTSCS26 -04080 IF AADJ-CREDIT-88 DTSCS26 -04081 PERFORM S4310-CREDIT-TOLER THRU S4310-EXIT DTSCS26 -04082 ELSE DTSCS26 -04083 PERFORM S4320-MQTR-TOLER THRU S4320-EXIT. DTSCS26 -04084 S4300-EXIT. DTSCS26 -04085 EXIT. DTSCS26 -04086 DTSCS26 -04087 DTSCS26 +04070 EJECT DTSCS26 +04071 S4200-WAIVE-EDIT. DTSCS26 +04072 PERFORM S7100-READ-APPLIC-YRQ THRU S7100-EXIT. DTSCS26 +04073 IF LCCM-MSG DTSCS26 +04074 GO TO S4200-EXIT DTSCS26 +04075 END-IF. DTSCS26 +04076 DTSCS26 +04077 IF WRK-MQTR-EXISTS-IND = 'N' DTSCS26 +04078 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 +04079 MOVE 'YEAR/QUARTER' TO WRK-MSG-TEXT DTSCS26 +04080 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS26 +04081 GO TO S4200-EXIT. DTSCS26 +04082 DTSCS26 +04083 MOVE +0 TO ACCT-SUB. DTSCS26 +04084 DTSCS26 +04085 PERFORM S4210-MQTR-ACCT-SCAN THRU S4210-EXIT DTSCS26 +04086 VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSCS26 +04087 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT. DTSCS26 04088 DTSCS26 -04089 S4310-CREDIT-TOLER. DTSCS26 -04090 PERFORM S7200-READ-APPLIC-MDST THRU S7200-EXIT. DTSCS26 -04091 DTSCS26 -04092 IF WRK-MDST-EXISTS-IND = 'N' DTSCS26 -04093 MOVE MSG-E262-AREA TO WRK-MSG-AREA DTSCS26 -04094 PERFORM S1801-ERROR THRU S1801-EXIT DTSCS26 -04095 PERFORM S1802-ERROR THRU S1802-EXIT DTSCS26 -04096 GO TO S4310-EXIT. DTSCS26 +04089 IF ACCT-SUB = +0 DTSCS26 +04090 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 +04091 MOVE 'WAIVE' TO WRK-MSG-TEXT DTSCS26 +04092 PERFORM S1501-ERROR THRU S1501-EXIT DTSCS26 +04093 GO TO S4200-EXIT. DTSCS26 +04094 DTSCS26 +04095 COMPUTE WRK-WAIVED-AMT DTSCS26 +04096 = MQTR-WAIVED-AMT (ACCT-SUB) + AADJ-AMT. DTSCS26 04097 DTSCS26 -04098 MOVE +0 TO WRK-CREDIT-AMT DTSCS26 -04099 WRK-TOLER-AMT. DTSCS26 -04100 DTSCS26 -04101 PERFORM DTSCS26 -04102 VARYING MDST-ACCT-IDX FROM 1 BY 1 DTSCS26 -04103 UNTIL MDST-ACCT-IDX > MDST-ACCT-CNT DTSCS26 -04104 IF MDST-ACCT-CR-AVAIL-88 (MDST-ACCT-IDX) DTSCS26 -04105 ADD MDST-AMT (MDST-ACCT-IDX) TO WRK-CREDIT-AMT DTSCS26 -04106 END-IF DTSCS26 -04107 IF MDST-ACCT-CR-TOL-88 (MDST-ACCT-IDX) DTSCS26 -04108 ADD MDST-AMT (MDST-ACCT-IDX) TO WRK-TOLER-AMT DTSCS26 -04109 END-IF DTSCS26 -04110 END-PERFORM. DTSCS26 -04111 DTSCS26 -04112 ADD AADJ-AMT TO WRK-TOLER-AMT. DTSCS26 -04113 DTSCS26 -04114 IF WRK-TOLER-AMT < +0 DTSCS26 -04115 MOVE MSG-E265-AREA TO WRK-MSG-AREA DTSCS26 -04116 PERFORM S1501-ERROR THRU S1501-EXIT DTSCS26 -04117 GO TO S4310-EXIT. DTSCS26 -04118 DTSCS26 -04119 IF AADJ-AMT > WRK-CREDIT-AMT DTSCS26 -04120 MOVE MSG-E265-AREA TO WRK-MSG-AREA DTSCS26 -04121 PERFORM S1501-ERROR THRU S1501-EXIT DTSCS26 -04122 GO TO S4310-EXIT. DTSCS26 -04123 S4310-EXIT. DTSCS26 -04124 EXIT. DTSCS26 -04125 SKIP3 DTSCS26 -04126 S4320-MQTR-TOLER. DTSCS26 -04127 PERFORM S7100-READ-APPLIC-YRQ THRU S7100-EXIT. DTSCS26 -04128 IF LCCM-MSG DTSCS26 -04129 GO TO S4320-EXIT DTSCS26 -04130 END-IF. DTSCS26 -04131 DTSCS26 -04132 IF WRK-MQTR-EXISTS-IND = 'N' DTSCS26 -04133 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 -04134 MOVE 'YEAR/QUARTER' TO WRK-MSG-TEXT DTSCS26 -04135 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS26 -04136 GO TO S4320-EXIT. DTSCS26 +04098 IF (WRK-WAIVED-AMT < +0) DTSCS26 +04099 OR DTSCS26 +04100 (WRK-WAIVED-AMT > MQTR-CHARGED-AMT (ACCT-SUB)) DTSCS26 +04101 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 +04102 MOVE 'WAIVE' TO WRK-MSG-TEXT DTSCS26 +04103 PERFORM S1501-ERROR THRU S1501-EXIT DTSCS26 +04104 GO TO S4200-EXIT. DTSCS26 +04105 S4200-EXIT. DTSCS26 +04106 EXIT. DTSCS26 +04107 DTSCS26 +04108 DTSCS26 +04109 DTSCS26 +04110 S4210-MQTR-ACCT-SCAN. DTSCS26 +04111 IF MQTR-ACCT-IND (MQTR-ACCT-IDX) = AADJ-APPLIC-IND DTSCS26 +04112 SET ACCT-SUB TO MQTR-ACCT-IDX. DTSCS26 +04113 S4210-EXIT. DTSCS26 +04114 EXIT. DTSCS26 +04115 EJECT DTSCS26 +04116 S4300-TOLER-EDIT. DTSCS26 +04117 IF AADJ-CREDIT-88 DTSCS26 +04118 PERFORM S4310-CREDIT-TOLER THRU S4310-EXIT DTSCS26 +04119 ELSE DTSCS26 +04120 PERFORM S4320-MQTR-TOLER THRU S4320-EXIT. DTSCS26 +04121 S4300-EXIT. DTSCS26 +04122 EXIT. DTSCS26 +04123 DTSCS26 +04124 DTSCS26 +04125 DTSCS26 +04126 S4310-CREDIT-TOLER. DTSCS26 +04127 PERFORM S7200-READ-APPLIC-MDST THRU S7200-EXIT. DTSCS26 +04128 DTSCS26 +04129 IF WRK-MDST-EXISTS-IND = 'N' DTSCS26 +04130 MOVE MSG-E262-AREA TO WRK-MSG-AREA DTSCS26 +04131 PERFORM S1801-ERROR THRU S1801-EXIT DTSCS26 +04132 PERFORM S1802-ERROR THRU S1802-EXIT DTSCS26 +04133 GO TO S4310-EXIT. DTSCS26 +04134 DTSCS26 +04135 MOVE +0 TO WRK-CREDIT-AMT DTSCS26 +04136 WRK-TOLER-AMT. DTSCS26 04137 DTSCS26 -04138 MOVE +0 TO ACCT-SUB. DTSCS26 -04139 DTSCS26 -04140 PERFORM DTSCS26 -04141 VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSCS26 -04142 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT DTSCS26 -04143 IF MQTR-ACCT-IND (MQTR-ACCT-IDX) = AADJ-APPLIC-IND DTSCS26 -04144 SET ACCT-SUB TO MQTR-ACCT-IDX DTSCS26 -04145 END-IF DTSCS26 -04146 END-PERFORM. DTSCS26 -04147 DTSCS26 -04148 IF ACCT-SUB = +0 DTSCS26 -04149 MOVE MSG-E265-AREA TO WRK-MSG-AREA DTSCS26 -04150 PERFORM S1501-ERROR THRU S1501-EXIT DTSCS26 -04151 GO TO S4320-EXIT. DTSCS26 -04152 DTSCS26 -04153 COMPUTE WRK-TOLER-AMT DTSCS26 -04154 = MQTR-TOLER-AMT (ACCT-SUB) + AADJ-AMT. DTSCS26 +04138 PERFORM DTSCS26 +04139 VARYING MDST-ACCT-IDX FROM 1 BY 1 DTSCS26 +04140 UNTIL MDST-ACCT-IDX > MDST-ACCT-CNT DTSCS26 +04141 IF MDST-ACCT-CR-AVAIL-88 (MDST-ACCT-IDX) DTSCS26 +04142 ADD MDST-AMT (MDST-ACCT-IDX) TO WRK-CREDIT-AMT DTSCS26 +04143 END-IF DTSCS26 +04144 IF MDST-ACCT-CR-TOL-88 (MDST-ACCT-IDX) DTSCS26 +04145 ADD MDST-AMT (MDST-ACCT-IDX) TO WRK-TOLER-AMT DTSCS26 +04146 END-IF DTSCS26 +04147 END-PERFORM. DTSCS26 +04148 DTSCS26 +04149 ADD AADJ-AMT TO WRK-TOLER-AMT. DTSCS26 +04150 DTSCS26 +04151 IF WRK-TOLER-AMT < +0 DTSCS26 +04152 MOVE MSG-E265-AREA TO WRK-MSG-AREA DTSCS26 +04153 PERFORM S1501-ERROR THRU S1501-EXIT DTSCS26 +04154 GO TO S4310-EXIT. DTSCS26 04155 DTSCS26 -04156 IF (WRK-TOLER-AMT < +0) DTSCS26 -04157 OR DTSCS26 -04158 (WRK-TOLER-AMT > MQTR-CHARGED-AMT (ACCT-SUB)) DTSCS26 -04159 MOVE MSG-E265-AREA TO WRK-MSG-AREA DTSCS26 -04160 PERFORM S1501-ERROR THRU S1501-EXIT DTSCS26 -04161 GO TO S4320-EXIT. DTSCS26 -04162 S4320-EXIT. DTSCS26 -04163 EXIT. DTSCS26 -04164 EJECT DTSCS26 -04165 S4400-AUTO-EDIT. DTSCS26 -04166 PERFORM S7100-READ-APPLIC-YRQ THRU S7100-EXIT. DTSCS26 -04167 IF LCCM-MSG DTSCS26 -04168 GO TO S4400-EXIT DTSCS26 -04169 END-IF. DTSCS26 -04170 DTSCS26 -04171 IF (WRK-MQTR-EXISTS-IND = 'N') DTSCS26 -04172 OR DTSCS26 -04173 (WRK-APPLIC-YRQ = LCCM-PICKUP-YRQ) DTSCS26 -04174 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 -04175 MOVE 'YEAR/QUARTER' TO WRK-MSG-TEXT DTSCS26 -04176 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS26 -04177 GO TO S4400-EXIT. DTSCS26 -04178 DTSCS26 -04179 IF AADJ-LATE-PEN-88 DTSCS26 -04180 IF MQTR-PEN-CHARGE-MANUAL-88 DTSCS26 -04181 NEXT SENTENCE DTSCS26 -04182 ELSE DTSCS26 -04183 MOVE MSG-E264-AREA TO WRK-MSG-AREA DTSCS26 -04184 PERFORM S1701-ERROR THRU S1701-EXIT DTSCS26 -04185 GO TO S4400-EXIT DTSCS26 -04186 ELSE DTSCS26 -04187 IF AADJ-INT-88 DTSCS26 -04188 IF MQTR-INT-CHARGE-MANUAL-88 DTSCS26 -04189 NEXT SENTENCE DTSCS26 -04190 ELSE DTSCS26 -04191 MOVE MSG-E264-AREA TO WRK-MSG-AREA DTSCS26 -04192 PERFORM S1701-ERROR THRU S1701-EXIT DTSCS26 -04193 GO TO S4400-EXIT DTSCS26 -04194 ELSE DTSCS26 -04195 IF AADJ-LP-INT-88 DTSCS26 -04196 IF MQTR-PEN-CHARGE-MANUAL-88 DTSCS26 -04197 AND DTSCS26 -04198 MQTR-INT-CHARGE-MANUAL-88 DTSCS26 -04199 NEXT SENTENCE DTSCS26 -04200 ELSE DTSCS26 -04201 MOVE MSG-E264-AREA TO WRK-MSG-AREA DTSCS26 -04202 PERFORM S1701-ERROR THRU S1701-EXIT DTSCS26 -04203 GO TO S4400-EXIT. DTSCS26 -04204 S4400-EXIT. DTSCS26 -04205 EXIT. DTSCS26 -04206 EJECT DTSCS26 -04207 S4500-MANUAL-EDIT. DTSCS26 -04208 PERFORM S7100-READ-APPLIC-YRQ THRU S7100-EXIT. DTSCS26 -04209 IF LCCM-MSG DTSCS26 -04210 GO TO S4500-EXIT DTSCS26 -04211 END-IF. DTSCS26 -04212 DTSCS26 -04213 IF WRK-MQTR-EXISTS-IND = 'N' DTSCS26 -04214 PERFORM S4510-NO-MQTR-REC THRU S4510-EXIT DTSCS26 -04215 ELSE DTSCS26 -04216 PERFORM S4520-MQTR-REC THRU S4520-EXIT. DTSCS26 -04217 S4500-EXIT. DTSCS26 -04218 EXIT. DTSCS26 -04219 SKIP3 DTSCS26 -04220 S4510-NO-MQTR-REC. DTSCS26 -04221 IF AADJ-INT-88 OR AADJ-LATE-PEN-88 OR AADJ-LP-INT-88 DTSCS26 -04222 NEXT SENTENCE DTSCS26 +04156 IF AADJ-AMT > WRK-CREDIT-AMT DTSCS26 +04157 MOVE MSG-E265-AREA TO WRK-MSG-AREA DTSCS26 +04158 PERFORM S1501-ERROR THRU S1501-EXIT DTSCS26 +04159 GO TO S4310-EXIT. DTSCS26 +04160 S4310-EXIT. DTSCS26 +04161 EXIT. DTSCS26 +04162 SKIP3 DTSCS26 +04163 S4320-MQTR-TOLER. DTSCS26 +04164 PERFORM S7100-READ-APPLIC-YRQ THRU S7100-EXIT. DTSCS26 +04165 IF LCCM-MSG DTSCS26 +04166 GO TO S4320-EXIT DTSCS26 +04167 END-IF. DTSCS26 +04168 DTSCS26 +04169 IF WRK-MQTR-EXISTS-IND = 'N' DTSCS26 +04170 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 +04171 MOVE 'YEAR/QUARTER' TO WRK-MSG-TEXT DTSCS26 +04172 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS26 +04173 GO TO S4320-EXIT. DTSCS26 +04174 DTSCS26 +04175 MOVE +0 TO ACCT-SUB. DTSCS26 +04176 DTSCS26 +04177 PERFORM DTSCS26 +04178 VARYING MQTR-ACCT-IDX FROM 1 BY 1 DTSCS26 +04179 UNTIL MQTR-ACCT-IDX > MQTR-ACCT-CNT DTSCS26 +04180 IF MQTR-ACCT-IND (MQTR-ACCT-IDX) = AADJ-APPLIC-IND DTSCS26 +04181 SET ACCT-SUB TO MQTR-ACCT-IDX DTSCS26 +04182 END-IF DTSCS26 +04183 END-PERFORM. DTSCS26 +04184 DTSCS26 +04185 IF ACCT-SUB = +0 DTSCS26 +04186 MOVE MSG-E265-AREA TO WRK-MSG-AREA DTSCS26 +04187 PERFORM S1501-ERROR THRU S1501-EXIT DTSCS26 +04188 GO TO S4320-EXIT. DTSCS26 +04189 DTSCS26 +04190 COMPUTE WRK-TOLER-AMT DTSCS26 +04191 = MQTR-TOLER-AMT (ACCT-SUB) + AADJ-AMT. DTSCS26 +04192 DTSCS26 +04193 IF (WRK-TOLER-AMT < +0) DTSCS26 +04194 OR DTSCS26 +04195 (WRK-TOLER-AMT > MQTR-CHARGED-AMT (ACCT-SUB)) DTSCS26 +04196 MOVE MSG-E265-AREA TO WRK-MSG-AREA DTSCS26 +04197 PERFORM S1501-ERROR THRU S1501-EXIT DTSCS26 +04198 GO TO S4320-EXIT. DTSCS26 +04199 S4320-EXIT. DTSCS26 +04200 EXIT. DTSCS26 +04201 EJECT DTSCS26 +04202 S4400-AUTO-EDIT. DTSCS26 +04203 PERFORM S7100-READ-APPLIC-YRQ THRU S7100-EXIT. DTSCS26 +04204 IF LCCM-MSG DTSCS26 +04205 GO TO S4400-EXIT DTSCS26 +04206 END-IF. DTSCS26 +04207 DTSCS26 +04208 IF (WRK-MQTR-EXISTS-IND = 'N') DTSCS26 +04209 OR DTSCS26 +04210 (WRK-APPLIC-YRQ = LCCM-PICKUP-YRQ) DTSCS26 +04211 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 +04212 MOVE 'YEAR/QUARTER' TO WRK-MSG-TEXT DTSCS26 +04213 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS26 +04214 GO TO S4400-EXIT. DTSCS26 +04215 DTSCS26 +04216 IF AADJ-LATE-PEN-88 DTSCS26 +04217 IF MQTR-PEN-CHARGE-MANUAL-88 DTSCS26 +04218 NEXT SENTENCE DTSCS26 +04219 ELSE DTSCS26 +04220 MOVE MSG-E264-AREA TO WRK-MSG-AREA DTSCS26 +04221 PERFORM S1701-ERROR THRU S1701-EXIT DTSCS26 +04222 GO TO S4400-EXIT DTSCS26 04223 ELSE DTSCS26 -04224 MOVE MSG-E266-AREA TO WRK-MSG-AREA DTSCS26 -04225 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS26 -04226 GO TO S4510-EXIT. DTSCS26 -04227 S4510-EXIT. DTSCS26 -04228 EXIT. DTSCS26 -04229 SKIP3 DTSCS26 -04230 S4520-MQTR-REC. DTSCS26 -04231 IF AADJ-LATE-PEN-88 DTSCS26 -04232 IF MQTR-PEN-CHARGE-AUTO-88 DTSCS26 -04233 NEXT SENTENCE DTSCS26 -04234 ELSE DTSCS26 -04235 MOVE MSG-E266-AREA TO WRK-MSG-AREA DTSCS26 -04236 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS26 -04237 GO TO S4520-EXIT DTSCS26 -04238 ELSE DTSCS26 -04239 IF AADJ-INT-88 DTSCS26 -04240 IF MQTR-INT-CHARGE-AUTO-88 DTSCS26 -04241 NEXT SENTENCE DTSCS26 -04242 ELSE DTSCS26 -04243 MOVE MSG-E266-AREA TO WRK-MSG-AREA DTSCS26 -04244 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS26 -04245 GO TO S4520-EXIT DTSCS26 -04246 ELSE DTSCS26 -04247 IF AADJ-LP-INT-88 DTSCS26 -04248 IF MQTR-PEN-CHARGE-AUTO-88 AND MQTR-INT-CHARGE-AUTO-88 DTSCS26 -04249 NEXT SENTENCE DTSCS26 -04250 ELSE DTSCS26 -04251 MOVE MSG-E266-AREA TO WRK-MSG-AREA DTSCS26 -04252 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS26 -04253 GO TO S4520-EXIT. DTSCS26 -04254 S4520-EXIT. DTSCS26 +04224 IF AADJ-INT-88 DTSCS26 +04225 IF MQTR-INT-CHARGE-MANUAL-88 DTSCS26 +04226 NEXT SENTENCE DTSCS26 +04227 ELSE DTSCS26 +04228 MOVE MSG-E264-AREA TO WRK-MSG-AREA DTSCS26 +04229 PERFORM S1701-ERROR THRU S1701-EXIT DTSCS26 +04230 GO TO S4400-EXIT DTSCS26 +04231 ELSE DTSCS26 +04232 IF AADJ-LP-INT-88 DTSCS26 +04233 IF MQTR-PEN-CHARGE-MANUAL-88 DTSCS26 +04234 AND DTSCS26 +04235 MQTR-INT-CHARGE-MANUAL-88 DTSCS26 +04236 NEXT SENTENCE DTSCS26 +04237 ELSE DTSCS26 +04238 MOVE MSG-E264-AREA TO WRK-MSG-AREA DTSCS26 +04239 PERFORM S1701-ERROR THRU S1701-EXIT DTSCS26 +04240 GO TO S4400-EXIT. DTSCS26 +04241 S4400-EXIT. DTSCS26 +04242 EXIT. DTSCS26 +04243 EJECT DTSCS26 +04244 S4500-MANUAL-EDIT. DTSCS26 +04245 PERFORM S7100-READ-APPLIC-YRQ THRU S7100-EXIT. DTSCS26 +04246 IF LCCM-MSG DTSCS26 +04247 GO TO S4500-EXIT DTSCS26 +04248 END-IF. DTSCS26 +04249 DTSCS26 +04250 IF WRK-MQTR-EXISTS-IND = 'N' DTSCS26 +04251 PERFORM S4510-NO-MQTR-REC THRU S4510-EXIT DTSCS26 +04252 ELSE DTSCS26 +04253 PERFORM S4520-MQTR-REC THRU S4520-EXIT. DTSCS26 +04254 S4500-EXIT. DTSCS26 04255 EXIT. DTSCS26 -04256 EJECT DTSCS26 -04257 S4600-DUE-DATE-EDIT. DTSCS26 -04258 IF WRK-APPLIC-YRQ = LCCM-PICKUP-YRQ DTSCS26 -04259 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 -04260 MOVE 'YEAR/QUARTER' TO WRK-MSG-TEXT DTSCS26 -04261 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS26 -04262 GO TO S4600-EXIT. DTSCS26 -04263 DTSCS26 -04264 PERFORM S7100-READ-APPLIC-YRQ THRU S7100-EXIT. DTSCS26 -04265 IF LCCM-MSG DTSCS26 -04266 GO TO S4600-EXIT DTSCS26 -04267 END-IF. DTSCS26 -04268 DTSCS26 -04269 IF WRK-MQTR-EXISTS-IND = 'N' DTSCS26 -04270 PERFORM S4610-NO-MQTR-REC THRU S4610-EXIT DTSCS26 -04271 ELSE DTSCS26 -04272 NEXT SENTENCE. DTSCS26 -04273 DTSCS26 -04274 IF AADJ-DATE-2 = +0 OR ALL-NINES-DATE DTSCS26 -04275 NEXT SENTENCE DTSCS26 -04276 ELSE DTSCS26 -04277 PERFORM S4620-TAX-DUE-DATE-EDIT THRU S4620-EXIT. DTSCS26 -04278 S4600-EXIT. DTSCS26 -04279 EXIT. DTSCS26 -04280 DTSCS26 -04281 DTSCS26 -04282 DTSCS26 -04283 S4610-NO-MQTR-REC. DTSCS26 -04284 IF (AADJ-DATE-1 = +0 OR ALL-NINES-DATE) DTSCS26 -04285 AND DTSCS26 -04286 (AADJ-DATE-2 = +0 OR ALL-NINES-DATE) DTSCS26 -04287 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 -04288 MOVE 'YEAR/QUARTER' TO WRK-MSG-TEXT DTSCS26 -04289 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS26 -04290 GO TO S4610-EXIT. DTSCS26 -04291 S4610-EXIT. DTSCS26 +04256 SKIP3 DTSCS26 +04257 S4510-NO-MQTR-REC. DTSCS26 +04258 IF AADJ-INT-88 OR AADJ-LATE-PEN-88 OR AADJ-LP-INT-88 DTSCS26 +04259 NEXT SENTENCE DTSCS26 +04260 ELSE DTSCS26 +04261 MOVE MSG-E266-AREA TO WRK-MSG-AREA DTSCS26 +04262 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS26 +04263 GO TO S4510-EXIT. DTSCS26 +04264 S4510-EXIT. DTSCS26 +04265 EXIT. DTSCS26 +04266 SKIP3 DTSCS26 +04267 S4520-MQTR-REC. DTSCS26 +04268 IF AADJ-LATE-PEN-88 DTSCS26 +04269 IF MQTR-PEN-CHARGE-AUTO-88 DTSCS26 +04270 NEXT SENTENCE DTSCS26 +04271 ELSE DTSCS26 +04272 MOVE MSG-E266-AREA TO WRK-MSG-AREA DTSCS26 +04273 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS26 +04274 GO TO S4520-EXIT DTSCS26 +04275 ELSE DTSCS26 +04276 IF AADJ-INT-88 DTSCS26 +04277 IF MQTR-INT-CHARGE-AUTO-88 DTSCS26 +04278 NEXT SENTENCE DTSCS26 +04279 ELSE DTSCS26 +04280 MOVE MSG-E266-AREA TO WRK-MSG-AREA DTSCS26 +04281 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS26 +04282 GO TO S4520-EXIT DTSCS26 +04283 ELSE DTSCS26 +04284 IF AADJ-LP-INT-88 DTSCS26 +04285 IF MQTR-PEN-CHARGE-AUTO-88 AND MQTR-INT-CHARGE-AUTO-88 DTSCS26 +04286 NEXT SENTENCE DTSCS26 +04287 ELSE DTSCS26 +04288 MOVE MSG-E266-AREA TO WRK-MSG-AREA DTSCS26 +04289 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS26 +04290 GO TO S4520-EXIT. DTSCS26 +04291 S4520-EXIT. DTSCS26 04292 EXIT. DTSCS26 -04293 DTSCS26 -04294 DTSCS26 -04295 DTSCS26 -04296 S4620-TAX-DUE-DATE-EDIT. DTSCS26 -04297 MOVE WRK-EMP-NO TO L381-EMP-NO. DTSCS26 -04298 DTSCS26 -04299 MOVE WRK-APPLIC-YRQ TO L381-YRQ. DTSCS26 +04293 EJECT DTSCS26 +04294 S4600-DUE-DATE-EDIT. DTSCS26 +04295 IF WRK-APPLIC-YRQ = LCCM-PICKUP-YRQ DTSCS26 +04296 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 +04297 MOVE 'YEAR/QUARTER' TO WRK-MSG-TEXT DTSCS26 +04298 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS26 +04299 GO TO S4600-EXIT. DTSCS26 04300 DTSCS26 -04301 MOVE MPRF-EMP-CLASS TO L381-EMP-CLASS. DTSCS26 -04302 DTSCS26 -04303 PERFORM S381-LOOKUP-LIABILITY THRU S381-EXIT. DTSCS26 -04304 DTSCS26 -04305 IF AADJ-DATE-2 > L381-DEFAULT-TAX-DUE-DATE DTSCS26 -04306 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 -04307 MOVE 'TAX DUE DATE' TO WRK-MSG-TEXT DTSCS26 -04308 PERFORM S2001-ERROR THRU S2001-EXIT. DTSCS26 -04309 S4620-EXIT. DTSCS26 -04310 EXIT. DTSCS26 -04311 EJECT DTSCS26 -04312 S4700-WAIVE-DATE-EDIT. DTSCS26 -04313 IF WRK-APPLIC-YRQ = LCCM-PICKUP-YRQ DTSCS26 -04314 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 -04315 MOVE 'YEAR/QUARTER' TO WRK-MSG-TEXT DTSCS26 -04316 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS26 -04317 GO TO S4700-EXIT. DTSCS26 +04301 PERFORM S7100-READ-APPLIC-YRQ THRU S7100-EXIT. DTSCS26 +04302 IF LCCM-MSG DTSCS26 +04303 GO TO S4600-EXIT DTSCS26 +04304 END-IF. DTSCS26 +04305 DTSCS26 +04306 IF WRK-MQTR-EXISTS-IND = 'N' DTSCS26 +04307 PERFORM S4610-NO-MQTR-REC THRU S4610-EXIT DTSCS26 +04308 ELSE DTSCS26 +04309 NEXT SENTENCE. DTSCS26 +04310 DTSCS26 +04311 IF AADJ-DATE-2 = +0 OR ALL-NINES-DATE DTSCS26 +04312 NEXT SENTENCE DTSCS26 +04313 ELSE DTSCS26 +04314 PERFORM S4620-TAX-DUE-DATE-EDIT THRU S4620-EXIT. DTSCS26 +04315 S4600-EXIT. DTSCS26 +04316 EXIT. DTSCS26 +04317 DTSCS26 04318 DTSCS26 -04319 PERFORM S7100-READ-APPLIC-YRQ THRU S7100-EXIT. DTSCS26 -04320 IF LCCM-MSG DTSCS26 -04321 GO TO S4700-EXIT DTSCS26 -04322 END-IF. DTSCS26 -04323 DTSCS26 -04324 IF WRK-MQTR-EXISTS-IND = 'N' DTSCS26 -04325 PERFORM S4710-NO-MQTR-REC THRU S4710-EXIT. DTSCS26 -04326 S4700-EXIT. DTSCS26 -04327 EXIT. DTSCS26 -04328 DTSCS26 -04329 DTSCS26 +04319 DTSCS26 +04320 S4610-NO-MQTR-REC. DTSCS26 +04321 IF (AADJ-DATE-1 = +0 OR ALL-NINES-DATE) DTSCS26 +04322 AND DTSCS26 +04323 (AADJ-DATE-2 = +0 OR ALL-NINES-DATE) DTSCS26 +04324 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 +04325 MOVE 'YEAR/QUARTER' TO WRK-MSG-TEXT DTSCS26 +04326 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS26 +04327 GO TO S4610-EXIT. DTSCS26 +04328 S4610-EXIT. DTSCS26 +04329 EXIT. DTSCS26 04330 DTSCS26 -04331 S4710-NO-MQTR-REC. DTSCS26 -04332 IF AADJ-DATE-1 = ALL-NINES-DATE DTSCS26 -04333 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 -04334 MOVE 'YEAR/QUARTER' TO WRK-MSG-TEXT DTSCS26 -04335 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS26 -04336 GO TO S4710-EXIT. DTSCS26 -04337 S4710-EXIT. DTSCS26 -04338 EXIT. DTSCS26 -04339 EJECT DTSCS26 -04340 S4800-INT-DATE-EDIT. DTSCS26 -04341 IF WRK-APPLIC-YRQ = LCCM-PICKUP-YRQ DTSCS26 -04342 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 -04343 MOVE 'YEAR/QUARTER' TO WRK-MSG-TEXT DTSCS26 -04344 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS26 -04345 GO TO S4800-EXIT. DTSCS26 -04346 DTSCS26 -04347 PERFORM S7100-READ-APPLIC-YRQ THRU S7100-EXIT. DTSCS26 -04348 IF LCCM-MSG DTSCS26 -04349 GO TO S4800-EXIT DTSCS26 -04350 END-IF. DTSCS26 -04351 DTSCS26 -04352 IF WRK-MQTR-EXISTS-IND = 'N' DTSCS26 -04353 PERFORM S4810-NO-MQTR-REC THRU S4810-EXIT DTSCS26 -04354 ELSE DTSCS26 -04355 NEXT SENTENCE. DTSCS26 -04356 DTSCS26 -04357 PERFORM S4820-DAY-OF-MONTH-EDIT THRU S4820-EXIT. DTSCS26 -04358 S4800-EXIT. DTSCS26 -04359 EXIT. DTSCS26 +04331 DTSCS26 +04332 DTSCS26 +04333 S4620-TAX-DUE-DATE-EDIT. DTSCS26 +04334 MOVE WRK-EMP-NO TO L381-EMP-NO. DTSCS26 +04335 DTSCS26 +04336 MOVE WRK-APPLIC-YRQ TO L381-YRQ. DTSCS26 +04337 DTSCS26 +04338 MOVE MPRF-EMP-CLASS TO L381-EMP-CLASS. DTSCS26 +04339 DTSCS26 +04340 PERFORM S381-LOOKUP-LIABILITY THRU S381-EXIT. DTSCS26 +04341 DTSCS26 +04342 IF AADJ-DATE-2 > L381-DEFAULT-TAX-DUE-DATE DTSCS26 +04343 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 +04344 MOVE 'TAX DUE DATE' TO WRK-MSG-TEXT DTSCS26 +04345 PERFORM S2001-ERROR THRU S2001-EXIT. DTSCS26 +04346 S4620-EXIT. DTSCS26 +04347 EXIT. DTSCS26 +04348 EJECT DTSCS26 +04349 S4700-WAIVE-DATE-EDIT. DTSCS26 +04350 IF WRK-APPLIC-YRQ = LCCM-PICKUP-YRQ DTSCS26 +04351 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 +04352 MOVE 'YEAR/QUARTER' TO WRK-MSG-TEXT DTSCS26 +04353 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS26 +04354 GO TO S4700-EXIT. DTSCS26 +04355 DTSCS26 +04356 PERFORM S7100-READ-APPLIC-YRQ THRU S7100-EXIT. DTSCS26 +04357 IF LCCM-MSG DTSCS26 +04358 GO TO S4700-EXIT DTSCS26 +04359 END-IF. DTSCS26 04360 DTSCS26 -04361 DTSCS26 -04362 DTSCS26 -04363 S4810-NO-MQTR-REC. DTSCS26 -04364 IF AADJ-DATE-1 = ALL-NINES-DATE DTSCS26 -04365 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 -04366 MOVE 'YEAR/QUARTER' TO WRK-MSG-TEXT DTSCS26 -04367 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS26 -04368 GO TO S4810-EXIT. DTSCS26 -04369 S4810-EXIT. DTSCS26 -04370 EXIT. DTSCS26 -04371 DTSCS26 -04372 DTSCS26 -04373 DTSCS26 -04374 S4820-DAY-OF-MONTH-EDIT. DTSCS26 -04375 IF AADJ-DATE-1 = ALL-NINES-DATE OR ZERO DTSCS26 -04376 CONTINUE DTSCS26 -04377 ELSE DTSCS26 -04378 PERFORM S4821-FIRST-DAY-OF-MONTH THRU S4821-EXIT. DTSCS26 -04379 DTSCS26 -04380 IF AADJ-DATE-2 = ALL-NINES-DATE OR ZERO DTSCS26 -04381 CONTINUE DTSCS26 -04382 ELSE DTSCS26 -04383 PERFORM S4822-LAST-DAY-OF-MONTH THRU S4822-EXIT. DTSCS26 -04384 S4820-EXIT. DTSCS26 -04385 EXIT. DTSCS26 -04386 DTSCS26 -04387 DTSCS26 +04361 IF WRK-MQTR-EXISTS-IND = 'N' DTSCS26 +04362 PERFORM S4710-NO-MQTR-REC THRU S4710-EXIT. DTSCS26 +04363 S4700-EXIT. DTSCS26 +04364 EXIT. DTSCS26 +04365 DTSCS26 +04366 DTSCS26 +04367 DTSCS26 +04368 S4710-NO-MQTR-REC. DTSCS26 +04369 IF AADJ-DATE-1 = ALL-NINES-DATE DTSCS26 +04370 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 +04371 MOVE 'YEAR/QUARTER' TO WRK-MSG-TEXT DTSCS26 +04372 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS26 +04373 GO TO S4710-EXIT. DTSCS26 +04374 S4710-EXIT. DTSCS26 +04375 EXIT. DTSCS26 +04376 EJECT DTSCS26 +04377 S4800-INT-DATE-EDIT. DTSCS26 +04378 IF WRK-APPLIC-YRQ = LCCM-PICKUP-YRQ DTSCS26 +04379 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 +04380 MOVE 'YEAR/QUARTER' TO WRK-MSG-TEXT DTSCS26 +04381 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS26 +04382 GO TO S4800-EXIT. DTSCS26 +04383 DTSCS26 +04384 PERFORM S7100-READ-APPLIC-YRQ THRU S7100-EXIT. DTSCS26 +04385 IF LCCM-MSG DTSCS26 +04386 GO TO S4800-EXIT DTSCS26 +04387 END-IF. DTSCS26 04388 DTSCS26 -04389 S4821-FIRST-DAY-OF-MONTH. DTSCS26 -04390 MOVE AADJ-DATE-1 TO L001-FED-8-DATE-9. DTSCS26 -04391 DTSCS26 -04392 IF L001-FED-8-DA = 01 DTSCS26 -04393 NEXT SENTENCE DTSCS26 -04394 ELSE DTSCS26 -04395 MOVE MSG-E268-AREA TO WRK-MSG-AREA DTSCS26 -04396 PERFORM S1901-ERROR THRU S1901-EXIT. DTSCS26 -04397 S4821-EXIT. DTSCS26 -04398 EXIT. DTSCS26 +04389 IF WRK-MQTR-EXISTS-IND = 'N' DTSCS26 +04390 PERFORM S4810-NO-MQTR-REC THRU S4810-EXIT DTSCS26 +04391 ELSE DTSCS26 +04392 NEXT SENTENCE. DTSCS26 +04393 DTSCS26 +04394 PERFORM S4820-DAY-OF-MONTH-EDIT THRU S4820-EXIT. DTSCS26 +04395 S4800-EXIT. DTSCS26 +04396 EXIT. DTSCS26 +04397 DTSCS26 +04398 DTSCS26 04399 DTSCS26 -04400 DTSCS26 -04401 DTSCS26 -04402 S4822-LAST-DAY-OF-MONTH. DTSCS26 -04403 MOVE AADJ-DATE-2 TO L001-FED-8-DATE-9 DTSCS26 -04404 WRK-DISPLAY. DTSCS26 -04405 DTSCS26 -04406 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSCS26 -04407 DTSCS26 -04408 IF L001-INVALID-DATE DTSCS26 -04409 GO TO S4822-EXIT. DTSCS26 +04400 S4810-NO-MQTR-REC. DTSCS26 +04401 IF AADJ-DATE-1 = ALL-NINES-DATE DTSCS26 +04402 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 +04403 MOVE 'YEAR/QUARTER' TO WRK-MSG-TEXT DTSCS26 +04404 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS26 +04405 GO TO S4810-EXIT. DTSCS26 +04406 S4810-EXIT. DTSCS26 +04407 EXIT. DTSCS26 +04408 DTSCS26 +04409 DTSCS26 04410 DTSCS26 -04411 ADD +1 TO L001-JUL-ABS-DAY. DTSCS26 -04412 DTSCS26 -04413 PERFORM S001-FROM-ABS-DAY THRU S001-EXIT. DTSCS26 -04414 DTSCS26 -04415 IF L001-INVALID-DATE DTSCS26 -04416 GO TO S4822-EXIT. DTSCS26 -04417 DTSCS26 -04418 IF L001-FED-8-MO = WRK-DISPLAY-MO DTSCS26 -04419 MOVE MSG-E269-AREA TO WRK-MSG-AREA DTSCS26 -04420 PERFORM S2001-ERROR THRU S2001-EXIT. DTSCS26 -04421 S4822-EXIT. DTSCS26 +04411 S4820-DAY-OF-MONTH-EDIT. DTSCS26 +04412 IF AADJ-DATE-1 = ALL-NINES-DATE OR ZERO DTSCS26 +04413 CONTINUE DTSCS26 +04414 ELSE DTSCS26 +04415 PERFORM S4821-FIRST-DAY-OF-MONTH THRU S4821-EXIT. DTSCS26 +04416 DTSCS26 +04417 IF AADJ-DATE-2 = ALL-NINES-DATE OR ZERO DTSCS26 +04418 CONTINUE DTSCS26 +04419 ELSE DTSCS26 +04420 PERFORM S4822-LAST-DAY-OF-MONTH THRU S4822-EXIT. DTSCS26 +04421 S4820-EXIT. DTSCS26 04422 EXIT. DTSCS26 -04423 EJECT DTSCS26 -04424 S4900-WAGE-RPT-EDIT. DTSCS26 -04425 IF WRK-APPLIC-YRQ = LCCM-PICKUP-YRQ DTSCS26 -04426 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 -04427 MOVE 'YEAR/QUARTER' TO WRK-MSG-TEXT DTSCS26 -04428 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS26 -04429 GO TO S4900-EXIT. DTSCS26 -04430 DTSCS26 -04431 *** PERFORM S7100-READ-APPLIC-YRQ THRU S7100-EXIT. DTSCS26 -04432 DTSCS26 -04433 IF MPRF-ORG-HSEHLD-DMSTIC-88 DTSCS26 -04434 MOVE WRK-APPLIC-YRQ TO L410-YRQ DTSCS26 -04435 MOVE WRK-EMP-NO TO L410-EMP-NO DTSCS26 -04436 PERFORM S410-FILING-SCHEDULE THRU S410-EXIT DTSCS26 -04437 IF L410-ANN-SCHED-88 DTSCS26 -04438 MOVE MSG-E26A-AREA TO WRK-MSG-AREA DTSCS26 -04439 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS26 -04440 GO TO S4900-EXIT. DTSCS26 -04441 DTSCS26 -04442 *****IF WRK-MQTR-EXISTS-IND = 'Y' DTSCS26 -04443 *********PERFORM S4910-MQTR-REC THRU S4910-EXIT DTSCS26 -04444 *****ELSE DTSCS26 -04445 *********PERFORM S4920-NO-MQTR-REC THRU S4920-EXIT. DTSCS26 -04446 S4900-EXIT. DTSCS26 -04447 EXIT. DTSCS26 -04448 DTSCS26 +04423 DTSCS26 +04424 DTSCS26 +04425 DTSCS26 +04426 S4821-FIRST-DAY-OF-MONTH. DTSCS26 +04427 MOVE AADJ-DATE-1 TO L001-FED-8-DATE-9. DTSCS26 +04428 DTSCS26 +04429 IF L001-FED-8-DA = 01 DTSCS26 +04430 NEXT SENTENCE DTSCS26 +04431 ELSE DTSCS26 +04432 MOVE MSG-E268-AREA TO WRK-MSG-AREA DTSCS26 +04433 PERFORM S1901-ERROR THRU S1901-EXIT. DTSCS26 +04434 S4821-EXIT. DTSCS26 +04435 EXIT. DTSCS26 +04436 DTSCS26 +04437 DTSCS26 +04438 DTSCS26 +04439 S4822-LAST-DAY-OF-MONTH. DTSCS26 +04440 MOVE AADJ-DATE-2 TO L001-FED-8-DATE-9 DTSCS26 +04441 WRK-DISPLAY. DTSCS26 +04442 DTSCS26 +04443 PERFORM S001-FROM-FED-8 THRU S001-EXIT. DTSCS26 +04444 DTSCS26 +04445 IF L001-INVALID-DATE DTSCS26 +04446 GO TO S4822-EXIT. DTSCS26 +04447 DTSCS26 +04448 ADD +1 TO L001-JUL-ABS-DAY. DTSCS26 04449 DTSCS26 -04450 DTSCS26 -04451 *S4910-MQTR-REC. DTSCS26 -04452 *S4910-EXIT. DTSCS26 -04453 *****EXIT. DTSCS26 +04450 PERFORM S001-FROM-ABS-DAY THRU S001-EXIT. DTSCS26 +04451 DTSCS26 +04452 IF L001-INVALID-DATE DTSCS26 +04453 GO TO S4822-EXIT. DTSCS26 04454 DTSCS26 -04455 DTSCS26 -04456 DTSCS26 -04457 *S4920-NO-MQTR-REC. DTSCS26 -04458 *S4920-EXIT. DTSCS26 -04459 *****EXIT. DTSCS26 +04455 IF L001-FED-8-MO = WRK-DISPLAY-MO DTSCS26 +04456 MOVE MSG-E269-AREA TO WRK-MSG-AREA DTSCS26 +04457 PERFORM S2001-ERROR THRU S2001-EXIT. DTSCS26 +04458 S4822-EXIT. DTSCS26 +04459 EXIT. DTSCS26 04460 EJECT DTSCS26 -04461 S6100-WRITE-OFF-EDIT. DTSCS26 -04462 IF MPRF-NOT-WRITTEN-OFF-88 DTSCS26 -04463 NEXT SENTENCE DTSCS26 -04464 ELSE DTSCS26 -04465 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 -04466 MOVE 'WRITTEN OFF' TO WRK-MSG-TEXT DTSCS26 -04467 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS26 -04468 GO TO S6100-EXIT. DTSCS26 +04461 S4900-WAGE-RPT-EDIT. DTSCS26 +04462 IF WRK-APPLIC-YRQ = LCCM-PICKUP-YRQ DTSCS26 +04463 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 +04464 MOVE 'YEAR/QUARTER' TO WRK-MSG-TEXT DTSCS26 +04465 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS26 +04466 GO TO S4900-EXIT. DTSCS26 +04467 DTSCS26 +04468 *** PERFORM S7100-READ-APPLIC-YRQ THRU S7100-EXIT. DTSCS26 04469 DTSCS26 -04470 IF (MPRF-TOT-BALANCE-AMT > +0) DTSCS26 -04471 OR DTSCS26 -04472 (MPRF-PURSUED-RPT-CNT > +0) DTSCS26 -04473 OR DTSCS26 -04474 (MPRF-TOT-CREDIT-AMT > +0) DTSCS26 -04475 NEXT SENTENCE DTSCS26 -04476 ELSE DTSCS26 -04477 MOVE MSG-E267-AREA TO WRK-MSG-AREA DTSCS26 -04478 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS26 -04479 GO TO S6100-EXIT. DTSCS26 -04480 DTSCS26 -04481 IF MPRF-STATUS-ACT-88 DTSCS26 -04482 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 -04483 MOVE 'WRITE OFF' TO WRK-MSG-TEXT DTSCS26 -04484 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS26 -04485 GO TO S6100-EXIT. DTSCS26 -04486 S6100-EXIT. DTSCS26 -04487 EXIT. DTSCS26 -04488 EJECT DTSCS26 -04489 S6200-WRITE-OFF-REV-EDIT. DTSCS26 -04490 IF MPRF-NOT-WRITTEN-OFF-88 DTSCS26 -04491 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 -04492 MOVE 'WRITE OFF' TO WRK-MSG-TEXT DTSCS26 -04493 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS26 -04494 GO TO S6200-EXIT. DTSCS26 -04495 S6200-EXIT. DTSCS26 -04496 EXIT. DTSCS26 +04470 IF MPRF-ORG-HSEHLD-DMSTIC-88 DTSCS26 +04471 MOVE WRK-APPLIC-YRQ TO L410-YRQ DTSCS26 +04472 MOVE WRK-EMP-NO TO L410-EMP-NO DTSCS26 +04473 PERFORM S410-FILING-SCHEDULE THRU S410-EXIT DTSCS26 +04474 IF L410-ANN-SCHED-88 DTSCS26 +04475 MOVE MSG-E26A-AREA TO WRK-MSG-AREA DTSCS26 +04476 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS26 +04477 GO TO S4900-EXIT. DTSCS26 +04478 DTSCS26 +04479 *****IF WRK-MQTR-EXISTS-IND = 'Y' DTSCS26 +04480 *********PERFORM S4910-MQTR-REC THRU S4910-EXIT DTSCS26 +04481 *****ELSE DTSCS26 +04482 *********PERFORM S4920-NO-MQTR-REC THRU S4920-EXIT. DTSCS26 +04483 S4900-EXIT. DTSCS26 +04484 EXIT. DTSCS26 +04485 DTSCS26 +04486 DTSCS26 +04487 DTSCS26 +04488 *S4910-MQTR-REC. DTSCS26 +04489 *S4910-EXIT. DTSCS26 +04490 *****EXIT. DTSCS26 +04491 DTSCS26 +04492 DTSCS26 +04493 DTSCS26 +04494 *S4920-NO-MQTR-REC. DTSCS26 +04495 *S4920-EXIT. DTSCS26 +04496 *****EXIT. DTSCS26 04497 EJECT DTSCS26 -04498 S6300-RCV-DATE-EDITS. DTSCS26 -04499 IF WRK-RECEIVED-DATE = +0 DTSCS26 -04500 GO TO S6300-EXIT. DTSCS26 -04501 DTSCS26 -04502 IF WRK-RECEIVED-DATE > LCCM-CURR-RUN-DATE DTSCS26 -04503 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 -04504 MOVE 'RECEIVED DATE' TO WRK-MSG-TEXT DTSCS26 -04505 PERFORM S2301-ERROR THRU S2301-EXIT DTSCS26 -04506 GO TO S6300-EXIT. DTSCS26 -04507 DTSCS26 -04508 MOVE LCCM-CURR-RUN-DATE TO L001-FED-8-DATE-9. DTSCS26 -04509 DTSCS26 -04510 SUBTRACT 1 FROM L001-FED-8-YR. DTSCS26 -04511 DTSCS26 -04512 IF (WRK-RECEIVED-DATE > L001-FED-8-DATE-9) DTSCS26 -04513 OR DTSCS26 -04514 (MAP-DISREGARD-EDITS-YES-88) DTSCS26 -04515 NEXT SENTENCE DTSCS26 -04516 ELSE DTSCS26 -04517 MOVE EMSG-OLD-RCVD-DATE TO WRK-MSG-AREA DTSCS26 -04518 PERFORM S2301-ERROR THRU S2301-EXIT DTSCS26 -04519 GO TO S6300-EXIT. DTSCS26 -04520 S6300-EXIT. DTSCS26 -04521 EXIT. DTSCS26 -04522 EJECT DTSCS26 -04523 S6700-LAST-ARCHIVED-YRQ-EDIT. DTSCS26 -04524 IF WRK-APPLIC-YRQ = +0 DTSCS26 -04525 GO TO S6700-EXIT. DTSCS26 -04526 DTSCS26 -04527 IF MAP-DISREGARD-EDITS-YES-88 DTSCS26 -04528 GO TO S6700-EXIT. DTSCS26 -04529 DTSCS26 -04530 IF (WRK-APPLIC-YRQ > MPRF-LAST-ARCHIVED-YRQ) DTSCS26 -04531 OR DTSCS26 -04532 (WRK-APPLIC-YRQ = LCCM-PICKUP-YRQ) DTSCS26 -04533 GO TO S6700-EXIT. DTSCS26 -04534 DTSCS26 -04535 DTSCS26 -04536 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER. DTSCS26 -04537 DTSCS26 -04538 MOVE 'YEAR/QUARTER' TO WRK-MSG-TEXT. DTSCS26 -04539 DTSCS26 -04540 PERFORM S2701-ERROR THRU S2701-EXIT. DTSCS26 -04541 S6700-EXIT. DTSCS26 -04542 EXIT. DTSCS26 -04543 SKIP3 DTSCS26 -04544 S6800-NEVER-SUBJECT-EDIT. DTSCS26 -04545 IF MPRF-STATUS-SUB-88 DTSCS26 -04546 GO TO S6800-EXIT. DTSCS26 -04547 DTSCS26 +04498 S6100-WRITE-OFF-EDIT. DTSCS26 +04499 IF MPRF-NOT-WRITTEN-OFF-88 DTSCS26 +04500 NEXT SENTENCE DTSCS26 +04501 ELSE DTSCS26 +04502 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 +04503 MOVE 'WRITTEN OFF' TO WRK-MSG-TEXT DTSCS26 +04504 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS26 +04505 GO TO S6100-EXIT. DTSCS26 +04506 DTSCS26 +04507 IF (MPRF-TOT-BALANCE-AMT > +0) DTSCS26 +04508 OR DTSCS26 +04509 (MPRF-PURSUED-RPT-CNT > +0) DTSCS26 +04510 OR DTSCS26 +04511 (MPRF-TOT-CREDIT-AMT > +0) DTSCS26 +04512 NEXT SENTENCE DTSCS26 +04513 ELSE DTSCS26 +04514 MOVE MSG-E267-AREA TO WRK-MSG-AREA DTSCS26 +04515 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS26 +04516 GO TO S6100-EXIT. DTSCS26 +04517 DTSCS26 +04518 IF MPRF-STATUS-ACT-88 DTSCS26 +04519 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 +04520 MOVE 'WRITE OFF' TO WRK-MSG-TEXT DTSCS26 +04521 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS26 +04522 GO TO S6100-EXIT. DTSCS26 +04523 S6100-EXIT. DTSCS26 +04524 EXIT. DTSCS26 +04525 EJECT DTSCS26 +04526 S6200-WRITE-OFF-REV-EDIT. DTSCS26 +04527 IF MPRF-NOT-WRITTEN-OFF-88 DTSCS26 +04528 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 +04529 MOVE 'WRITE OFF' TO WRK-MSG-TEXT DTSCS26 +04530 PERFORM S1401-ERROR THRU S1401-EXIT DTSCS26 +04531 GO TO S6200-EXIT. DTSCS26 +04532 S6200-EXIT. DTSCS26 +04533 EXIT. DTSCS26 +04534 EJECT DTSCS26 +04535 S6300-RCV-DATE-EDITS. DTSCS26 +04536 IF WRK-RECEIVED-DATE = +0 DTSCS26 +04537 GO TO S6300-EXIT. DTSCS26 +04538 DTSCS26 +04539 IF WRK-RECEIVED-DATE > LCCM-CURR-RUN-DATE DTSCS26 +04540 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER DTSCS26 +04541 MOVE 'RECEIVED DATE' TO WRK-MSG-TEXT DTSCS26 +04542 PERFORM S2301-ERROR THRU S2301-EXIT DTSCS26 +04543 GO TO S6300-EXIT. DTSCS26 +04544 DTSCS26 +04545 MOVE LCCM-CURR-RUN-DATE TO L001-FED-8-DATE-9. DTSCS26 +04546 DTSCS26 +04547 SUBTRACT 1 FROM L001-FED-8-YR. DTSCS26 04548 DTSCS26 -04549 MOVE MSG-E261-AREA TO WRK-MSG-AREA. DTSCS26 -04550 DTSCS26 -04551 PERFORM S1401-ERROR THRU S1401-EXIT. DTSCS26 -04552 S6800-EXIT. DTSCS26 -04553 EXIT. DTSCS26 -04554 SKIP3 DTSCS26 -04555 S6900-WRITTEN-OFF-EDIT. DTSCS26 -04556 IF MPRF-NOT-WRITTEN-OFF-88 DTSCS26 -04557 GO TO S6900-EXIT. DTSCS26 -04558 DTSCS26 -04559 DTSCS26 -04560 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER. DTSCS26 -04561 DTSCS26 -04562 MOVE 'WRITTEN OFF' TO WRK-MSG-TEXT. DTSCS26 +04549 IF (WRK-RECEIVED-DATE > L001-FED-8-DATE-9) DTSCS26 +04550 OR DTSCS26 +04551 (MAP-DISREGARD-EDITS-YES-88) DTSCS26 +04552 NEXT SENTENCE DTSCS26 +04553 ELSE DTSCS26 +04554 MOVE EMSG-OLD-RCVD-DATE TO WRK-MSG-AREA DTSCS26 +04555 PERFORM S2301-ERROR THRU S2301-EXIT DTSCS26 +04556 GO TO S6300-EXIT. DTSCS26 +04557 S6300-EXIT. DTSCS26 +04558 EXIT. DTSCS26 +04559 EJECT DTSCS26 +04560 S6700-LAST-ARCHIVED-YRQ-EDIT. DTSCS26 +04561 IF WRK-APPLIC-YRQ = +0 DTSCS26 +04562 GO TO S6700-EXIT. DTSCS26 04563 DTSCS26 -04564 PERFORM S1401-ERROR THRU S1401-EXIT. DTSCS26 -04565 S6900-EXIT. DTSCS26 -04566 EXIT. DTSCS26 -04567 EJECT DTSCS26 -04568 S7100-READ-APPLIC-YRQ. DTSCS26 -04569 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSCS26 -04570 DTSCS26 -04571 MOVE WRK-EMP-NO TO MQTR-EMP-NO. DTSCS26 +04564 IF MAP-DISREGARD-EDITS-YES-88 DTSCS26 +04565 GO TO S6700-EXIT. DTSCS26 +04566 DTSCS26 +04567 IF (WRK-APPLIC-YRQ > MPRF-LAST-ARCHIVED-YRQ) DTSCS26 +04568 OR DTSCS26 +04569 (WRK-APPLIC-YRQ = LCCM-PICKUP-YRQ) DTSCS26 +04570 GO TO S6700-EXIT. DTSCS26 +04571 DTSCS26 04572 DTSCS26 -04573 SET MQTR-QTR-88 TO TRUE. DTSCS26 +04573 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER. DTSCS26 04574 DTSCS26 -04575 MOVE WRK-APPLIC-YRQ TO MQTR-YRQ. DTSCS26 +04575 MOVE 'YEAR/QUARTER' TO WRK-MSG-TEXT. DTSCS26 04576 DTSCS26 -04577 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSCS26 -04578 DTSCS26 -04579 PERFORM S810-READ THRU S810-EXIT. DTSCS26 -04580 DTSCS26 -04581 MOVE MSKL-REC TO MQTR-REC. DTSCS26 -04582 DTSCS26 -04583 IF L810-OK-88 DTSCS26 -04584 MOVE 'Y' TO WRK-MQTR-EXISTS-IND DTSCS26 -04585 IF MQTR-CMP-ESTB-ABSTIME > ZERO DTSCS26 -04586 IF WRK-PENDING-MCMP-NO-88 DTSCS26 -04587 IF MAP-APPLIC-IND = 'I ' DTSCS26 -04588 NEXT SENTENCE DTSCS26 -04589 ELSE DTSCS26 -04590 MOVE MSG-E26H-AREA TO WRK-MSG-AREA DTSCS26 -04591 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS26 -04592 END-IF DTSCS26 -04593 END-IF DTSCS26 -04594 END-IF DTSCS26 -04595 ELSE DTSCS26 -04596 MOVE 'N' TO WRK-MQTR-EXISTS-IND. DTSCS26 -04597 DTSCS26 -04598 IF MPRF-ORG-HSEHLD-DMSTIC-88 DTSCS26 -04599 MOVE WRK-APPLIC-YRQ TO L410-YRQ DTSCS26 -04600 MOVE WRK-EMP-NO TO L410-EMP-NO DTSCS26 -04601 PERFORM S410-FILING-SCHEDULE THRU S410-EXIT DTSCS26 -04602 IF L410-ANN-SCHED-88 DTSCS26 -04603 PERFORM S7105-CHK-ADJ-TYPE THRU S7105-EXIT DTSCS26 -04604 IF ADJ-FOUR-QTRS-YES-88 DTSCS26 -04605 PERFORM S7110-SET-QTRS THRU S7110-EXIT DTSCS26 -04606 END-IF DTSCS26 -04607 END-IF. DTSCS26 -04608 * IF SUM-FOUR-QTRS-YES-88 DTSCS26 -04609 * OR ADJ-FOUR-QTRS-YES-88 DTSCS26 -04610 * PERFORM S7110-SUM-ANN-QTR THRU S7110-EXIT DTSCS26 -04611 * PERFORM S7120-DISTRIB-ADJ THRU S7120-EXIT. DTSCS26 -04612 DTSCS26 -04613 S7100-EXIT. DTSCS26 -04614 EXIT. DTSCS26 +04577 PERFORM S2701-ERROR THRU S2701-EXIT. DTSCS26 +04578 S6700-EXIT. DTSCS26 +04579 EXIT. DTSCS26 +04580 SKIP3 DTSCS26 +04581 S6800-NEVER-SUBJECT-EDIT. DTSCS26 +04582 IF MPRF-STATUS-SUB-88 DTSCS26 +04583 GO TO S6800-EXIT. DTSCS26 +04584 DTSCS26 +04585 DTSCS26 +04586 MOVE MSG-E261-AREA TO WRK-MSG-AREA. DTSCS26 +04587 DTSCS26 +04588 PERFORM S1401-ERROR THRU S1401-EXIT. DTSCS26 +04589 S6800-EXIT. DTSCS26 +04590 EXIT. DTSCS26 +04591 SKIP3 DTSCS26 +04592 S6900-WRITTEN-OFF-EDIT. DTSCS26 +04593 IF MPRF-NOT-WRITTEN-OFF-88 DTSCS26 +04594 GO TO S6900-EXIT. DTSCS26 +04595 DTSCS26 +04596 DTSCS26 +04597 MOVE EMSG-C-VALIDATE TO WRK-MSG-NUMBER. DTSCS26 +04598 DTSCS26 +04599 MOVE 'WRITTEN OFF' TO WRK-MSG-TEXT. DTSCS26 +04600 DTSCS26 +04601 PERFORM S1401-ERROR THRU S1401-EXIT. DTSCS26 +04602 S6900-EXIT. DTSCS26 +04603 EXIT. DTSCS26 +04604 EJECT DTSCS26 +04605 S7100-READ-APPLIC-YRQ. DTSCS26 +04606 MOVE LOW-VALUES TO MQTR-KEY-AREA. DTSCS26 +04607 DTSCS26 +04608 MOVE WRK-EMP-NO TO MQTR-EMP-NO. DTSCS26 +04609 DTSCS26 +04610 SET MQTR-QTR-88 TO TRUE. DTSCS26 +04611 DTSCS26 +04612 MOVE WRK-APPLIC-YRQ TO MQTR-YRQ. DTSCS26 +04613 DTSCS26 +04614 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSCS26 04615 DTSCS26 -04616 ************************************************************* DTSCS26 -04617 * DETERMINE WHETHER THE EDITS REQUIRE THAT THE ACCOUNTING DTSCS26 -04618 * DATA FROM ALL QUARTERS COVERED BY THE ANNUAL REPORT DTSCS26 -04619 * MUST BE SUMMED TO PRODUCE A SINGLE ANNUAL TOTAL. DTSCS26 -04620 * THIS IS NECESSARY FOR CHARGE AND WAIVER EDITS. SET DTSCS26 -04621 * SUM-FOUR-QTRS-YES-88 TO TRUE FOR THESE ADJUSTMENTS. DTSCS26 -04622 * DTSCS26 -04623 * DTSCS26 -04624 * DETERMINE WHETHER THE ADJUSTMENT REQUIRES SEPARATE DTSCS26 -04625 * ACCOUNTING TRANSACTIONS FOR EACH QUARTER COVERED BY AN DTSCS26 -04626 * ANNUAL REPORT. SET ADJ-FOUR-QTRS-YES-88 TO TRUE FOR DTSCS26 -04627 * THESE ADJUSTMENTS. DTSCS26 -04628 ************************************************************* DTSCS26 -04629 S7105-CHK-ADJ-TYPE. DTSCS26 -04630 *& SET SUM-FOUR-QTRS-NO-88 TO TRUE. DTSCS26 -04631 SET ADJ-FOUR-QTRS-NO-88 TO TRUE. DTSCS26 -04632 DTSCS26 -04633 *& IF AADJ-CHARGE-88 DTSCS26 -04634 * IF AADJ-LATE-PEN-88 OR AADJ-MISC-PEN-88 DTSCS26 -04635 * SET SUM-FOUR-QTRS-YES-88 TO TRUE DTSCS26 -04636 * SET ADJ-FOUR-QTRS-YES-88 TO TRUE DTSCS26 -04637 * END-IF DTSCS26 -04638 * ELSE DTSCS26 -04639 * IF AADJ-WAIVE-88 DTSCS26 -04640 * SET SUM-FOUR-QTRS-YES-88 TO TRUE DTSCS26 -04641 * SET ADJ-FOUR-QTRS-YES-88 TO TRUE DTSCS26 -04642 *& ELSE DTSCS26 -04643 IF AADJ-AUTO-88 DTSCS26 -04644 OR AADJ-MANUAL-88 DTSCS26 -04645 OR AADJ-DUE-DATE-88 DTSCS26 -04646 OR AADJ-WAIVE-DATE-88 DTSCS26 -04647 OR AADJ-INT-DATE-88 DTSCS26 -04648 SET ADJ-FOUR-QTRS-YES-88 TO TRUE. DTSCS26 +04616 PERFORM S810-READ THRU S810-EXIT. DTSCS26 +04617 DTSCS26 +04618 MOVE MSKL-REC TO MQTR-REC. DTSCS26 +04619 DTSCS26 +04620 IF L810-OK-88 DTSCS26 +04621 MOVE 'Y' TO WRK-MQTR-EXISTS-IND DTSCS26 +04622 IF MQTR-CMP-ESTB-ABSTIME > ZERO DTSCS26 +04623 IF WRK-PENDING-MCMP-NO-88 DTSCS26 +04624 IF MAP-APPLIC-IND = 'I ' DTSCS26 +04625 NEXT SENTENCE DTSCS26 +04626 ELSE DTSCS26 +04627 MOVE MSG-E26H-AREA TO WRK-MSG-AREA DTSCS26 +04628 PERFORM S1601-ERROR THRU S1601-EXIT DTSCS26 +04629 END-IF DTSCS26 +04630 END-IF DTSCS26 +04631 END-IF DTSCS26 +04632 ELSE DTSCS26 +04633 MOVE 'N' TO WRK-MQTR-EXISTS-IND. DTSCS26 +04634 DTSCS26 +04635 IF MPRF-ORG-HSEHLD-DMSTIC-88 DTSCS26 +04636 MOVE WRK-APPLIC-YRQ TO L410-YRQ DTSCS26 +04637 MOVE WRK-EMP-NO TO L410-EMP-NO DTSCS26 +04638 PERFORM S410-FILING-SCHEDULE THRU S410-EXIT DTSCS26 +04639 IF L410-ANN-SCHED-88 DTSCS26 +04640 PERFORM S7105-CHK-ADJ-TYPE THRU S7105-EXIT DTSCS26 +04641 IF ADJ-FOUR-QTRS-YES-88 DTSCS26 +04642 PERFORM S7110-SET-QTRS THRU S7110-EXIT DTSCS26 +04643 END-IF DTSCS26 +04644 END-IF. DTSCS26 +04645 * IF SUM-FOUR-QTRS-YES-88 DTSCS26 +04646 * OR ADJ-FOUR-QTRS-YES-88 DTSCS26 +04647 * PERFORM S7110-SUM-ANN-QTR THRU S7110-EXIT DTSCS26 +04648 * PERFORM S7120-DISTRIB-ADJ THRU S7120-EXIT. DTSCS26 04649 DTSCS26 -04650 S7105-EXIT. DTSCS26 +04650 S7100-EXIT. DTSCS26 04651 EXIT. DTSCS26 04652 DTSCS26 -04653 S7110-SET-QTRS. DTSCS26 -04654 PERFORM S7111-INIT-MQTR-TBL THRU S7111-EXIT. DTSCS26 -04655 DTSCS26 -04656 MOVE MQTR-YRQ TO L004-QTR-5-9. DTSCS26 -04657 MOVE 1 TO L004-QTR-5-Q DTSCS26 -04658 QTR-SUB. DTSCS26 -04659 MOVE L004-QTR-5-9 TO WRK-MQTR-YRQ (QTR-SUB). DTSCS26 -04660 PERFORM S7150-CHK-FOR-BYPASS THRU S7150-EXIT. DTSCS26 -04661 DTSCS26 -04662 MOVE MQTR-YRQ TO L004-QTR-5-9. DTSCS26 -04663 MOVE 2 TO L004-QTR-5-Q DTSCS26 -04664 QTR-SUB. DTSCS26 -04665 MOVE L004-QTR-5-9 TO WRK-MQTR-YRQ (QTR-SUB). DTSCS26 -04666 PERFORM S7150-CHK-FOR-BYPASS THRU S7150-EXIT. DTSCS26 -04667 DTSCS26 -04668 MOVE MQTR-YRQ TO L004-QTR-5-9. DTSCS26 -04669 MOVE 3 TO L004-QTR-5-Q DTSCS26 -04670 QTR-SUB. DTSCS26 -04671 MOVE L004-QTR-5-9 TO WRK-MQTR-YRQ (QTR-SUB). DTSCS26 -04672 PERFORM S7150-CHK-FOR-BYPASS THRU S7150-EXIT. DTSCS26 -04673 DTSCS26 -04674 MOVE MQTR-YRQ TO L004-QTR-5-9. DTSCS26 -04675 MOVE 4 TO L004-QTR-5-Q DTSCS26 -04676 QTR-SUB. DTSCS26 -04677 MOVE L004-QTR-5-9 TO WRK-MQTR-YRQ (QTR-SUB). DTSCS26 -04678 PERFORM S7150-CHK-FOR-BYPASS THRU S7150-EXIT. DTSCS26 -04679 DTSCS26 -04680 S7110-EXIT. DTSCS26 -04681 EXIT. DTSCS26 -04682 DTSCS26 -04683 ************************************************************* DTSCS26 -04684 * FOR QUARTERS REPORTED ANNUALLY, READ ALL 4 QUARTERS DTSCS26 -04685 * COVERED BY THE ANNUAL REPORT AND BUILD A COMBINED MQTR DTSCS26 -04686 * RECORD, SUMMING THE VALUES IN THE MATRIX OF ACCOUNTS. DTSCS26 -04687 ************************************************************* DTSCS26 -04688 *S7110-SUM-ANN-QTR. DTSCS26 -04689 * PERFORM S7111-INIT-MQTR-TBL THRU S7111-EXIT. DTSCS26 -04690 * DTSCS26 -04691 * MOVE MQTR-YRQ TO L004-QTR-5-9. DTSCS26 -04692 * MOVE 1 TO L004-QTR-5-Q DTSCS26 -04693 * QTR-SUB. DTSCS26 -04694 * MOVE L004-QTR-5-9 TO WRK-MQTR-YRQ (QTR-SUB). DTSCS26 -04695 * IF SUM-FOUR-QTRS-YES-88 DTSCS26 -04696 * PERFORM S7112-GET-ACCT-DATA THRU S7112-EXIT DTSCS26 -04697 * ELSE DTSCS26 -04698 * IF ADJ-FOUR-QTRS-YES-88 DTSCS26 -04699 * PERFORM S7150-CHK-FOR-BYPASS THRU S7150-EXIT. DTSCS26 -04700 * DTSCS26 -04701 * MOVE 2 TO L004-QTR-5-Q DTSCS26 -04702 * QTR-SUB. DTSCS26 -04703 * MOVE L004-QTR-5-9 TO WRK-MQTR-YRQ (QTR-SUB). DTSCS26 -04704 * IF SUM-FOUR-QTRS-YES-88 DTSCS26 -04705 * PERFORM S7112-GET-ACCT-DATA THRU S7112-EXIT DTSCS26 -04706 * ELSE DTSCS26 -04707 * IF ADJ-FOUR-QTRS-YES-88 DTSCS26 -04708 * PERFORM S7150-CHK-FOR-BYPASS THRU S7150-EXIT. DTSCS26 -04709 * DTSCS26 -04710 * MOVE 3 TO L004-QTR-5-Q DTSCS26 -04711 * QTR-SUB. DTSCS26 -04712 * MOVE L004-QTR-5-9 TO WRK-MQTR-YRQ (QTR-SUB). DTSCS26 -04713 * IF SUM-FOUR-QTRS-YES-88 DTSCS26 -04714 * PERFORM S7112-GET-ACCT-DATA THRU S7112-EXIT DTSCS26 -04715 * ELSE DTSCS26 -04716 * IF ADJ-FOUR-QTRS-YES-88 DTSCS26 -04717 * PERFORM S7150-CHK-FOR-BYPASS THRU S7150-EXIT. DTSCS26 -04718 * DTSCS26 -04719 * MOVE 4 TO L004-QTR-5-Q DTSCS26 -04720 * QTR-SUB. DTSCS26 -04721 * MOVE L004-QTR-5-9 TO WRK-MQTR-YRQ (QTR-SUB). DTSCS26 -04722 * IF SUM-FOUR-QTRS-YES-88 DTSCS26 -04723 * PERFORM S7112-GET-ACCT-DATA THRU S7112-EXIT DTSCS26 -04724 * ELSE DTSCS26 -04725 * IF ADJ-FOUR-QTRS-YES-88 DTSCS26 -04726 * PERFORM S7150-CHK-FOR-BYPASS THRU S7150-EXIT. DTSCS26 +04653 ************************************************************* DTSCS26 +04654 * DETERMINE WHETHER THE EDITS REQUIRE THAT THE ACCOUNTING DTSCS26 +04655 * DATA FROM ALL QUARTERS COVERED BY THE ANNUAL REPORT DTSCS26 +04656 * MUST BE SUMMED TO PRODUCE A SINGLE ANNUAL TOTAL. DTSCS26 +04657 * THIS IS NECESSARY FOR CHARGE AND WAIVER EDITS. SET DTSCS26 +04658 * SUM-FOUR-QTRS-YES-88 TO TRUE FOR THESE ADJUSTMENTS. DTSCS26 +04659 * DTSCS26 +04660 * DTSCS26 +04661 * DETERMINE WHETHER THE ADJUSTMENT REQUIRES SEPARATE DTSCS26 +04662 * ACCOUNTING TRANSACTIONS FOR EACH QUARTER COVERED BY AN DTSCS26 +04663 * ANNUAL REPORT. SET ADJ-FOUR-QTRS-YES-88 TO TRUE FOR DTSCS26 +04664 * THESE ADJUSTMENTS. DTSCS26 +04665 ************************************************************* DTSCS26 +04666 S7105-CHK-ADJ-TYPE. DTSCS26 +04667 *& SET SUM-FOUR-QTRS-NO-88 TO TRUE. DTSCS26 +04668 SET ADJ-FOUR-QTRS-NO-88 TO TRUE. DTSCS26 +04669 DTSCS26 +04670 *& IF AADJ-CHARGE-88 DTSCS26 +04671 * IF AADJ-LATE-PEN-88 OR AADJ-MISC-PEN-88 DTSCS26 +04672 * SET SUM-FOUR-QTRS-YES-88 TO TRUE DTSCS26 +04673 * SET ADJ-FOUR-QTRS-YES-88 TO TRUE DTSCS26 +04674 * END-IF DTSCS26 +04675 * ELSE DTSCS26 +04676 * IF AADJ-WAIVE-88 DTSCS26 +04677 * SET SUM-FOUR-QTRS-YES-88 TO TRUE DTSCS26 +04678 * SET ADJ-FOUR-QTRS-YES-88 TO TRUE DTSCS26 +04679 *& ELSE DTSCS26 +04680 IF AADJ-AUTO-88 DTSCS26 +04681 OR AADJ-MANUAL-88 DTSCS26 +04682 OR AADJ-DUE-DATE-88 DTSCS26 +04683 OR AADJ-WAIVE-DATE-88 DTSCS26 +04684 OR AADJ-INT-DATE-88 DTSCS26 +04685 SET ADJ-FOUR-QTRS-YES-88 TO TRUE. DTSCS26 +04686 DTSCS26 +04687 S7105-EXIT. DTSCS26 +04688 EXIT. DTSCS26 +04689 DTSCS26 +04690 S7110-SET-QTRS. DTSCS26 +04691 PERFORM S7111-INIT-MQTR-TBL THRU S7111-EXIT. DTSCS26 +04692 DTSCS26 +04693 MOVE MQTR-YRQ TO L004-QTR-5-9. DTSCS26 +04694 MOVE 1 TO L004-QTR-5-Q DTSCS26 +04695 QTR-SUB. DTSCS26 +04696 MOVE L004-QTR-5-9 TO WRK-MQTR-YRQ (QTR-SUB). DTSCS26 +04697 PERFORM S7150-CHK-FOR-BYPASS THRU S7150-EXIT. DTSCS26 +04698 DTSCS26 +04699 MOVE MQTR-YRQ TO L004-QTR-5-9. DTSCS26 +04700 MOVE 2 TO L004-QTR-5-Q DTSCS26 +04701 QTR-SUB. DTSCS26 +04702 MOVE L004-QTR-5-9 TO WRK-MQTR-YRQ (QTR-SUB). DTSCS26 +04703 PERFORM S7150-CHK-FOR-BYPASS THRU S7150-EXIT. DTSCS26 +04704 DTSCS26 +04705 MOVE MQTR-YRQ TO L004-QTR-5-9. DTSCS26 +04706 MOVE 3 TO L004-QTR-5-Q DTSCS26 +04707 QTR-SUB. DTSCS26 +04708 MOVE L004-QTR-5-9 TO WRK-MQTR-YRQ (QTR-SUB). DTSCS26 +04709 PERFORM S7150-CHK-FOR-BYPASS THRU S7150-EXIT. DTSCS26 +04710 DTSCS26 +04711 MOVE MQTR-YRQ TO L004-QTR-5-9. DTSCS26 +04712 MOVE 4 TO L004-QTR-5-Q DTSCS26 +04713 QTR-SUB. DTSCS26 +04714 MOVE L004-QTR-5-9 TO WRK-MQTR-YRQ (QTR-SUB). DTSCS26 +04715 PERFORM S7150-CHK-FOR-BYPASS THRU S7150-EXIT. DTSCS26 +04716 DTSCS26 +04717 S7110-EXIT. DTSCS26 +04718 EXIT. DTSCS26 +04719 DTSCS26 +04720 ************************************************************* DTSCS26 +04721 * FOR QUARTERS REPORTED ANNUALLY, READ ALL 4 QUARTERS DTSCS26 +04722 * COVERED BY THE ANNUAL REPORT AND BUILD A COMBINED MQTR DTSCS26 +04723 * RECORD, SUMMING THE VALUES IN THE MATRIX OF ACCOUNTS. DTSCS26 +04724 ************************************************************* DTSCS26 +04725 *S7110-SUM-ANN-QTR. DTSCS26 +04726 * PERFORM S7111-INIT-MQTR-TBL THRU S7111-EXIT. DTSCS26 04727 * DTSCS26 -04728 * IF SUM-FOUR-QTRS-YES-88 DTSCS26 -04729 * MOVE WRK-MQTR-ACCT-CNT (TOT-SUB) TO MQTR-ACCT-CNT DTSCS26 -04730 * MOVE WRK-ANN-ACCT-AREA (TOT-SUB) TO MQTR-ACCT-AREA. DTSCS26 -04731 * DTSCS26 -04732 *S7110-EXIT. DTSCS26 -04733 * EXIT. DTSCS26 -04734 * DTSCS26 -04735 S7111-INIT-MQTR-TBL. DTSCS26 -04736 PERFORM DTSCS26 -04737 VARYING QTR-SUB FROM +1 BY +1 DTSCS26 -04738 UNTIL QTR-SUB > +4 DTSCS26 -04739 MOVE +0 TO WRK-MQTR-YRQ (QTR-SUB) DTSCS26 -04740 *** WRK-MQTR-ADJ-AMT (QTR-SUB) DTSCS26 -04741 *** WRK-MQTR-ACCT-CNT (QTR-SUB) DTSCS26 -04742 SET WRK-MQTR-BYPASS-NO-88 (QTR-SUB) TO TRUE DTSCS26 -04743 *** PERFORM S7111A-INIT-ACCT-AREA THRU S7111A-EXIT DTSCS26 -04744 END-PERFORM. DTSCS26 -04745 DTSCS26 -04746 S7111-EXIT. DTSCS26 -04747 EXIT. DTSCS26 -04748 * DTSCS26 -04749 *S7111A-INIT-ACCT-AREA. DTSCS26 -04750 * PERFORM DTSCS26 -04751 * VARYING ACCT-SUB FROM +1 BY +1 DTSCS26 -04752 * UNTIL ACCT-SUB > +10 DTSCS26 -04753 * MOVE +0 TO DTSCS26 -04754 * WRK-MQTR-CHARGED-AMT (QTR-SUB, ACCT-SUB) DTSCS26 -04755 * WRK-MQTR-PAID-AMT (QTR-SUB, ACCT-SUB) DTSCS26 -04756 * WRK-MQTR-WAIVED-AMT (QTR-SUB, ACCT-SUB) DTSCS26 -04757 * WRK-MQTR-WRITTEN-OFF-AMT (QTR-SUB, ACCT-SUB) DTSCS26 -04758 * WRK-MQTR-TOLER-AMT (QTR-SUB, ACCT-SUB) DTSCS26 -04759 * WRK-MQTR-BALANCE-AMT (QTR-SUB, ACCT-SUB) DTSCS26 -04760 * MOVE SPACE TO DTSCS26 -04761 * WRK-MQTR-ACCT-IND (QTR-SUB, ACCT-SUB) DTSCS26 -04762 * END-PERFORM. DTSCS26 -04763 *S7111A-EXIT. DTSCS26 -04764 * EXIT. DTSCS26 -04765 * DTSCS26 -04766 *S7112-GET-ACCT-DATA. DTSCS26 -04767 * MOVE L004-QTR-5-9 TO MQTR-YRQ. DTSCS26 -04768 * MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSCS26 -04769 * PERFORM S810-READ THRU S810-EXIT. DTSCS26 -04770 * IF L810-OK-88 DTSCS26 -04771 * MOVE MSKL-REC TO MQTR-REC DTSCS26 -04772 * MOVE MQTR-ACCT-CNT DTSCS26 -04773 * TO WRK-MQTR-ACCT-CNT (QTR-SUB) DTSCS26 -04774 * MOVE MQTR-ACCT-AREA DTSCS26 -04775 * TO WRK-ANN-ACCT-AREA (QTR-SUB). DTSCS26 -04776 * DTSCS26 -04777 * PERFORM DTSCS26 -04778 * VARYING ACCT-SUB FROM +1 BY +1 DTSCS26 -04779 * UNTIL ACCT-SUB > WRK-MQTR-ACCT-CNT (QTR-SUB) DTSCS26 -04780 * PERFORM S7119-TOT-ACCT-SUB THRU S7119-EXIT DTSCS26 -04781 * MOVE WRK-MQTR-ACCT-IND (QTR-SUB, ACCT-SUB) TO DTSCS26 -04782 * WRK-MQTR-ACCT-IND (TOT-SUB, ACCT1-SUB) DTSCS26 -04783 * ADD WRK-MQTR-CHARGED-AMT (QTR-SUB, ACCT-SUB) TO DTSCS26 -04784 * WRK-MQTR-CHARGED-AMT (TOT-SUB, ACCT1-SUB) DTSCS26 -04785 * ADD WRK-MQTR-PAID-AMT (QTR-SUB, ACCT-SUB) TO DTSCS26 -04786 * WRK-MQTR-PAID-AMT (TOT-SUB, ACCT1-SUB) DTSCS26 -04787 * ADD WRK-MQTR-WAIVED-AMT (QTR-SUB, ACCT-SUB) TO DTSCS26 -04788 * WRK-MQTR-WAIVED-AMT (TOT-SUB, ACCT1-SUB) DTSCS26 -04789 * ADD WRK-MQTR-WRITTEN-OFF-AMT (QTR-SUB, ACCT-SUB) TO DTSCS26 -04790 * WRK-MQTR-WRITTEN-OFF-AMT (TOT-SUB, ACCT1-SUB) DTSCS26 -04791 * ADD WRK-MQTR-TOLER-AMT (QTR-SUB, ACCT-SUB) TO DTSCS26 -04792 * WRK-MQTR-TOLER-AMT (TOT-SUB, ACCT1-SUB) DTSCS26 -04793 * ADD WRK-MQTR-BALANCE-AMT (QTR-SUB, ACCT-SUB) TO DTSCS26 -04794 * WRK-MQTR-BALANCE-AMT (TOT-SUB, ACCT1-SUB) DTSCS26 -04795 * END-PERFORM. DTSCS26 -04796 * DTSCS26 -04797 *S7112-EXIT. DTSCS26 -04798 * EXIT. DTSCS26 -04799 * DTSCS26 -04800 *S7119-TOT-ACCT-SUB. DTSCS26 -04801 * MOVE ZERO TO ACCT1-SUB. DTSCS26 +04728 * MOVE MQTR-YRQ TO L004-QTR-5-9. DTSCS26 +04729 * MOVE 1 TO L004-QTR-5-Q DTSCS26 +04730 * QTR-SUB. DTSCS26 +04731 * MOVE L004-QTR-5-9 TO WRK-MQTR-YRQ (QTR-SUB). DTSCS26 +04732 * IF SUM-FOUR-QTRS-YES-88 DTSCS26 +04733 * PERFORM S7112-GET-ACCT-DATA THRU S7112-EXIT DTSCS26 +04734 * ELSE DTSCS26 +04735 * IF ADJ-FOUR-QTRS-YES-88 DTSCS26 +04736 * PERFORM S7150-CHK-FOR-BYPASS THRU S7150-EXIT. DTSCS26 +04737 * DTSCS26 +04738 * MOVE 2 TO L004-QTR-5-Q DTSCS26 +04739 * QTR-SUB. DTSCS26 +04740 * MOVE L004-QTR-5-9 TO WRK-MQTR-YRQ (QTR-SUB). DTSCS26 +04741 * IF SUM-FOUR-QTRS-YES-88 DTSCS26 +04742 * PERFORM S7112-GET-ACCT-DATA THRU S7112-EXIT DTSCS26 +04743 * ELSE DTSCS26 +04744 * IF ADJ-FOUR-QTRS-YES-88 DTSCS26 +04745 * PERFORM S7150-CHK-FOR-BYPASS THRU S7150-EXIT. DTSCS26 +04746 * DTSCS26 +04747 * MOVE 3 TO L004-QTR-5-Q DTSCS26 +04748 * QTR-SUB. DTSCS26 +04749 * MOVE L004-QTR-5-9 TO WRK-MQTR-YRQ (QTR-SUB). DTSCS26 +04750 * IF SUM-FOUR-QTRS-YES-88 DTSCS26 +04751 * PERFORM S7112-GET-ACCT-DATA THRU S7112-EXIT DTSCS26 +04752 * ELSE DTSCS26 +04753 * IF ADJ-FOUR-QTRS-YES-88 DTSCS26 +04754 * PERFORM S7150-CHK-FOR-BYPASS THRU S7150-EXIT. DTSCS26 +04755 * DTSCS26 +04756 * MOVE 4 TO L004-QTR-5-Q DTSCS26 +04757 * QTR-SUB. DTSCS26 +04758 * MOVE L004-QTR-5-9 TO WRK-MQTR-YRQ (QTR-SUB). DTSCS26 +04759 * IF SUM-FOUR-QTRS-YES-88 DTSCS26 +04760 * PERFORM S7112-GET-ACCT-DATA THRU S7112-EXIT DTSCS26 +04761 * ELSE DTSCS26 +04762 * IF ADJ-FOUR-QTRS-YES-88 DTSCS26 +04763 * PERFORM S7150-CHK-FOR-BYPASS THRU S7150-EXIT. DTSCS26 +04764 * DTSCS26 +04765 * IF SUM-FOUR-QTRS-YES-88 DTSCS26 +04766 * MOVE WRK-MQTR-ACCT-CNT (TOT-SUB) TO MQTR-ACCT-CNT DTSCS26 +04767 * MOVE WRK-ANN-ACCT-AREA (TOT-SUB) TO MQTR-ACCT-AREA. DTSCS26 +04768 * DTSCS26 +04769 *S7110-EXIT. DTSCS26 +04770 * EXIT. DTSCS26 +04771 * DTSCS26 +04772 S7111-INIT-MQTR-TBL. DTSCS26 +04773 PERFORM DTSCS26 +04774 VARYING QTR-SUB FROM +1 BY +1 DTSCS26 +04775 UNTIL QTR-SUB > +4 DTSCS26 +04776 MOVE +0 TO WRK-MQTR-YRQ (QTR-SUB) DTSCS26 +04777 *** WRK-MQTR-ADJ-AMT (QTR-SUB) DTSCS26 +04778 *** WRK-MQTR-ACCT-CNT (QTR-SUB) DTSCS26 +04779 SET WRK-MQTR-BYPASS-NO-88 (QTR-SUB) TO TRUE DTSCS26 +04780 *** PERFORM S7111A-INIT-ACCT-AREA THRU S7111A-EXIT DTSCS26 +04781 END-PERFORM. DTSCS26 +04782 DTSCS26 +04783 S7111-EXIT. DTSCS26 +04784 EXIT. DTSCS26 +04785 * DTSCS26 +04786 *S7111A-INIT-ACCT-AREA. DTSCS26 +04787 * PERFORM DTSCS26 +04788 * VARYING ACCT-SUB FROM +1 BY +1 DTSCS26 +04789 * UNTIL ACCT-SUB > +10 DTSCS26 +04790 * MOVE +0 TO DTSCS26 +04791 * WRK-MQTR-CHARGED-AMT (QTR-SUB, ACCT-SUB) DTSCS26 +04792 * WRK-MQTR-PAID-AMT (QTR-SUB, ACCT-SUB) DTSCS26 +04793 * WRK-MQTR-WAIVED-AMT (QTR-SUB, ACCT-SUB) DTSCS26 +04794 * WRK-MQTR-WRITTEN-OFF-AMT (QTR-SUB, ACCT-SUB) DTSCS26 +04795 * WRK-MQTR-TOLER-AMT (QTR-SUB, ACCT-SUB) DTSCS26 +04796 * WRK-MQTR-BALANCE-AMT (QTR-SUB, ACCT-SUB) DTSCS26 +04797 * MOVE SPACE TO DTSCS26 +04798 * WRK-MQTR-ACCT-IND (QTR-SUB, ACCT-SUB) DTSCS26 +04799 * END-PERFORM. DTSCS26 +04800 *S7111A-EXIT. DTSCS26 +04801 * EXIT. DTSCS26 04802 * DTSCS26 -04803 * PERFORM DTSCS26 -04804 * VARYING ACCT2-SUB FROM +1 BY +1 DTSCS26 -04805 * UNTIL ACCT2-SUB > WRK-MQTR-ACCT-CNT (TOT-SUB) DTSCS26 -04806 * IF WRK-MQTR-ACCT-IND (TOT-SUB, ACCT2-SUB) = DTSCS26 -04807 * WRK-MQTR-ACCT-IND (QTR-SUB, ACCT-SUB) DTSCS26 -04808 * MOVE ACCT2-SUB TO ACCT1-SUB DTSCS26 -04809 * END-IF DTSCS26 -04810 * END-PERFORM. DTSCS26 -04811 * DTSCS26 -04812 * IF ACCT1-SUB = ZERO DTSCS26 -04813 * ADD +1 TO WRK-MQTR-ACCT-CNT (TOT-SUB) DTSCS26 -04814 * MOVE WRK-MQTR-ACCT-CNT (TOT-SUB) TO ACCT1-SUB. DTSCS26 -04815 * DTSCS26 -04816 *S7119-EXIT. DTSCS26 -04817 * EXIT. DTSCS26 -04818 * DTSCS26 -04819 * DTSCS26 -04820 *S7120-DISTRIB-ADJ. DTSCS26 -04821 * IF WRK-AMT = ZERO DTSCS26 -04822 * GO TO S7120-EXIT. DTSCS26 -04823 * DTSCS26 -04824 * MOVE WRK-AMT TO WRK-AMT-REMAIN. DTSCS26 -04825 * MOVE ZERO TO WRK-LARGEST-AMT DTSCS26 -04826 * WRK-LARGEST-YRQ. DTSCS26 -04827 * DTSCS26 -04828 * DTSCS26 -04829 *& IF AADJ-CHARGE-88 DTSCS26 -04830 * PERFORM S7121-DISTRIB-CHARGE THRU S7121-EXIT. DTSCS26 -04831 *& ELSE DTSCS26 -04832 *& IF AADJ-WAIVE-88 DTSCS26 -04833 *& PERFORM S7122-DISTRIB-WAIVE THRU S7122-EXIT. DTSCS26 -04834 * DTSCS26 -04835 *S7120-EXIT. DTSCS26 -04836 * EXIT. DTSCS26 -04837 * DTSCS26 -04838 *S7121-DISTRIB-CHARGE. DTSCS26 -04839 * MOVE ZERO TO WRK-TOT-AMT. DTSCS26 -04840 * PERFORM S7128-TOT-SUB THRU S7128-EXIT. DTSCS26 -04841 * IF ACCT2-SUB = ZERO DTSCS26 -04842 * GO TO S7121-EXIT. DTSCS26 -04843 * DTSCS26 -04844 * ADD WRK-MQTR-CHARGED-AMT (TOT-SUB, ACCT2-SUB) DTSCS26 -04845 * TO WRK-TOT-AMT. DTSCS26 -04846 * IF WRK-TOT-AMT = ZERO DTSCS26 -04847 * GO TO S7121-EXIT. DTSCS26 +04803 *S7112-GET-ACCT-DATA. DTSCS26 +04804 * MOVE L004-QTR-5-9 TO MQTR-YRQ. DTSCS26 +04805 * MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSCS26 +04806 * PERFORM S810-READ THRU S810-EXIT. DTSCS26 +04807 * IF L810-OK-88 DTSCS26 +04808 * MOVE MSKL-REC TO MQTR-REC DTSCS26 +04809 * MOVE MQTR-ACCT-CNT DTSCS26 +04810 * TO WRK-MQTR-ACCT-CNT (QTR-SUB) DTSCS26 +04811 * MOVE MQTR-ACCT-AREA DTSCS26 +04812 * TO WRK-ANN-ACCT-AREA (QTR-SUB). DTSCS26 +04813 * DTSCS26 +04814 * PERFORM DTSCS26 +04815 * VARYING ACCT-SUB FROM +1 BY +1 DTSCS26 +04816 * UNTIL ACCT-SUB > WRK-MQTR-ACCT-CNT (QTR-SUB) DTSCS26 +04817 * PERFORM S7119-TOT-ACCT-SUB THRU S7119-EXIT DTSCS26 +04818 * MOVE WRK-MQTR-ACCT-IND (QTR-SUB, ACCT-SUB) TO DTSCS26 +04819 * WRK-MQTR-ACCT-IND (TOT-SUB, ACCT1-SUB) DTSCS26 +04820 * ADD WRK-MQTR-CHARGED-AMT (QTR-SUB, ACCT-SUB) TO DTSCS26 +04821 * WRK-MQTR-CHARGED-AMT (TOT-SUB, ACCT1-SUB) DTSCS26 +04822 * ADD WRK-MQTR-PAID-AMT (QTR-SUB, ACCT-SUB) TO DTSCS26 +04823 * WRK-MQTR-PAID-AMT (TOT-SUB, ACCT1-SUB) DTSCS26 +04824 * ADD WRK-MQTR-WAIVED-AMT (QTR-SUB, ACCT-SUB) TO DTSCS26 +04825 * WRK-MQTR-WAIVED-AMT (TOT-SUB, ACCT1-SUB) DTSCS26 +04826 * ADD WRK-MQTR-WRITTEN-OFF-AMT (QTR-SUB, ACCT-SUB) TO DTSCS26 +04827 * WRK-MQTR-WRITTEN-OFF-AMT (TOT-SUB, ACCT1-SUB) DTSCS26 +04828 * ADD WRK-MQTR-TOLER-AMT (QTR-SUB, ACCT-SUB) TO DTSCS26 +04829 * WRK-MQTR-TOLER-AMT (TOT-SUB, ACCT1-SUB) DTSCS26 +04830 * ADD WRK-MQTR-BALANCE-AMT (QTR-SUB, ACCT-SUB) TO DTSCS26 +04831 * WRK-MQTR-BALANCE-AMT (TOT-SUB, ACCT1-SUB) DTSCS26 +04832 * END-PERFORM. DTSCS26 +04833 * DTSCS26 +04834 *S7112-EXIT. DTSCS26 +04835 * EXIT. DTSCS26 +04836 * DTSCS26 +04837 *S7119-TOT-ACCT-SUB. DTSCS26 +04838 * MOVE ZERO TO ACCT1-SUB. DTSCS26 +04839 * DTSCS26 +04840 * PERFORM DTSCS26 +04841 * VARYING ACCT2-SUB FROM +1 BY +1 DTSCS26 +04842 * UNTIL ACCT2-SUB > WRK-MQTR-ACCT-CNT (TOT-SUB) DTSCS26 +04843 * IF WRK-MQTR-ACCT-IND (TOT-SUB, ACCT2-SUB) = DTSCS26 +04844 * WRK-MQTR-ACCT-IND (QTR-SUB, ACCT-SUB) DTSCS26 +04845 * MOVE ACCT2-SUB TO ACCT1-SUB DTSCS26 +04846 * END-IF DTSCS26 +04847 * END-PERFORM. DTSCS26 04848 * DTSCS26 -04849 * PERFORM DTSCS26 -04850 * VARYING QTR-SUB FROM +1 BY +1 DTSCS26 -04851 * UNTIL QTR-SUB > +4 DTSCS26 -04852 * MOVE ZERO TO WRK-QTR-AMT DTSCS26 -04853 * PERFORM S7129-ACCT-SUB THRU S7129-EXIT DTSCS26 -04854 * IF ACCT1-SUB > ZERO DTSCS26 -04855 * ADD WRK-MQTR-CHARGED-AMT (QTR-SUB, ACCT1-SUB) DTSCS26 -04856 * TO WRK-QTR-AMT DTSCS26 -04857 * PERFORM S7127-CALC-AMT THRU S7127-EXIT DTSCS26 -04858 * END-IF DTSCS26 -04859 * END-PERFORM. DTSCS26 +04849 * IF ACCT1-SUB = ZERO DTSCS26 +04850 * ADD +1 TO WRK-MQTR-ACCT-CNT (TOT-SUB) DTSCS26 +04851 * MOVE WRK-MQTR-ACCT-CNT (TOT-SUB) TO ACCT1-SUB. DTSCS26 +04852 * DTSCS26 +04853 *S7119-EXIT. DTSCS26 +04854 * EXIT. DTSCS26 +04855 * DTSCS26 +04856 * DTSCS26 +04857 *S7120-DISTRIB-ADJ. DTSCS26 +04858 * IF WRK-AMT = ZERO DTSCS26 +04859 * GO TO S7120-EXIT. DTSCS26 04860 * DTSCS26 -04861 * IF WRK-AMT-REMAIN NOT = ZERO DTSCS26 -04862 * ADD WRK-AMT-REMAIN TO DTSCS26 -04863 * WRK-MQTR-ADJ-AMT (WRK-LARGEST-YRQ). DTSCS26 +04861 * MOVE WRK-AMT TO WRK-AMT-REMAIN. DTSCS26 +04862 * MOVE ZERO TO WRK-LARGEST-AMT DTSCS26 +04863 * WRK-LARGEST-YRQ. DTSCS26 04864 * DTSCS26 -04865 *S7121-EXIT. DTSCS26 -04866 * EXIT. DTSCS26 -04867 * DTSCS26 -04868 *S7122-DISTRIB-WAIVE. DTSCS26 -04869 * MOVE ZERO TO WRK-TOT-AMT. DTSCS26 -04870 * PERFORM S7128-TOT-SUB THRU S7128-EXIT. DTSCS26 -04871 * IF ACCT2-SUB = ZERO DTSCS26 -04872 * GO TO S7122-EXIT. DTSCS26 -04873 * DTSCS26 -04874 * ADD WRK-MQTR-WAIVED-AMT (TOT-SUB, ACCT2-SUB) DTSCS26 -04875 * TO WRK-TOT-AMT. DTSCS26 -04876 * IF WRK-TOT-AMT = ZERO DTSCS26 -04877 * GO TO S7122-EXIT. DTSCS26 -04878 * DTSCS26 -04879 * PERFORM DTSCS26 -04880 * VARYING QTR-SUB FROM +1 BY +1 DTSCS26 -04881 * UNTIL QTR-SUB > +4 DTSCS26 -04882 * MOVE ZERO TO WRK-QTR-AMT DTSCS26 -04883 * PERFORM S7129-ACCT-SUB THRU S7129-EXIT DTSCS26 -04884 * IF ACCT1-SUB > ZERO DTSCS26 -04885 * ADD WRK-MQTR-WAIVED-AMT (QTR-SUB, ACCT1-SUB) DTSCS26 -04886 * TO WRK-QTR-AMT DTSCS26 -04887 * PERFORM S7127-CALC-AMT THRU S7127-EXIT DTSCS26 -04888 * END-IF DTSCS26 -04889 * END-PERFORM. DTSCS26 -04890 * DTSCS26 -04891 * IF WRK-AMT-REMAIN NOT = ZERO DTSCS26 -04892 * ADD WRK-AMT-REMAIN TO DTSCS26 -04893 * WRK-MQTR-ADJ-AMT (WRK-LARGEST-YRQ). DTSCS26 -04894 * DTSCS26 -04895 *S7122-EXIT. DTSCS26 -04896 * EXIT. DTSCS26 +04865 * DTSCS26 +04866 *& IF AADJ-CHARGE-88 DTSCS26 +04867 * PERFORM S7121-DISTRIB-CHARGE THRU S7121-EXIT. DTSCS26 +04868 *& ELSE DTSCS26 +04869 *& IF AADJ-WAIVE-88 DTSCS26 +04870 *& PERFORM S7122-DISTRIB-WAIVE THRU S7122-EXIT. DTSCS26 +04871 * DTSCS26 +04872 *S7120-EXIT. DTSCS26 +04873 * EXIT. DTSCS26 +04874 * DTSCS26 +04875 *S7121-DISTRIB-CHARGE. DTSCS26 +04876 * MOVE ZERO TO WRK-TOT-AMT. DTSCS26 +04877 * PERFORM S7128-TOT-SUB THRU S7128-EXIT. DTSCS26 +04878 * IF ACCT2-SUB = ZERO DTSCS26 +04879 * GO TO S7121-EXIT. DTSCS26 +04880 * DTSCS26 +04881 * ADD WRK-MQTR-CHARGED-AMT (TOT-SUB, ACCT2-SUB) DTSCS26 +04882 * TO WRK-TOT-AMT. DTSCS26 +04883 * IF WRK-TOT-AMT = ZERO DTSCS26 +04884 * GO TO S7121-EXIT. DTSCS26 +04885 * DTSCS26 +04886 * PERFORM DTSCS26 +04887 * VARYING QTR-SUB FROM +1 BY +1 DTSCS26 +04888 * UNTIL QTR-SUB > +4 DTSCS26 +04889 * MOVE ZERO TO WRK-QTR-AMT DTSCS26 +04890 * PERFORM S7129-ACCT-SUB THRU S7129-EXIT DTSCS26 +04891 * IF ACCT1-SUB > ZERO DTSCS26 +04892 * ADD WRK-MQTR-CHARGED-AMT (QTR-SUB, ACCT1-SUB) DTSCS26 +04893 * TO WRK-QTR-AMT DTSCS26 +04894 * PERFORM S7127-CALC-AMT THRU S7127-EXIT DTSCS26 +04895 * END-IF DTSCS26 +04896 * END-PERFORM. DTSCS26 04897 * DTSCS26 -04898 * DTSCS26 -04899 *S7127-CALC-AMT. DTSCS26 -04900 * COMPUTE WRK-MQTR-ADJ-AMT (QTR-SUB) = DTSCS26 -04901 * WRK-AMT * (WRK-QTR-AMT / WRK-TOT-AMT). DTSCS26 -04902 * DTSCS26 -04903 * IF WRK-AMT > ZERO DTSCS26 -04904 * SUBTRACT WRK-MQTR-ADJ-AMT (QTR-SUB) FROM DTSCS26 -04905 * WRK-AMT-REMAIN DTSCS26 -04906 * ELSE DTSCS26 -04907 * COMPUTE WRK-AMT-REMAIN = WRK-AMT-REMAIN + DTSCS26 -04908 * (WRK-MQTR-ADJ-AMT (QTR-SUB) * -1) DTSCS26 -04909 * END-IF. DTSCS26 +04898 * IF WRK-AMT-REMAIN NOT = ZERO DTSCS26 +04899 * ADD WRK-AMT-REMAIN TO DTSCS26 +04900 * WRK-MQTR-ADJ-AMT (WRK-LARGEST-YRQ). DTSCS26 +04901 * DTSCS26 +04902 *S7121-EXIT. DTSCS26 +04903 * EXIT. DTSCS26 +04904 * DTSCS26 +04905 *S7122-DISTRIB-WAIVE. DTSCS26 +04906 * MOVE ZERO TO WRK-TOT-AMT. DTSCS26 +04907 * PERFORM S7128-TOT-SUB THRU S7128-EXIT. DTSCS26 +04908 * IF ACCT2-SUB = ZERO DTSCS26 +04909 * GO TO S7122-EXIT. DTSCS26 04910 * DTSCS26 -04911 * IF WRK-MQTR-ADJ-AMT (QTR-SUB) > WRK-LARGEST-AMT DTSCS26 -04912 * MOVE WRK-MQTR-ADJ-AMT (QTR-SUB) DTSCS26 -04913 * TO WRK-LARGEST-YRQ DTSCS26 -04914 * END-IF. DTSCS26 +04911 * ADD WRK-MQTR-WAIVED-AMT (TOT-SUB, ACCT2-SUB) DTSCS26 +04912 * TO WRK-TOT-AMT. DTSCS26 +04913 * IF WRK-TOT-AMT = ZERO DTSCS26 +04914 * GO TO S7122-EXIT. DTSCS26 04915 * DTSCS26 -04916 *S7127-EXIT. DTSCS26 -04917 * EXIT. DTSCS26 -04918 * DTSCS26 -04919 *S7128-TOT-SUB. DTSCS26 -04920 * MOVE +0 TO ACCT2-SUB. DTSCS26 -04921 * DTSCS26 -04922 * PERFORM DTSCS26 -04923 * VARYING ACCT-SUB FROM 1 BY 1 DTSCS26 -04924 * UNTIL ACCT-SUB > WRK-MQTR-ACCT-CNT (TOT-SUB) DTSCS26 -04925 * IF WRK-MQTR-ACCT-IND (TOT-SUB, ACCT-SUB) DTSCS26 -04926 * = AADJ-APPLIC-IND DTSCS26 -04927 * MOVE ACCT-SUB TO ACCT2-SUB DTSCS26 -04928 * END-IF DTSCS26 -04929 * END-PERFORM. DTSCS26 -04930 * DTSCS26 -04931 *S7128-EXIT. DTSCS26 -04932 * EXIT. DTSCS26 -04933 * DTSCS26 -04934 *S7129-ACCT-SUB. DTSCS26 -04935 * MOVE +0 TO ACCT1-SUB. DTSCS26 -04936 * DTSCS26 -04937 * PERFORM DTSCS26 -04938 * VARYING ACCT-SUB FROM 1 BY 1 DTSCS26 -04939 * UNTIL ACCT-SUB > WRK-MQTR-ACCT-CNT (QTR-SUB) DTSCS26 -04940 * IF WRK-MQTR-ACCT-IND (QTR-SUB, ACCT-SUB) DTSCS26 -04941 * = AADJ-APPLIC-IND DTSCS26 -04942 * MOVE ACCT-SUB TO ACCT1-SUB DTSCS26 -04943 * END-IF DTSCS26 -04944 * END-PERFORM. DTSCS26 -04945 * DTSCS26 -04946 *S7129-EXIT. DTSCS26 -04947 * EXIT. DTSCS26 -04948 * DTSCS26 -04949 S7150-CHK-FOR-BYPASS. DTSCS26 -04950 IF AADJ-AUTO-88 DTSCS26 -04951 OR AADJ-DUE-DATE-88 DTSCS26 -04952 OR AADJ-WAIVE-DATE-88 DTSCS26 -04953 OR AADJ-INT-DATE-88 DTSCS26 -04954 NEXT SENTENCE DTSCS26 -04955 ELSE DTSCS26 -04956 GO TO S7150-EXIT. DTSCS26 -04957 DTSCS26 -04958 MOVE L004-QTR-5-9 TO MQTR-YRQ. DTSCS26 -04959 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSCS26 -04960 PERFORM S810-READ THRU S810-EXIT. DTSCS26 -04961 IF L810-NO-REC-88 DTSCS26 -04962 IF AADJ-AUTO-88 DTSCS26 -04963 SET WRK-MQTR-BYPASS-YES-88 (QTR-SUB) TO TRUE DTSCS26 -04964 IF (AADJ-DUE-DATE-88 DTSCS26 -04965 OR AADJ-WAIVE-DATE-88 DTSCS26 -04966 OR AADJ-INT-DATE-88) DTSCS26 -04967 IF (AADJ-DATE-1 = +0 OR ALL-NINES-DATE) DTSCS26 -04968 AND (AADJ-DATE-2 = +0 OR ALL-NINES-DATE) DTSCS26 -04969 SET WRK-MQTR-BYPASS-YES-88 (QTR-SUB) TO TRUE. DTSCS26 -04970 DTSCS26 -04971 S7150-EXIT. DTSCS26 -04972 EXIT. DTSCS26 -04973 DTSCS26 -04974 S7200-READ-APPLIC-MDST. DTSCS26 -04975 MOVE LOW-VALUES TO MDST-KEY-AREA. DTSCS26 -04976 DTSCS26 -04977 MOVE WRK-EMP-NO TO MDST-EMP-NO. DTSCS26 -04978 DTSCS26 -04979 SET MDST-DST-88 TO TRUE. DTSCS26 -04980 DTSCS26 -04981 SET MDST-CREDIT-REC-88 TO TRUE. DTSCS26 -04982 DTSCS26 -04983 MOVE WRK-APPLIC-DOC-NO TO MDST-DOC-NO. DTSCS26 -04984 DTSCS26 -04985 MOVE MDST-KEY-AREA TO MSKL-KEY-AREA. DTSCS26 -04986 DTSCS26 -04987 PERFORM S810-READ THRU S810-EXIT. DTSCS26 -04988 DTSCS26 -04989 MOVE MSKL-REC TO MDST-REC. DTSCS26 -04990 DTSCS26 -04991 IF L810-OK-88 DTSCS26 -04992 MOVE 'Y' TO WRK-MDST-EXISTS-IND DTSCS26 -04993 ELSE DTSCS26 -04994 MOVE 'N' TO WRK-MDST-EXISTS-IND. DTSCS26 -04995 S7200-EXIT. DTSCS26 -04996 EXIT. DTSCS26 -04997 /*****************************************************************DTSCS26 -04998 * LOCK SCREEN FOR UPDATE CONFIRMATION *DTSCS26 -04999 ******************************************************************DTSCS26 -05000 S5100-SET-LOCK-ATTRB. DTSCS26 -05001 MOVE CATB-ASKIP-BRT-MDTON TO WRK-ATB-AN DTSCS26 -05002 WRK-ATB-NUM. DTSCS26 -05003 DTSCS26 -05004 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS26 -05005 DTSCS26 -05006 MOVE CATB-ASKIP-BRT-MDTON TO MAP-BATCH-NO-A DTSCS26 -05007 MAP-ITEM-NO-A DTSCS26 -05008 MAP-GOTO-A. DTSCS26 -05009 S5100-EXIT. DTSCS26 -05010 EXIT. DTSCS26 -05011 DTSCS26 -05012 DTSCS26 +04916 * PERFORM DTSCS26 +04917 * VARYING QTR-SUB FROM +1 BY +1 DTSCS26 +04918 * UNTIL QTR-SUB > +4 DTSCS26 +04919 * MOVE ZERO TO WRK-QTR-AMT DTSCS26 +04920 * PERFORM S7129-ACCT-SUB THRU S7129-EXIT DTSCS26 +04921 * IF ACCT1-SUB > ZERO DTSCS26 +04922 * ADD WRK-MQTR-WAIVED-AMT (QTR-SUB, ACCT1-SUB) DTSCS26 +04923 * TO WRK-QTR-AMT DTSCS26 +04924 * PERFORM S7127-CALC-AMT THRU S7127-EXIT DTSCS26 +04925 * END-IF DTSCS26 +04926 * END-PERFORM. DTSCS26 +04927 * DTSCS26 +04928 * IF WRK-AMT-REMAIN NOT = ZERO DTSCS26 +04929 * ADD WRK-AMT-REMAIN TO DTSCS26 +04930 * WRK-MQTR-ADJ-AMT (WRK-LARGEST-YRQ). DTSCS26 +04931 * DTSCS26 +04932 *S7122-EXIT. DTSCS26 +04933 * EXIT. DTSCS26 +04934 * DTSCS26 +04935 * DTSCS26 +04936 *S7127-CALC-AMT. DTSCS26 +04937 * COMPUTE WRK-MQTR-ADJ-AMT (QTR-SUB) = DTSCS26 +04938 * WRK-AMT * (WRK-QTR-AMT / WRK-TOT-AMT). DTSCS26 +04939 * DTSCS26 +04940 * IF WRK-AMT > ZERO DTSCS26 +04941 * SUBTRACT WRK-MQTR-ADJ-AMT (QTR-SUB) FROM DTSCS26 +04942 * WRK-AMT-REMAIN DTSCS26 +04943 * ELSE DTSCS26 +04944 * COMPUTE WRK-AMT-REMAIN = WRK-AMT-REMAIN + DTSCS26 +04945 * (WRK-MQTR-ADJ-AMT (QTR-SUB) * -1) DTSCS26 +04946 * END-IF. DTSCS26 +04947 * DTSCS26 +04948 * IF WRK-MQTR-ADJ-AMT (QTR-SUB) > WRK-LARGEST-AMT DTSCS26 +04949 * MOVE WRK-MQTR-ADJ-AMT (QTR-SUB) DTSCS26 +04950 * TO WRK-LARGEST-YRQ DTSCS26 +04951 * END-IF. DTSCS26 +04952 * DTSCS26 +04953 *S7127-EXIT. DTSCS26 +04954 * EXIT. DTSCS26 +04955 * DTSCS26 +04956 *S7128-TOT-SUB. DTSCS26 +04957 * MOVE +0 TO ACCT2-SUB. DTSCS26 +04958 * DTSCS26 +04959 * PERFORM DTSCS26 +04960 * VARYING ACCT-SUB FROM 1 BY 1 DTSCS26 +04961 * UNTIL ACCT-SUB > WRK-MQTR-ACCT-CNT (TOT-SUB) DTSCS26 +04962 * IF WRK-MQTR-ACCT-IND (TOT-SUB, ACCT-SUB) DTSCS26 +04963 * = AADJ-APPLIC-IND DTSCS26 +04964 * MOVE ACCT-SUB TO ACCT2-SUB DTSCS26 +04965 * END-IF DTSCS26 +04966 * END-PERFORM. DTSCS26 +04967 * DTSCS26 +04968 *S7128-EXIT. DTSCS26 +04969 * EXIT. DTSCS26 +04970 * DTSCS26 +04971 *S7129-ACCT-SUB. DTSCS26 +04972 * MOVE +0 TO ACCT1-SUB. DTSCS26 +04973 * DTSCS26 +04974 * PERFORM DTSCS26 +04975 * VARYING ACCT-SUB FROM 1 BY 1 DTSCS26 +04976 * UNTIL ACCT-SUB > WRK-MQTR-ACCT-CNT (QTR-SUB) DTSCS26 +04977 * IF WRK-MQTR-ACCT-IND (QTR-SUB, ACCT-SUB) DTSCS26 +04978 * = AADJ-APPLIC-IND DTSCS26 +04979 * MOVE ACCT-SUB TO ACCT1-SUB DTSCS26 +04980 * END-IF DTSCS26 +04981 * END-PERFORM. DTSCS26 +04982 * DTSCS26 +04983 *S7129-EXIT. DTSCS26 +04984 * EXIT. DTSCS26 +04985 * DTSCS26 +04986 S7150-CHK-FOR-BYPASS. DTSCS26 +04987 IF AADJ-AUTO-88 DTSCS26 +04988 OR AADJ-DUE-DATE-88 DTSCS26 +04989 OR AADJ-WAIVE-DATE-88 DTSCS26 +04990 OR AADJ-INT-DATE-88 DTSCS26 +04991 NEXT SENTENCE DTSCS26 +04992 ELSE DTSCS26 +04993 GO TO S7150-EXIT. DTSCS26 +04994 DTSCS26 +04995 MOVE L004-QTR-5-9 TO MQTR-YRQ. DTSCS26 +04996 MOVE MQTR-KEY-AREA TO MSKL-KEY-AREA. DTSCS26 +04997 PERFORM S810-READ THRU S810-EXIT. DTSCS26 +04998 IF L810-NO-REC-88 DTSCS26 +04999 IF AADJ-AUTO-88 DTSCS26 +05000 SET WRK-MQTR-BYPASS-YES-88 (QTR-SUB) TO TRUE DTSCS26 +05001 IF (AADJ-DUE-DATE-88 DTSCS26 +05002 OR AADJ-WAIVE-DATE-88 DTSCS26 +05003 OR AADJ-INT-DATE-88) DTSCS26 +05004 IF (AADJ-DATE-1 = +0 OR ALL-NINES-DATE) DTSCS26 +05005 AND (AADJ-DATE-2 = +0 OR ALL-NINES-DATE) DTSCS26 +05006 SET WRK-MQTR-BYPASS-YES-88 (QTR-SUB) TO TRUE. DTSCS26 +05007 DTSCS26 +05008 S7150-EXIT. DTSCS26 +05009 EXIT. DTSCS26 +05010 DTSCS26 +05011 S7200-READ-APPLIC-MDST. DTSCS26 +05012 MOVE LOW-VALUES TO MDST-KEY-AREA. DTSCS26 05013 DTSCS26 -05014 ******************************************************************DTSCS26 -05015 * SET ATTIBUTE BYTES FOR UPDATE ACCESS *DTSCS26 -05016 ******************************************************************DTSCS26 +05014 MOVE WRK-EMP-NO TO MDST-EMP-NO. DTSCS26 +05015 DTSCS26 +05016 SET MDST-DST-88 TO TRUE. DTSCS26 05017 DTSCS26 -05018 S5200-SET-UPDATE-ATTRB. DTSCS26 -05019 MOVE CATB-UNPROT-BRT-AN-MDTON TO WRK-ATB-AN. DTSCS26 -05020 DTSCS26 -05021 MOVE CATB-UNPROT-BRT-NUM-MDTON TO WRK-ATB-NUM. DTSCS26 -05022 DTSCS26 -05023 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS26 -05024 S5200-EXIT. DTSCS26 -05025 EXIT. DTSCS26 -05026 DTSCS26 +05018 SET MDST-CREDIT-REC-88 TO TRUE. DTSCS26 +05019 DTSCS26 +05020 MOVE WRK-APPLIC-DOC-NO TO MDST-DOC-NO. DTSCS26 +05021 DTSCS26 +05022 MOVE MDST-KEY-AREA TO MSKL-KEY-AREA. DTSCS26 +05023 DTSCS26 +05024 PERFORM S810-READ THRU S810-EXIT. DTSCS26 +05025 DTSCS26 +05026 MOVE MSKL-REC TO MDST-REC. DTSCS26 05027 DTSCS26 -05028 DTSCS26 -05029 ******************************************************************DTSCS26 -05030 * SET ATTRIBUTE BYTES FOR INQUIRY STATUS *DTSCS26 -05031 ******************************************************************DTSCS26 -05032 DTSCS26 -05033 S5300-SET-INQ-ATTRB. DTSCS26 -05034 MOVE CATB-ASKIP-BRT-MDTOFF TO WRK-ATB-AN DTSCS26 -05035 WRK-ATB-NUM. DTSCS26 -05036 DTSCS26 -05037 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS26 -05038 S5300-EXIT. DTSCS26 -05039 EXIT. DTSCS26 +05028 IF L810-OK-88 DTSCS26 +05029 MOVE 'Y' TO WRK-MDST-EXISTS-IND DTSCS26 +05030 ELSE DTSCS26 +05031 MOVE 'N' TO WRK-MDST-EXISTS-IND. DTSCS26 +05032 S7200-EXIT. DTSCS26 +05033 EXIT. DTSCS26 +05034 /*****************************************************************DTSCS26 +05035 * LOCK SCREEN FOR UPDATE CONFIRMATION *DTSCS26 +05036 ******************************************************************DTSCS26 +05037 S5100-SET-LOCK-ATTRB. DTSCS26 +05038 MOVE CATB-ASKIP-BRT-MDTON TO WRK-ATB-AN DTSCS26 +05039 WRK-ATB-NUM. DTSCS26 05040 DTSCS26 -05041 DTSCS26 +05041 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS26 05042 DTSCS26 -05043 S5900-SET-ATTRB. DTSCS26 -05044 MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-BATCH-NO-A DTSCS26 -05045 MAP-ITEM-NO-A. DTSCS26 -05046 DTSCS26 -05047 MOVE WRK-ATB-AN DTSCS26 -05048 TO MAP-APPLIC-IND-A DTSCS26 -05049 MAP-DISREGARD-EDITS-IND-A DTSCS26 -05050 MAP-NAME-CHECK-A DTSCS26 -05051 MAP-RESPONSIBLE-ACTIVITY-A DTSCS26 -05052 MAP-RESPONSIBLE-OP-ID-A DTSCS26 -05053 MAP-ADJ-TYPE-A DTSCS26 -05054 MAP-INT-SPAN-IND-A DTSCS26 -05055 MAP-APPLIC-YRQ-Q-A DTSCS26 -05056 MAP-APPLIC-YRQ-YR-A. DTSCS26 +05043 MOVE CATB-ASKIP-BRT-MDTON TO MAP-BATCH-NO-A DTSCS26 +05044 MAP-ITEM-NO-A DTSCS26 +05045 MAP-GOTO-A. DTSCS26 +05046 S5100-EXIT. DTSCS26 +05047 EXIT. DTSCS26 +05048 DTSCS26 +05049 DTSCS26 +05050 DTSCS26 +05051 ******************************************************************DTSCS26 +05052 * SET ATTIBUTE BYTES FOR UPDATE ACCESS *DTSCS26 +05053 ******************************************************************DTSCS26 +05054 DTSCS26 +05055 S5200-SET-UPDATE-ATTRB. DTSCS26 +05056 MOVE CATB-UNPROT-BRT-AN-MDTON TO WRK-ATB-AN. DTSCS26 05057 DTSCS26 -05058 MOVE WRK-ATB-NUM DTSCS26 -05059 TO MAP-EMP-NO-1-A DTSCS26 -05060 MAP-EMP-NO-2-A DTSCS26 -05061 MAP-RECEIVED-DATE-DA-A DTSCS26 -05062 MAP-RECEIVED-DATE-MO-A DTSCS26 -05063 MAP-RECEIVED-DATE-YR-A DTSCS26 -05064 MAP-DATE-1-DA-A DTSCS26 -05065 MAP-DATE-1-MO-A DTSCS26 -05066 MAP-DATE-1-YR-A DTSCS26 -05067 MAP-DATE-2-DA-A DTSCS26 -05068 MAP-DATE-2-MO-A DTSCS26 -05069 MAP-DATE-2-YR-A DTSCS26 -05070 MAP-ENTRY-MODE-A DTSCS26 -05071 MAP-AMT-A DTSCS26 -05072 MAP-APPLIC-BATCH-NO-A DTSCS26 -05073 MAP-APPLIC-ITEM-NO-A DTSCS26 -05074 MAP-INT-RATE-A. DTSCS26 -05075 DTSCS26 -05076 MOVE CATB-ASKIP-NORM-MDTOFF TO MAP-CMPRMISE-LABEL-A. DTSCS26 -05077 IF LCCM-OP-IS-FLD-DESK-88 DTSCS26 -05078 OR LCCM-OP-IS-ACCOUNTING-DESK-88 DTSCS26 -05079 MOVE WRK-ATB-AN TO MAP-CMPRMISE-IND-A DTSCS26 -05080 ELSE DTSCS26 -05081 MOVE CATB-ASKIP-BRT-MDTON TO MAP-CMPRMISE-IND-A DTSCS26 -05082 END-IF. DTSCS26 +05058 MOVE CATB-UNPROT-BRT-NUM-MDTON TO WRK-ATB-NUM. DTSCS26 +05059 DTSCS26 +05060 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS26 +05061 S5200-EXIT. DTSCS26 +05062 EXIT. DTSCS26 +05063 DTSCS26 +05064 DTSCS26 +05065 DTSCS26 +05066 ******************************************************************DTSCS26 +05067 * SET ATTRIBUTE BYTES FOR INQUIRY STATUS *DTSCS26 +05068 ******************************************************************DTSCS26 +05069 DTSCS26 +05070 S5300-SET-INQ-ATTRB. DTSCS26 +05071 MOVE CATB-ASKIP-BRT-MDTOFF TO WRK-ATB-AN DTSCS26 +05072 WRK-ATB-NUM. DTSCS26 +05073 DTSCS26 +05074 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS26 +05075 S5300-EXIT. DTSCS26 +05076 EXIT. DTSCS26 +05077 DTSCS26 +05078 DTSCS26 +05079 DTSCS26 +05080 S5900-SET-ATTRB. DTSCS26 +05081 MOVE CATB-UNPROT-BRT-NUM-MDTON TO MAP-BATCH-NO-A DTSCS26 +05082 MAP-ITEM-NO-A. DTSCS26 05083 DTSCS26 -05084 MOVE CATB-ASKIP-BRT-MDTON TO MAP-PROCESSED-DATE-A. DTSCS26 -05085 DTSCS26 -05086 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-GOTO-A. DTSCS26 -05087 S5900-EXIT. DTSCS26 -05088 EXIT. DTSCS26 -05089 /*****************************************************************DTSCS26 -05090 * MAP ROUTINES *DTSCS26 -05091 ******************************************************************DTSCS26 -05092 DTSCS26 -05093 S9100-RECEIVE. DTSCS26 -05094 SET L851-RECEIVE-88 TO TRUE. DTSCS26 -05095 DTSCS26 -05096 MOVE WRK-SCR-ID TO L851-SCR-ID. DTSCS26 -05097 DTSCS26 -05098 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS26 -05099 DTSCS26 -05100 MOVE L851-AID TO LCCM-AID. DTSCS26 -05101 DTSCS26 -05102 MOVE L851-CURSOR TO LCCM-CURSOR. DTSCS26 -05103 S9100-EXIT. DTSCS26 -05104 EXIT. DTSCS26 -05105 DTSCS26 -05106 DTSCS26 -05107 DTSCS26 -05108 S9200-SEND-DATAONLY. DTSCS26 -05109 MOVE LOW-VALUES TO MAP-AREA. DTSCS26 -05110 DTSCS26 -05111 IF LCCM-NO-MSG DTSCS26 -05112 NEXT SENTENCE DTSCS26 -05113 ELSE DTSCS26 -05114 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS26 -05115 DTSCS26 -05116 IF CURSOR-SET-GOTO DTSCS26 -05117 MOVE CATB-CURSOR TO MAP-GOTO-L DTSCS26 -05118 ELSE DTSCS26 -05119 MOVE CATB-CURSOR TO MAP-BATCH-NO-L. DTSCS26 +05084 MOVE WRK-ATB-AN DTSCS26 +05085 TO MAP-APPLIC-IND-A DTSCS26 +05086 MAP-DISREGARD-EDITS-IND-A DTSCS26 +05087 MAP-NAME-CHECK-A DTSCS26 +05088 MAP-RESPONSIBLE-ACTIVITY-A DTSCS26 +05089 MAP-RESPONSIBLE-OP-ID-A DTSCS26 +05090 MAP-ADJ-TYPE-A DTSCS26 +05091 MAP-INT-SPAN-IND-A DTSCS26 +05092 MAP-APPLIC-YRQ-Q-A DTSCS26 +05093 MAP-APPLIC-YRQ-YR-A. DTSCS26 +05094 DTSCS26 +05095 MOVE WRK-ATB-NUM DTSCS26 +05096 TO MAP-EMP-NO-1-A DTSCS26 +05097 MAP-EMP-NO-2-A DTSCS26 +05098 MAP-RECEIVED-DATE-DA-A DTSCS26 +05099 MAP-RECEIVED-DATE-MO-A DTSCS26 +05100 MAP-RECEIVED-DATE-YR-A DTSCS26 +05101 MAP-DATE-1-DA-A DTSCS26 +05102 MAP-DATE-1-MO-A DTSCS26 +05103 MAP-DATE-1-YR-A DTSCS26 +05104 MAP-DATE-2-DA-A DTSCS26 +05105 MAP-DATE-2-MO-A DTSCS26 +05106 MAP-DATE-2-YR-A DTSCS26 +05107 MAP-ENTRY-MODE-A DTSCS26 +05108 MAP-AMT-A DTSCS26 +05109 MAP-APPLIC-BATCH-NO-A DTSCS26 +05110 MAP-APPLIC-ITEM-NO-A DTSCS26 +05111 MAP-INT-RATE-A. DTSCS26 +05112 DTSCS26 +05113 MOVE CATB-ASKIP-NORM-MDTOFF TO MAP-CMPRMISE-LABEL-A. DTSCS26 +05114 IF LCCM-OP-IS-FLD-DESK-88 DTSCS26 +05115 OR LCCM-OP-IS-ACCOUNTING-DESK-88 DTSCS26 +05116 MOVE WRK-ATB-AN TO MAP-CMPRMISE-IND-A DTSCS26 +05117 ELSE DTSCS26 +05118 MOVE CATB-ASKIP-BRT-MDTON TO MAP-CMPRMISE-IND-A DTSCS26 +05119 END-IF. DTSCS26 05120 DTSCS26 -05121 SET L851-SEND-DATAONLY-88 TO TRUE. DTSCS26 +05121 MOVE CATB-ASKIP-BRT-MDTON TO MAP-PROCESSED-DATE-A. DTSCS26 05122 DTSCS26 -05123 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS26 -05124 DTSCS26 -05125 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS26 -05126 S9200-EXIT. DTSCS26 -05127 EXIT. DTSCS26 -05128 DTSCS26 +05123 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-GOTO-A. DTSCS26 +05124 S5900-EXIT. DTSCS26 +05125 EXIT. DTSCS26 +05126 /*****************************************************************DTSCS26 +05127 * MAP ROUTINES *DTSCS26 +05128 ******************************************************************DTSCS26 05129 DTSCS26 -05130 DTSCS26 -05131 S9300-SEND-MAP. DTSCS26 -05132 MOVE LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE. DTSCS26 -05133 DTSCS26 -05134 MOVE LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME. DTSCS26 -05135 DTSCS26 -05136 MOVE LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME. DTSCS26 -05137 DTSCS26 -05138 IF SCR-ACCESS-UPDATE DTSCS26 -05139 PERFORM S9310-UPDATE-FKEYS THRU S9310-EXIT DTSCS26 -05140 ELSE DTSCS26 -05141 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS26 +05130 S9100-RECEIVE. DTSCS26 +05131 SET L851-RECEIVE-88 TO TRUE. DTSCS26 +05132 DTSCS26 +05133 MOVE WRK-SCR-ID TO L851-SCR-ID. DTSCS26 +05134 DTSCS26 +05135 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS26 +05136 DTSCS26 +05137 MOVE L851-AID TO LCCM-AID. DTSCS26 +05138 DTSCS26 +05139 MOVE L851-CURSOR TO LCCM-CURSOR. DTSCS26 +05140 S9100-EXIT. DTSCS26 +05141 EXIT. DTSCS26 05142 DTSCS26 -05143 PERFORM S9330-DSCR-FIELDS THRU S9330-EXIT. DTSCS26 +05143 DTSCS26 05144 DTSCS26 -05145 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS26 -05146 DTSCS26 -05147 IF CURSOR-SET-NO DTSCS26 -05148 MOVE CATB-CURSOR TO MAP-BATCH-NO-L. DTSCS26 -05149 DTSCS26 -05150 SET L851-SEND-88 TO TRUE. DTSCS26 -05151 DTSCS26 -05152 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS26 -05153 DTSCS26 -05154 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS26 -05155 S9300-EXIT. DTSCS26 -05156 EXIT. DTSCS26 +05145 S9200-SEND-DATAONLY. DTSCS26 +05146 MOVE LOW-VALUES TO MAP-AREA. DTSCS26 +05147 DTSCS26 +05148 IF LCCM-NO-MSG DTSCS26 +05149 NEXT SENTENCE DTSCS26 +05150 ELSE DTSCS26 +05151 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS26 +05152 DTSCS26 +05153 IF CURSOR-SET-GOTO DTSCS26 +05154 MOVE CATB-CURSOR TO MAP-GOTO-L DTSCS26 +05155 ELSE DTSCS26 +05156 MOVE CATB-CURSOR TO MAP-BATCH-NO-L. DTSCS26 05157 DTSCS26 -05158 DTSCS26 +05158 SET L851-SEND-DATAONLY-88 TO TRUE. DTSCS26 05159 DTSCS26 -05160 S9310-UPDATE-FKEYS. DTSCS26 -05161 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS26 -05162 DTSCS26 -05163 IF LCCM-SCR-CLEAR DTSCS26 -05164 MOVE 'ENTER=ADD' TO MAP-KEY-ENTER DTSCS26 -05165 ELSE DTSCS26 -05166 IF LCCM-SCR-INQUIRE DTSCS26 -05167 MOVE CFKD-MOD TO MAP-KEY-MOD DTSCS26 -05168 MOVE CFKD-DEL TO MAP-KEY-DEL DTSCS26 -05169 ELSE DTSCS26 -05170 IF LCCM-SCR-UPDATE-LOCKED DTSCS26 -05171 MOVE LOW-VALUES TO MAP-KEY-BACK DTSCS26 -05172 MAP-KEY-FWRD DTSCS26 -05173 MAP-KEY-INQ. DTSCS26 -05174 S9310-EXIT. DTSCS26 -05175 EXIT. DTSCS26 -05176 DTSCS26 -05177 DTSCS26 -05178 DTSCS26 -05179 S9320-INQUIRY-FKEYS. DTSCS26 -05180 MOVE CFKD-BACKWARD TO MAP-KEY-BACK. DTSCS26 +05160 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS26 +05161 DTSCS26 +05162 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS26 +05163 S9200-EXIT. DTSCS26 +05164 EXIT. DTSCS26 +05165 DTSCS26 +05166 DTSCS26 +05167 DTSCS26 +05168 S9300-SEND-MAP. DTSCS26 +05169 MOVE LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE. DTSCS26 +05170 DTSCS26 +05171 MOVE LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME. DTSCS26 +05172 DTSCS26 +05173 MOVE LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME. DTSCS26 +05174 DTSCS26 +05175 IF SCR-ACCESS-UPDATE DTSCS26 +05176 PERFORM S9310-UPDATE-FKEYS THRU S9310-EXIT DTSCS26 +05177 ELSE DTSCS26 +05178 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS26 +05179 DTSCS26 +05180 PERFORM S9330-DSCR-FIELDS THRU S9330-EXIT. DTSCS26 05181 DTSCS26 -05182 MOVE CFKD-FORWARD TO MAP-KEY-FWRD. DTSCS26 +05182 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS26 05183 DTSCS26 -05184 MOVE 'F9=INQ' TO MAP-KEY-INQ. DTSCS26 -05185 DTSCS26 -05186 MOVE LOW-VALUES TO MAP-KEY-ENTER DTSCS26 -05187 MAP-KEY-MOD DTSCS26 -05188 MAP-KEY-DEL. DTSCS26 -05189 S9320-EXIT. DTSCS26 -05190 EXIT. DTSCS26 -05191 DTSCS26 -05192 DTSCS26 -05193 DTSCS26 -05194 S9330-DSCR-FIELDS. DTSCS26 -05195 IF MAP-ENTRY-MODE-A = CATB-UNPROT-NORM-NUM-MDTON DTSCS26 -05196 NEXT SENTENCE DTSCS26 -05197 ELSE DTSCS26 -05198 MOVE LCCM-ENTRY-MODE TO MAP-ENTRY-MODE. DTSCS26 +05184 IF CURSOR-SET-NO DTSCS26 +05185 MOVE CATB-CURSOR TO MAP-BATCH-NO-L. DTSCS26 +05186 DTSCS26 +05187 SET L851-SEND-88 TO TRUE. DTSCS26 +05188 DTSCS26 +05189 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS26 +05190 DTSCS26 +05191 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS26 +05192 S9300-EXIT. DTSCS26 +05193 EXIT. DTSCS26 +05194 DTSCS26 +05195 DTSCS26 +05196 DTSCS26 +05197 S9310-UPDATE-FKEYS. DTSCS26 +05198 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS26 05199 DTSCS26 -05200 IF LCCM-OP-IS-FLD-DESK-88 DTSCS26 -05201 OR LCCM-OP-IS-ACCOUNTING-DESK-88 DTSCS26 -05202 MOVE 'COMPROMISE?' TO MAP-CMPRMISE-LABEL DTSCS26 -05203 END-IF. DTSCS26 -05204 DTSCS26 -05205 *****MOVE MAP-DOC-NO-AREA TO L019-S-DOC-NO. DTSCS26 -05206 DTSCS26 -05207 *****PERFORM S019-BATCH-NO-FROM-SCREEN THRU S019-EXIT. DTSCS26 -05208 DTSCS26 -05209 *****IF L019-VALID DTSCS26 -05210 *********IF L372-BATCH-NO = L019-BATCH-NO DTSCS26 -05211 *************NEXT SENTENCE DTSCS26 -05212 *********ELSE DTSCS26 -05213 *************MOVE L019-BATCH-NO TO L372-BATCH-NO DTSCS26 -05214 *************PERFORM S372-BATCH-INQUIRY THRU S372-EXIT. DTSCS26 -05215 S9330-EXIT. DTSCS26 -05216 EXIT. DTSCS26 -05217 DTSCS26 +05200 IF LCCM-SCR-CLEAR DTSCS26 +05201 MOVE 'ENTER=ADD' TO MAP-KEY-ENTER DTSCS26 +05202 ELSE DTSCS26 +05203 IF LCCM-SCR-INQUIRE DTSCS26 +05204 MOVE CFKD-MOD TO MAP-KEY-MOD DTSCS26 +05205 MOVE CFKD-DEL TO MAP-KEY-DEL DTSCS26 +05206 ELSE DTSCS26 +05207 IF LCCM-SCR-UPDATE-LOCKED DTSCS26 +05208 MOVE LOW-VALUES TO MAP-KEY-BACK DTSCS26 +05209 MAP-KEY-FWRD DTSCS26 +05210 MAP-KEY-INQ. DTSCS26 +05211 S9310-EXIT. DTSCS26 +05212 EXIT. DTSCS26 +05213 DTSCS26 +05214 DTSCS26 +05215 DTSCS26 +05216 S9320-INQUIRY-FKEYS. DTSCS26 +05217 MOVE CFKD-BACKWARD TO MAP-KEY-BACK. DTSCS26 05218 DTSCS26 -05219 DTSCS26 -05220 S9900-PREPARE-SEND. DTSCS26 -05221 MOVE WRK-SCR-ID TO L851-SCR-ID DTSCS26 -05222 LCCM-SCR-ID. DTSCS26 -05223 DTSCS26 -05224 MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND. DTSCS26 -05225 DTSCS26 -05226 MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE. DTSCS26 -05227 S9900-EXIT. DTSCS26 -05228 EXIT. DTSCS26 +05219 MOVE CFKD-FORWARD TO MAP-KEY-FWRD. DTSCS26 +05220 DTSCS26 +05221 MOVE 'F9=INQ' TO MAP-KEY-INQ. DTSCS26 +05222 DTSCS26 +05223 MOVE LOW-VALUES TO MAP-KEY-ENTER DTSCS26 +05224 MAP-KEY-MOD DTSCS26 +05225 MAP-KEY-DEL. DTSCS26 +05226 S9320-EXIT. DTSCS26 +05227 EXIT. DTSCS26 +05228 DTSCS26 +05229 DTSCS26 +05230 DTSCS26 +05231 S9330-DSCR-FIELDS. DTSCS26 +05232 IF MAP-ENTRY-MODE-A = CATB-UNPROT-NORM-NUM-MDTON DTSCS26 +05233 NEXT SENTENCE DTSCS26 +05234 ELSE DTSCS26 +05235 MOVE LCCM-ENTRY-MODE TO MAP-ENTRY-MODE. DTSCS26 +05236 DTSCS26 +05237 IF LCCM-OP-IS-FLD-DESK-88 DTSCS26 +05238 OR LCCM-OP-IS-ACCOUNTING-DESK-88 DTSCS26 +05239 MOVE 'COMPROMISE?' TO MAP-CMPRMISE-LABEL DTSCS26 +05240 END-IF. DTSCS26 +05241 DTSCS26 +05242 *****MOVE MAP-DOC-NO-AREA TO L019-S-DOC-NO. DTSCS26 +05243 DTSCS26 +05244 *****PERFORM S019-BATCH-NO-FROM-SCREEN THRU S019-EXIT. DTSCS26 +05245 DTSCS26 +05246 *****IF L019-VALID DTSCS26 +05247 *********IF L372-BATCH-NO = L019-BATCH-NO DTSCS26 +05248 *************NEXT SENTENCE DTSCS26 +05249 *********ELSE DTSCS26 +05250 *************MOVE L019-BATCH-NO TO L372-BATCH-NO DTSCS26 +05251 *************PERFORM S372-BATCH-INQUIRY THRU S372-EXIT. DTSCS26 +05252 S9330-EXIT. DTSCS26 +05253 EXIT. DTSCS26 +05254 DTSCS26 +05255 DTSCS26 +05256 DTSCS26 +05257 S9900-PREPARE-SEND. DTSCS26 +05258 MOVE WRK-SCR-ID TO L851-SCR-ID DTSCS26 +05259 LCCM-SCR-ID. DTSCS26 +05260 DTSCS26 +05261 MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND. DTSCS26 +05262 DTSCS26 +05263 MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE. DTSCS26 +05264 S9900-EXIT. DTSCS26 +05265 EXIT. DTSCS26 diff --git a/CICSFiles.txt b/CICSFiles.txt index 505d2ab..a6c1f97 100644 --- a/CICSFiles.txt +++ b/CICSFiles.txt @@ -1,4 +1,4 @@ -E:\Faizan_Folder\DUTAS_DEV_UPDATE\DUTAS\CICS\DTSCS81.cob +E:\Faizan_Folder\DUTAS_DEV_UPDATE\DUTAS\CICS\DTSCS26.cob diff --git a/Copybook/DTSIS13.cpy b/Copybook/DTSIS13.cpy index eec5298..ce1fd6a 100644 --- a/Copybook/DTSIS13.cpy +++ b/Copybook/DTSIS13.cpy @@ -1,6 +1,6 @@ -00001 ***** 09/13/12 +00001 ***** 05/11/17 00002 * DTSIS13 -00003 * DTSIS13 TAX ADDRESS INQUIRY/UPDATE SEND/RECEIVE AREA. LV012 +00003 * DTSIS13 TAX ADDRESS INQUIRY/UPDATE SEND/RECEIVE AREA. LV003 00004 * DTSIS13 00005 ***** DTSIS13 00006 SKIP1 DTSIS13 @@ -126,15 +126,15 @@ 00126 25 MAP-PHONE-EXT-A PIC X(01). DTSIS13 00127 25 MAP-PHONE-EXT PIC X(05). DTSIS13 00128 SKIP1 DTSIS13 -00129 15 MAP-EMAIL-AREA. DTSIS13 -00130 20 MAP-EMAIL-L PIC S9(04) COMP. DTSIS13 -00131 20 MAP-EMAIL-A PIC X(01). DTSIS13 -00132 20 MAP-EMAIL PIC X(40). DTSIS13 +00129 15 MAP-EMAIL-AREA. CL**3 +00130 20 MAP-EMAIL-L PIC S9(04) COMP. CL**3 +00131 20 MAP-EMAIL-A PIC X(01). CL**3 +00132 20 MAP-EMAIL PIC X(40). CL**3 00133 SKIP1 DTSIS13 -00134 15 MAP-EMAIL-UC30-AREA. DTSIS13 -00135 20 MAP-EMAIL-UC30-L PIC S9(04) COMP. DTSIS13 -00136 20 MAP-EMAIL-UC30-A PIC X(01). DTSIS13 -00137 20 MAP-EMAIL-UC30 PIC X(01). DTSIS13 +00134 * 15 MAP-EMAIL-UC30-AREA. CL**3 +00135 * 20 MAP-EMAIL-UC30-L PIC S9(04) COMP. CL**3 +00136 * 20 MAP-EMAIL-UC30-A PIC X(01). CL**3 +00137 * 20 MAP-EMAIL-UC30 PIC X(01). CL**3 00138 SKIP1 DTSIS13 00139 15 MAP-MEMO-AREA. DTSIS13 00140 20 MAP-MEMO-L PIC S9(04) COMP. DTSIS13 diff --git a/Maps/DTSM13.bms b/Maps/DTSM13.bms index ffd9da0..99ae4ff 100644 --- a/Maps/DTSM13.bms +++ b/Maps/DTSM13.bms @@ -1,321 +1,322 @@ -* DATA SET DTSM13 AT LEVEL 014 AS OF 09/29/04 -* DATA SET DTSM13 AT LEVEL 002 AS OF 07/21/04 00001 -* DATA SET DTSM13 AT LEVEL 012 AS OF 07/18/00 00002 -* DATA SET DTSM13 AT LEVEL 002 AS OF 06/05/00 00003 -* DATA SET DTSM13 AT LEVEL 010 AS OF 09/07/99 00004 -* DATA SET MACM13 AT LEVEL 010 AS OF 10/30/95 00005 -***** 00006 -* 00007 -* 13 TAX ADDRESS INQUIRY/UPDATE. 00008 -* 00009 -***** 00010 - SPACE 00011 -DTSM13 DFHMDI SIZE=(24,80),LINE=1,COLUMN=1 00012 - SPACE 00013 -F130101 DFHMDF POS=(01,01),LENGTH=02,ATTRB=(FSET,ASKIP), *00014 - INITIAL='13' 00015 - SPACE 00016 - DFHMDF POS=(01,23),LENGTH=26,ATTRB=(ASKIP), *00017 - INITIAL='TAX ADDRESS INQUIRY/UPDATE' 00018 - SPACE 00019 -F130162 DFHMDF POS=(01,62),LENGTH=08,ATTRB=ASKIP 00020 - SPACE 00021 -F130172 DFHMDF POS=(01,72),LENGTH=08,ATTRB=ASKIP 00022 - SPACE 00023 -F130272 DFHMDF POS=(02,72),LENGTH=08,ATTRB=ASKIP 00024 - SPACE 00025 - DFHMDF POS=(03,08),LENGTH=07,ATTRB=ASKIP, *00026 - INITIAL='EMP NO:' 00027 - SPACE 00028 -F130316 DFHMDF POS=(03,16),LENGTH=03,ATTRB=ASKIP 00029 - SPACE 00030 -F130320 DFHMDF POS=(03,20),LENGTH=03,ATTRB=ASKIP 00031 - SPACE 00032 - DFHMDF POS=(03,24),LENGTH=01,ATTRB=ASKIP 00033 - SPACE 00034 - DFHMDF POS=(04,01),LENGTH=14,ATTRB=ASKIP, *00035 - INITIAL=' PRIMARY NAME:' 00036 - SPACE 00037 -F130416 DFHMDF POS=(04,16),LENGTH=40,ATTRB=ASKIP 00038 - SPACE 00039 - DFHMDF POS=(04,57),LENGTH=01,ATTRB=ASKIP 00040 - SPACE 00041 - DFHMDF POS=(04,60),LENGTH=12,ATTRB=ASKIP, *00042 - INITIAL='ENTITY NAME?' 00043 - SPACE 00044 -F130465 DFHMDF POS=(04,73),LENGTH=01,ATTRB=ASKIP 00045 - SPACE 00046 - DFHMDF POS=(04,75),LENGTH=01,ATTRB=ASKIP 00047 - SPACE 00048 - DFHMDF POS=(05,01),LENGTH=14,ATTRB=ASKIP, *00049 - INITIAL=' ENTITY NAME:' 00050 - SPACE 00051 -F130516 DFHMDF POS=(05,16),LENGTH=40,ATTRB=ASKIP 00052 - SPACE 00053 - DFHMDF POS=(05,57),LENGTH=01,ATTRB=ASKIP 00054 - SPACE 00055 -F130609 DFHMDF POS=(06,09),LENGTH=07,ATTRB=(ASKIP) 00056 - SPACE 00057 -F130617 DFHMDF POS=(06,17),LENGTH=01,ATTRB=(ASKIP) 00058 - SPACE 00059 - DFHMDF POS=(06,19),LENGTH=01,ATTRB=(ASKIP) 00060 - SPACE 00061 - DFHMDF POS=(07,09),LENGTH=15,ATTRB=ASKIP, *00062 - INITIAL='MAILING ADDRESS' 00063 - SPACE 00064 - DFHMDF POS=(07,56),LENGTH=13,ATTRB=ASKIP, *00065 - INITIAL='FISCAL AGENT:' 00066 - SPACE 00067 -F130770 DFHMDF POS=(07,70),LENGTH=03,ATTRB=ASKIP 00068 - SPACE 00069 - DFHMDF POS=(07,74),LENGTH=01,ATTRB=ASKIP 00070 - SPACE 00071 - DFHMDF POS=(08,01),LENGTH=05,ATTRB=ASKIP, *00072 - INITIAL='ATTN:' 00073 - SPACE 00074 -F130807 DFHMDF POS=(08,07),LENGTH=40,ATTRB=ASKIP 00075 - SPACE 00076 - DFHMDF POS=(08,48),LENGTH=01,ATTRB=ASKIP 00077 - SPACE 00078 - DFHMDF POS=(08,56),LENGTH=05,ATTRB=ASKIP, *00079 - INITIAL='CASS?' 00080 - SPACE 00081 -F130862 DFHMDF POS=(08,62),LENGTH=01,ATTRB=ASKIP 00082 - SPACE 00083 - DFHMDF POS=(08,64),LENGTH=01,ATTRB=ASKIP 00084 - SPACE 00085 - DFHMDF POS=(09,01),LENGTH=05,ATTRB=ASKIP, *00086 - INITIAL='DLV1:' 00087 - SPACE 00088 -F130907 DFHMDF POS=(09,07),LENGTH=40,ATTRB=ASKIP 00089 - SPACE 00090 - DFHMDF POS=(09,48),LENGTH=01,ATTRB=ASKIP 00091 - SPACE 00092 - DFHMDF POS=(09,56),LENGTH=07,ATTRB=ASKIP, *00093 - INITIAL='CASS CD' 00094 - SPACE 00095 - DFHMDF POS=(10,01),LENGTH=05,ATTRB=ASKIP, *00096 - INITIAL='DLV2:' 00097 - SPACE 00098 -F131007 DFHMDF POS=(10,07),LENGTH=40,ATTRB=ASKIP 00099 - SPACE 00100 - DFHMDF POS=(10,48),LENGTH=01,ATTRB=ASKIP 00101 - SPACE 00102 -F131054 DFHMDF POS=(10,54),LENGTH=25,ATTRB=ASKIP 00103 - SPACE 00104 - DFHMDF POS=(11,01),LENGTH=05,ATTRB=ASKIP, *00105 - INITIAL='CITY:' 00106 - SPACE 00107 -F131107 DFHMDF POS=(11,07),LENGTH=25,ATTRB=ASKIP 00108 - SPACE 00109 - DFHMDF POS=(11,33),LENGTH=01,ATTRB=ASKIP, *00110 - INITIAL=':' 00111 - SPACE 00112 -F131135 DFHMDF POS=(11,35),LENGTH=02,ATTRB=ASKIP 00113 - SPACE 00114 - DFHMDF POS=(11,38),LENGTH=01,ATTRB=ASKIP, *00115 - INITIAL=':' 00116 - SPACE 00117 -F131140 DFHMDF POS=(11,40),LENGTH=10,ATTRB=ASKIP 00118 - SPACE 00119 - DFHMDF POS=(11,51),LENGTH=01,ATTRB=ASKIP 00120 - SPACE 00121 - DFHMDF POS=(12,01),LENGTH=05,ATTRB=ASKIP, *00122 - INITIAL='TEL1:' 00123 - SPACE 00124 -F131207 DFHMDF POS=(12,07),LENGTH=03,ATTRB=ASKIP 00125 - SPACE 00126 -F131211 DFHMDF POS=(12,11),LENGTH=03,ATTRB=ASKIP 00127 - SPACE 00128 -F131215 DFHMDF POS=(12,15),LENGTH=04,ATTRB=ASKIP 00129 - SPACE 00130 -F131320 DFHMDF POS=(12,20),LENGTH=05,ATTRB=ASKIP 00131 - SPACE 00132 - DFHMDF POS=(12,26),LENGTH=01,ATTRB=ASKIP 00133 - SPACE 00134 - DFHMDF POS=(12,29),LENGTH=05,ATTRB=ASKIP, *00135 - INITIAL='TEL2:' 00136 - SPACE 00137 -F131235 DFHMDF POS=(12,35),LENGTH=03,ATTRB=ASKIP 00138 - SPACE 00139 -F131239 DFHMDF POS=(12,39),LENGTH=03,ATTRB=ASKIP 00140 - SPACE 00141 -F131243 DFHMDF POS=(12,43),LENGTH=04,ATTRB=ASKIP 00142 - SPACE 00143 -F131248 DFHMDF POS=(12,48),LENGTH=05,ATTRB=ASKIP 00144 - SPACE 00145 - DFHMDF POS=(12,54),LENGTH=01,ATTRB=ASKIP 00146 - SPACE 00147 - DFHMDF POS=(12,57),LENGTH=04,ATTRB=ASKIP, *00148 - INITIAL='FAX:' 00149 - SPACE 00150 -F131262 DFHMDF POS=(12,62),LENGTH=03,ATTRB=ASKIP 00151 - SPACE 00152 -F131266 DFHMDF POS=(12,66),LENGTH=03,ATTRB=ASKIP 00153 - SPACE 00154 -F131270 DFHMDF POS=(12,70),LENGTH=04,ATTRB=ASKIP 00155 - SPACE 00156 -F131275 DFHMDF POS=(12,75),LENGTH=05,ATTRB=ASKIP 00157 - SPACE 00158 - DFHMDF POS=(13,01),LENGTH=01,ATTRB=ASKIP 00159 - SPACE 00160 - DFHMDF POS=(13,03),LENGTH=06,ATTRB=ASKIP, *00161 - INITIAL='EMAIL:' 00162 - SPACE 00163 -F131310 DFHMDF POS=(13,10),LENGTH=40,ATTRB=ASKIP 00164 - SPACE 00165 - DFHMDF POS=(13,51),LENGTH=01,ATTRB=ASKIP 00166 - SPACE 00167 - DFHMDF POS=(14,01),LENGTH=12,ATTRB=ASKIP, *00168 - INITIAL=' DEBIT MEMO?' 00169 - SPACE 00170 -F131414 DFHMDF POS=(14,14),LENGTH=01,ATTRB=ASKIP 00171 - SPACE 00172 - DFHMDF POS=(14,16),LENGTH=01,ATTRB=ASKIP 00173 - SPACE 00174 - DFHMDF POS=(14,20),LENGTH=13,ATTRB=ASKIP, *00175 - INITIAL='MISS RPT LTR?' 00176 - SPACE 00177 -F131433 DFHMDF POS=(14,34),LENGTH=01,ATTRB=ASKIP 00178 - SPACE 00179 - DFHMDF POS=(14,36),LENGTH=01,ATTRB=ASKIP 00180 - SPACE 00181 - DFHMDF POS=(14,40),LENGTH=14,ATTRB=ASKIP, *00182 - INITIAL='PHYSICAL ADDR?' 00183 - SPACE 00184 -F131455 DFHMDF POS=(14,55),LENGTH=01,ATTRB=ASKIP 00185 - SPACE 00186 - DFHMDF POS=(14,57),LENGTH=01,ATTRB=ASKIP 00187 - SPACE 00188 - DFHMDF POS=(15,09),LENGTH=17,ATTRB=ASKIP, *00189 - INITIAL='DC STREET ADDRESS' 00190 - SPACE 00191 - DFHMDF POS=(16,01),LENGTH=05,ATTRB=ASKIP, *00192 - INITIAL='ATTN:' 00193 - SPACE 00194 -F131607 DFHMDF POS=(16,07),LENGTH=40,ATTRB=ASKIP 00195 - SPACE 00196 - DFHMDF POS=(16,48),LENGTH=01,ATTRB=ASKIP 00197 - SPACE 00198 - DFHMDF POS=(16,56),LENGTH=05,ATTRB=ASKIP, *00199 - INITIAL='CASS?' 00200 - SPACE 00201 -F131662 DFHMDF POS=(16,62),LENGTH=01,ATTRB=ASKIP 00202 - SPACE 00203 - DFHMDF POS=(16,64),LENGTH=01,ATTRB=ASKIP 00204 - SPACE 00205 - DFHMDF POS=(17,01),LENGTH=05,ATTRB=ASKIP, *00206 - INITIAL='DLV1:' 00207 - SPACE 00208 -F131707 DFHMDF POS=(17,07),LENGTH=40,ATTRB=ASKIP 00209 - SPACE 00210 - DFHMDF POS=(17,48),LENGTH=01,ATTRB=ASKIP 00211 - SPACE 00212 - DFHMDF POS=(17,56),LENGTH=07,ATTRB=ASKIP, *00213 - INITIAL='CASS CD' 00214 - SPACE 00215 - DFHMDF POS=(18,01),LENGTH=05,ATTRB=ASKIP, *00216 - INITIAL='DLV2:' 00217 - SPACE 00218 -F131807 DFHMDF POS=(18,07),LENGTH=40,ATTRB=ASKIP 00219 - SPACE 00220 - DFHMDF POS=(18,48),LENGTH=01,ATTRB=ASKIP 00221 - SPACE 00222 -F131854 DFHMDF POS=(18,54),LENGTH=25,ATTRB=ASKIP 00223 - SPACE 00224 - DFHMDF POS=(19,01),LENGTH=05,ATTRB=ASKIP, *00225 - INITIAL='CITY:' 00226 - SPACE 00227 -F131907 DFHMDF POS=(19,07),LENGTH=25,ATTRB=ASKIP 00228 - SPACE 00229 - DFHMDF POS=(19,33),LENGTH=01,ATTRB=ASKIP, *00230 - INITIAL=':' 00231 - SPACE 00232 -F131935 DFHMDF POS=(19,35),LENGTH=02,ATTRB=ASKIP 00233 - SPACE 00234 - DFHMDF POS=(19,38),LENGTH=01,ATTRB=ASKIP, *00235 - INITIAL=':' 00236 - SPACE 00237 -F131940 DFHMDF POS=(19,40),LENGTH=10,ATTRB=ASKIP 00238 - SPACE 00239 - DFHMDF POS=(19,51),LENGTH=01,ATTRB=ASKIP 00240 - SPACE 00241 - DFHMDF POS=(20,01),LENGTH=05,ATTRB=ASKIP, *00242 - INITIAL='TEL1:' 00243 - SPACE 00244 -F132007 DFHMDF POS=(20,07),LENGTH=03,ATTRB=ASKIP 00245 - SPACE 00246 -F132011 DFHMDF POS=(20,11),LENGTH=03,ATTRB=ASKIP 00247 - SPACE 00248 -F132015 DFHMDF POS=(20,15),LENGTH=04,ATTRB=ASKIP 00249 - SPACE 00250 -F132020 DFHMDF POS=(20,20),LENGTH=05,ATTRB=ASKIP 00251 - SPACE 00252 - DFHMDF POS=(20,26),LENGTH=01,ATTRB=ASKIP 00253 - SPACE 00254 - DFHMDF POS=(20,29),LENGTH=05,ATTRB=ASKIP, *00255 - INITIAL='TEL2:' 00256 - SPACE 00257 -F132035 DFHMDF POS=(20,35),LENGTH=03,ATTRB=ASKIP 00258 - SPACE 00259 -F132039 DFHMDF POS=(20,39),LENGTH=03,ATTRB=ASKIP 00260 - SPACE 00261 -F132043 DFHMDF POS=(20,43),LENGTH=04,ATTRB=ASKIP 00262 - SPACE 00263 -F132048 DFHMDF POS=(20,48),LENGTH=05,ATTRB=ASKIP 00264 - SPACE 00265 - DFHMDF POS=(20,54),LENGTH=01,ATTRB=ASKIP 00266 - SPACE 00267 - DFHMDF POS=(20,57),LENGTH=04,ATTRB=ASKIP, *00268 - INITIAL='FAX:' 00269 - SPACE 00270 -F132062 DFHMDF POS=(20,62),LENGTH=03,ATTRB=ASKIP 00271 - SPACE 00272 -F132066 DFHMDF POS=(20,66),LENGTH=03,ATTRB=ASKIP 00273 - SPACE 00274 -F132070 DFHMDF POS=(20,70),LENGTH=04,ATTRB=ASKIP 00275 - SPACE 00276 -F132075 DFHMDF POS=(20,75),LENGTH=05,ATTRB=ASKIP 00277 - SPACE 00278 - DFHMDF POS=(21,01),LENGTH=01,ATTRB=ASKIP 00279 - SPACE 00280 - DFHMDF POS=(21,03),LENGTH=06,ATTRB=ASKIP, *00281 - INITIAL='EMAIL:' 00282 - SPACE 00283 -F132110 DFHMDF POS=(21,10),LENGTH=40,ATTRB=ASKIP 00284 - SPACE 00285 - DFHMDF POS=(21,51),LENGTH=01,ATTRB=ASKIP 00286 - SPACE 00287 - DFHMDF POS=(22,01),LENGTH=12,ATTRB=ASKIP, *00288 - INITIAL=' DEBIT MEMO?' 00289 - SPACE 00290 -F132214 DFHMDF POS=(22,14),LENGTH=01,ATTRB=ASKIP 00291 - SPACE 00292 - DFHMDF POS=(22,16),LENGTH=01,ATTRB=ASKIP 00293 - SPACE 00294 - DFHMDF POS=(22,20),LENGTH=13,ATTRB=ASKIP, *00295 - INITIAL='MISS RPT LTR?' 00296 - SPACE 00297 -F132233 DFHMDF POS=(22,34),LENGTH=01,ATTRB=ASKIP 00298 - SPACE 00299 - DFHMDF POS=(22,36),LENGTH=01,ATTRB=ASKIP 00300 - SPACE 00301 - DFHMDF POS=(22,40),LENGTH=14,ATTRB=ASKIP, *00302 - INITIAL='PHYSICAL ADDR?' 00303 - SPACE 00304 -F132255 DFHMDF POS=(22,55),LENGTH=01,ATTRB=ASKIP 00305 - SPACE 00306 - DFHMDF POS=(22,57),LENGTH=01,ATTRB=ASKIP 00307 - SPACE 00308 -F132317 DFHMDF POS=(23,17),LENGTH=07,ATTRB=ASKIP 00309 - SPACE 00310 -F132401 DFHMDF POS=(24,01),LENGTH=08,ATTRB=ASKIP 00311 - SPACE 00312 -F132410 DFHMDF POS=(24,10),LENGTH=58,ATTRB=ASKIP 00313 - SPACE 00314 - DFHMDF POS=(24,69),LENGTH=06,ATTRB=ASKIP, *00315 - INITIAL='GO TO:' 00316 - SPACE 00317 -F132476 DFHMDF POS=(24,76),LENGTH=02,ATTRB=ASKIP 00318 - SPACE 00319 - DFHMDF POS=(24,79),LENGTH=01,ATTRB=ASKIP 00320 +* DATA SET DTSM13 AT LEVEL 001 AS OF 05/11/17 +* DATA SET DTSM13 AT LEVEL 014 AS OF 09/29/04 00001 +* DATA SET DTSM13 AT LEVEL 002 AS OF 07/21/04 00002 +* DATA SET DTSM13 AT LEVEL 012 AS OF 07/18/00 00003 +* DATA SET DTSM13 AT LEVEL 002 AS OF 06/05/00 00004 +* DATA SET DTSM13 AT LEVEL 010 AS OF 09/07/99 00005 +* DATA SET MACM13 AT LEVEL 010 AS OF 10/30/95 00006 +***** 00007 +* 00008 +* 13 TAX ADDRESS INQUIRY/UPDATE. 00009 +* 00010 +***** 00011 + SPACE 00012 +DTSM13 DFHMDI SIZE=(24,80),LINE=1,COLUMN=1 00013 + SPACE 00014 +F130101 DFHMDF POS=(01,01),LENGTH=02,ATTRB=(FSET,ASKIP), *00015 + INITIAL='13' 00016 + SPACE 00017 + DFHMDF POS=(01,23),LENGTH=26,ATTRB=(ASKIP), *00018 + INITIAL='TAX ADDRESS INQUIRY/UPDATE' 00019 + SPACE 00020 +F130162 DFHMDF POS=(01,62),LENGTH=08,ATTRB=ASKIP 00021 + SPACE 00022 +F130172 DFHMDF POS=(01,72),LENGTH=08,ATTRB=ASKIP 00023 + SPACE 00024 +F130272 DFHMDF POS=(02,72),LENGTH=08,ATTRB=ASKIP 00025 + SPACE 00026 + DFHMDF POS=(03,08),LENGTH=07,ATTRB=ASKIP, *00027 + INITIAL='EMP NO:' 00028 + SPACE 00029 +F130316 DFHMDF POS=(03,16),LENGTH=03,ATTRB=ASKIP 00030 + SPACE 00031 +F130320 DFHMDF POS=(03,20),LENGTH=03,ATTRB=ASKIP 00032 + SPACE 00033 + DFHMDF POS=(03,24),LENGTH=01,ATTRB=ASKIP 00034 + SPACE 00035 + DFHMDF POS=(04,01),LENGTH=14,ATTRB=ASKIP, *00036 + INITIAL=' PRIMARY NAME:' 00037 + SPACE 00038 +F130416 DFHMDF POS=(04,16),LENGTH=40,ATTRB=ASKIP 00039 + SPACE 00040 + DFHMDF POS=(04,57),LENGTH=01,ATTRB=ASKIP 00041 + SPACE 00042 + DFHMDF POS=(04,60),LENGTH=12,ATTRB=ASKIP, *00043 + INITIAL='ENTITY NAME?' 00044 + SPACE 00045 +F130465 DFHMDF POS=(04,73),LENGTH=01,ATTRB=ASKIP 00046 + SPACE 00047 + DFHMDF POS=(04,75),LENGTH=01,ATTRB=ASKIP 00048 + SPACE 00049 + DFHMDF POS=(05,01),LENGTH=14,ATTRB=ASKIP, *00050 + INITIAL=' ENTITY NAME:' 00051 + SPACE 00052 +F130516 DFHMDF POS=(05,16),LENGTH=40,ATTRB=ASKIP 00053 + SPACE 00054 + DFHMDF POS=(05,57),LENGTH=01,ATTRB=ASKIP 00055 + SPACE 00056 +F130609 DFHMDF POS=(06,09),LENGTH=07,ATTRB=(ASKIP) 00057 + SPACE 00058 +F130617 DFHMDF POS=(06,17),LENGTH=01,ATTRB=(ASKIP) 00059 + SPACE 00060 + DFHMDF POS=(06,19),LENGTH=01,ATTRB=(ASKIP) 00061 + SPACE 00062 + DFHMDF POS=(07,09),LENGTH=15,ATTRB=ASKIP, *00063 + INITIAL='MAILING ADDRESS' 00064 + SPACE 00065 + DFHMDF POS=(07,56),LENGTH=13,ATTRB=ASKIP, *00066 + INITIAL='FISCAL AGENT:' 00067 + SPACE 00068 +F130770 DFHMDF POS=(07,70),LENGTH=03,ATTRB=ASKIP 00069 + SPACE 00070 + DFHMDF POS=(07,74),LENGTH=01,ATTRB=ASKIP 00071 + SPACE 00072 + DFHMDF POS=(08,01),LENGTH=05,ATTRB=ASKIP, *00073 + INITIAL='ATTN:' 00074 + SPACE 00075 +F130807 DFHMDF POS=(08,07),LENGTH=40,ATTRB=ASKIP 00076 + SPACE 00077 + DFHMDF POS=(08,48),LENGTH=01,ATTRB=ASKIP 00078 + SPACE 00079 + DFHMDF POS=(08,56),LENGTH=05,ATTRB=ASKIP, *00080 + INITIAL='CASS?' 00081 + SPACE 00082 +F130862 DFHMDF POS=(08,62),LENGTH=01,ATTRB=ASKIP 00083 + SPACE 00084 + DFHMDF POS=(08,64),LENGTH=01,ATTRB=ASKIP 00085 + SPACE 00086 + DFHMDF POS=(09,01),LENGTH=05,ATTRB=ASKIP, *00087 + INITIAL='DLV1:' 00088 + SPACE 00089 +F130907 DFHMDF POS=(09,07),LENGTH=40,ATTRB=ASKIP 00090 + SPACE 00091 + DFHMDF POS=(09,48),LENGTH=01,ATTRB=ASKIP 00092 + SPACE 00093 + DFHMDF POS=(09,56),LENGTH=07,ATTRB=ASKIP, *00094 + INITIAL='CASS CD' 00095 + SPACE 00096 + DFHMDF POS=(10,01),LENGTH=05,ATTRB=ASKIP, *00097 + INITIAL='DLV2:' 00098 + SPACE 00099 +F131007 DFHMDF POS=(10,07),LENGTH=40,ATTRB=ASKIP 00100 + SPACE 00101 + DFHMDF POS=(10,48),LENGTH=01,ATTRB=ASKIP 00102 + SPACE 00103 +F131054 DFHMDF POS=(10,54),LENGTH=25,ATTRB=ASKIP 00104 + SPACE 00105 + DFHMDF POS=(11,01),LENGTH=05,ATTRB=ASKIP, *00106 + INITIAL='CITY:' 00107 + SPACE 00108 +F131107 DFHMDF POS=(11,07),LENGTH=25,ATTRB=ASKIP 00109 + SPACE 00110 + DFHMDF POS=(11,33),LENGTH=01,ATTRB=ASKIP, *00111 + INITIAL=':' 00112 + SPACE 00113 +F131135 DFHMDF POS=(11,35),LENGTH=02,ATTRB=ASKIP 00114 + SPACE 00115 + DFHMDF POS=(11,38),LENGTH=01,ATTRB=ASKIP, *00116 + INITIAL=':' 00117 + SPACE 00118 +F131140 DFHMDF POS=(11,40),LENGTH=10,ATTRB=ASKIP 00119 + SPACE 00120 + DFHMDF POS=(11,51),LENGTH=01,ATTRB=ASKIP 00121 + SPACE 00122 + DFHMDF POS=(12,01),LENGTH=05,ATTRB=ASKIP, *00123 + INITIAL='TEL1:' 00124 + SPACE 00125 +F131207 DFHMDF POS=(12,07),LENGTH=03,ATTRB=ASKIP 00126 + SPACE 00127 +F131211 DFHMDF POS=(12,11),LENGTH=03,ATTRB=ASKIP 00128 + SPACE 00129 +F131215 DFHMDF POS=(12,15),LENGTH=04,ATTRB=ASKIP 00130 + SPACE 00131 +F131320 DFHMDF POS=(12,20),LENGTH=05,ATTRB=ASKIP 00132 + SPACE 00133 + DFHMDF POS=(12,26),LENGTH=01,ATTRB=ASKIP 00134 + SPACE 00135 + DFHMDF POS=(12,29),LENGTH=05,ATTRB=ASKIP, *00136 + INITIAL='TEL2:' 00137 + SPACE 00138 +F131235 DFHMDF POS=(12,35),LENGTH=03,ATTRB=ASKIP 00139 + SPACE 00140 +F131239 DFHMDF POS=(12,39),LENGTH=03,ATTRB=ASKIP 00141 + SPACE 00142 +F131243 DFHMDF POS=(12,43),LENGTH=04,ATTRB=ASKIP 00143 + SPACE 00144 +F131248 DFHMDF POS=(12,48),LENGTH=05,ATTRB=ASKIP 00145 + SPACE 00146 + DFHMDF POS=(12,54),LENGTH=01,ATTRB=ASKIP 00147 + SPACE 00148 + DFHMDF POS=(12,57),LENGTH=04,ATTRB=ASKIP, *00149 + INITIAL='FAX:' 00150 + SPACE 00151 +F131262 DFHMDF POS=(12,62),LENGTH=03,ATTRB=ASKIP 00152 + SPACE 00153 +F131266 DFHMDF POS=(12,66),LENGTH=03,ATTRB=ASKIP 00154 + SPACE 00155 +F131270 DFHMDF POS=(12,70),LENGTH=04,ATTRB=ASKIP 00156 + SPACE 00157 +F131275 DFHMDF POS=(12,75),LENGTH=05,ATTRB=ASKIP 00158 + SPACE 00159 + DFHMDF POS=(13,01),LENGTH=01,ATTRB=ASKIP 00160 + SPACE 00161 + DFHMDF POS=(13,03),LENGTH=06,ATTRB=ASKIP, *00162 + INITIAL='EMAIL:' 00163 + SPACE 00164 +F131310 DFHMDF POS=(13,10),LENGTH=40,ATTRB=ASKIP 00165 + SPACE 00166 + DFHMDF POS=(13,51),LENGTH=01,ATTRB=ASKIP 00167 + SPACE 00168 + DFHMDF POS=(14,01),LENGTH=12,ATTRB=ASKIP, *00169 + INITIAL=' DEBIT MEMO?' 00170 + SPACE 00171 +F131414 DFHMDF POS=(14,14),LENGTH=01,ATTRB=ASKIP 00172 + SPACE 00173 + DFHMDF POS=(14,16),LENGTH=01,ATTRB=ASKIP 00174 + SPACE 00175 + DFHMDF POS=(14,20),LENGTH=13,ATTRB=ASKIP, *00176 + INITIAL='MISS RPT LTR?' 00177 + SPACE 00178 +F131433 DFHMDF POS=(14,34),LENGTH=01,ATTRB=ASKIP 00179 + SPACE 00180 + DFHMDF POS=(14,36),LENGTH=01,ATTRB=ASKIP 00181 + SPACE 00182 + DFHMDF POS=(14,40),LENGTH=14,ATTRB=ASKIP, *00183 + INITIAL='PHYSICAL ADDR?' 00184 + SPACE 00185 +F131455 DFHMDF POS=(14,55),LENGTH=01,ATTRB=ASKIP 00186 + SPACE 00187 + DFHMDF POS=(14,57),LENGTH=01,ATTRB=ASKIP 00188 + SPACE 00189 + DFHMDF POS=(15,09),LENGTH=17,ATTRB=ASKIP, *00190 + INITIAL='DC STREET ADDRESS' 00191 + SPACE 00192 + DFHMDF POS=(16,01),LENGTH=05,ATTRB=ASKIP, *00193 + INITIAL='ATTN:' 00194 + SPACE 00195 +F131607 DFHMDF POS=(16,07),LENGTH=40,ATTRB=ASKIP 00196 + SPACE 00197 + DFHMDF POS=(16,48),LENGTH=01,ATTRB=ASKIP 00198 + SPACE 00199 + DFHMDF POS=(16,56),LENGTH=05,ATTRB=ASKIP, *00200 + INITIAL='CASS?' 00201 + SPACE 00202 +F131662 DFHMDF POS=(16,62),LENGTH=01,ATTRB=ASKIP 00203 + SPACE 00204 + DFHMDF POS=(16,64),LENGTH=01,ATTRB=ASKIP 00205 + SPACE 00206 + DFHMDF POS=(17,01),LENGTH=05,ATTRB=ASKIP, *00207 + INITIAL='DLV1:' 00208 + SPACE 00209 +F131707 DFHMDF POS=(17,07),LENGTH=40,ATTRB=ASKIP 00210 + SPACE 00211 + DFHMDF POS=(17,48),LENGTH=01,ATTRB=ASKIP 00212 + SPACE 00213 + DFHMDF POS=(17,56),LENGTH=07,ATTRB=ASKIP, *00214 + INITIAL='CASS CD' 00215 + SPACE 00216 + DFHMDF POS=(18,01),LENGTH=05,ATTRB=ASKIP, *00217 + INITIAL='DLV2:' 00218 + SPACE 00219 +F131807 DFHMDF POS=(18,07),LENGTH=40,ATTRB=ASKIP 00220 + SPACE 00221 + DFHMDF POS=(18,48),LENGTH=01,ATTRB=ASKIP 00222 + SPACE 00223 +F131854 DFHMDF POS=(18,54),LENGTH=25,ATTRB=ASKIP 00224 + SPACE 00225 + DFHMDF POS=(19,01),LENGTH=05,ATTRB=ASKIP, *00226 + INITIAL='CITY:' 00227 + SPACE 00228 +F131907 DFHMDF POS=(19,07),LENGTH=25,ATTRB=ASKIP 00229 + SPACE 00230 + DFHMDF POS=(19,33),LENGTH=01,ATTRB=ASKIP, *00231 + INITIAL=':' 00232 + SPACE 00233 +F131935 DFHMDF POS=(19,35),LENGTH=02,ATTRB=ASKIP 00234 + SPACE 00235 + DFHMDF POS=(19,38),LENGTH=01,ATTRB=ASKIP, *00236 + INITIAL=':' 00237 + SPACE 00238 +F131940 DFHMDF POS=(19,40),LENGTH=10,ATTRB=ASKIP 00239 + SPACE 00240 + DFHMDF POS=(19,51),LENGTH=01,ATTRB=ASKIP 00241 + SPACE 00242 + DFHMDF POS=(20,01),LENGTH=05,ATTRB=ASKIP, *00243 + INITIAL='TEL1:' 00244 + SPACE 00245 +F132007 DFHMDF POS=(20,07),LENGTH=03,ATTRB=ASKIP 00246 + SPACE 00247 +F132011 DFHMDF POS=(20,11),LENGTH=03,ATTRB=ASKIP 00248 + SPACE 00249 +F132015 DFHMDF POS=(20,15),LENGTH=04,ATTRB=ASKIP 00250 + SPACE 00251 +F132020 DFHMDF POS=(20,20),LENGTH=05,ATTRB=ASKIP 00252 + SPACE 00253 + DFHMDF POS=(20,26),LENGTH=01,ATTRB=ASKIP 00254 + SPACE 00255 + DFHMDF POS=(20,29),LENGTH=05,ATTRB=ASKIP, *00256 + INITIAL='TEL2:' 00257 + SPACE 00258 +F132035 DFHMDF POS=(20,35),LENGTH=03,ATTRB=ASKIP 00259 + SPACE 00260 +F132039 DFHMDF POS=(20,39),LENGTH=03,ATTRB=ASKIP 00261 + SPACE 00262 +F132043 DFHMDF POS=(20,43),LENGTH=04,ATTRB=ASKIP 00263 + SPACE 00264 +F132048 DFHMDF POS=(20,48),LENGTH=05,ATTRB=ASKIP 00265 + SPACE 00266 + DFHMDF POS=(20,54),LENGTH=01,ATTRB=ASKIP 00267 + SPACE 00268 + DFHMDF POS=(20,57),LENGTH=04,ATTRB=ASKIP, *00269 + INITIAL='FAX:' 00270 + SPACE 00271 +F132062 DFHMDF POS=(20,62),LENGTH=03,ATTRB=ASKIP 00272 + SPACE 00273 +F132066 DFHMDF POS=(20,66),LENGTH=03,ATTRB=ASKIP 00274 + SPACE 00275 +F132070 DFHMDF POS=(20,70),LENGTH=04,ATTRB=ASKIP 00276 + SPACE 00277 +F132075 DFHMDF POS=(20,75),LENGTH=05,ATTRB=ASKIP 00278 + SPACE 00279 + DFHMDF POS=(21,01),LENGTH=01,ATTRB=ASKIP 00280 + SPACE 00281 + DFHMDF POS=(21,03),LENGTH=06,ATTRB=ASKIP, *00282 + INITIAL='EMAIL:' 00283 + SPACE 00284 +F132110 DFHMDF POS=(21,10),LENGTH=40,ATTRB=ASKIP 00285 + SPACE 00286 + DFHMDF POS=(21,51),LENGTH=01,ATTRB=ASKIP 00287 + SPACE 00288 + DFHMDF POS=(22,01),LENGTH=12,ATTRB=ASKIP, *00289 + INITIAL=' DEBIT MEMO?' 00290 + SPACE 00291 +F132214 DFHMDF POS=(22,14),LENGTH=01,ATTRB=ASKIP 00292 + SPACE 00293 + DFHMDF POS=(22,16),LENGTH=01,ATTRB=ASKIP 00294 + SPACE 00295 + DFHMDF POS=(22,20),LENGTH=13,ATTRB=ASKIP, *00296 + INITIAL='MISS RPT LTR?' 00297 + SPACE 00298 +F132233 DFHMDF POS=(22,34),LENGTH=01,ATTRB=ASKIP 00299 + SPACE 00300 + DFHMDF POS=(22,36),LENGTH=01,ATTRB=ASKIP 00301 + SPACE 00302 + DFHMDF POS=(22,40),LENGTH=14,ATTRB=ASKIP, *00303 + INITIAL='PHYSICAL ADDR?' 00304 + SPACE 00305 +F132255 DFHMDF POS=(22,55),LENGTH=01,ATTRB=ASKIP 00306 + SPACE 00307 + DFHMDF POS=(22,57),LENGTH=01,ATTRB=ASKIP 00308 + SPACE 00309 +F132317 DFHMDF POS=(23,17),LENGTH=07,ATTRB=ASKIP 00310 + SPACE 00311 +F132401 DFHMDF POS=(24,01),LENGTH=08,ATTRB=ASKIP 00312 + SPACE 00313 +F132410 DFHMDF POS=(24,10),LENGTH=58,ATTRB=ASKIP 00314 + SPACE 00315 + DFHMDF POS=(24,69),LENGTH=06,ATTRB=ASKIP, *00316 + INITIAL='GO TO:' 00317 + SPACE 00318 +F132476 DFHMDF POS=(24,76),LENGTH=02,ATTRB=ASKIP 00319 + SPACE 00320 + DFHMDF POS=(24,79),LENGTH=01,ATTRB=ASKIP 00321 diff --git a/Maps/DTSM44.bms b/Maps/DTSM44.bms index db3ad6b..63a11cb 100644 --- a/Maps/DTSM44.bms +++ b/Maps/DTSM44.bms @@ -1,606 +1,597 @@ -* DATA SET DTSM44 AT LEVEL 012 AS OF 11/16/00 -* DATA SET DTSM44 AT LEVEL 002 AS OF 11/14/00 00001 -* DATA SET DTSM44 AT LEVEL 010 AS OF 11/13/00 00002 -* DATA SET DTSM44 AT LEVEL 008 AS OF 10/27/00 00003 -* DATA SET DTSM44 AT LEVEL 007 AS OF 09/29/99 00004 -DTSM44 DFHMDI SIZE=(24,80), X00005 - LINE=01, X00006 - COLUMN=01 00007 -F440101 DFHMDF POS=(01,01), X00008 - ATTRB=(ASKIP,FSET), X00009 - LENGTH=002, X00010 - INITIAL='44' 00011 - DFHMDF POS=(01,19), X00012 - ATTRB=(ASKIP), X00013 - LENGTH=019, X00014 - INITIAL='LIEN INQUIRY/UPDATE' 00015 -F440162 DFHMDF POS=(01,62), X00016 - ATTRB=(ASKIP), X00017 - LENGTH=008 00018 -F440172 DFHMDF POS=(01,72), X00019 - ATTRB=(ASKIP), X00020 - LENGTH=008 00021 - DFHMDF POS=(02,01), X00022 - ATTRB=(ASKIP), X00023 - LENGTH=007, X00024 - INITIAL='EMP NO:' 00025 -F440209 DFHMDF POS=(02,09), X00026 - ATTRB=(ASKIP), X00027 - LENGTH=003 00028 -F440213 DFHMDF POS=(02,13), X00029 - ATTRB=(ASKIP), X00030 - LENGTH=003 00031 - DFHMDF POS=(02,17), X00032 - ATTRB=(ASKIP), X00033 - LENGTH=001 00034 -F440219 DFHMDF POS=(02,19), X00035 - ATTRB=(ASKIP), X00036 - LENGTH=040 00037 -F440272 DFHMDF POS=(02,72), X00038 - ATTRB=(ASKIP), X00039 - LENGTH=008 00040 - DFHMDF POS=(03,02), X00041 - ATTRB=(ASKIP), X00042 - LENGTH=012, X00043 - INITIAL='LIEN STATUS:' 00044 -F440315 DFHMDF POS=(03,15), X00045 - ATTRB=(ASKIP), X00046 - LENGTH=001 00047 - DFHMDF POS=(03,17), X00048 - ATTRB=(ASKIP), X00049 - LENGTH=001 00050 -F440319 DFHMDF POS=(03,19), X00051 - ATTRB=(ASKIP), X00052 - LENGTH=010 00053 - DFHMDF POS=(03,30), X00054 - ATTRB=(ASKIP), X00055 - LENGTH=001 00056 - DFHMDF POS=(03,38), X00057 - ATTRB=(ASKIP), X00058 - LENGTH=013, X00059 - INITIAL='FIELD REP ID:' 00060 -F440352 DFHMDF POS=(03,52), X00061 +* DATA SET DTSM44 AT LEVEL 004 AS OF 08/23/24 +* DATA SET DTSM44 AT LEVEL 012 AS OF 11/16/00 00001 +* DATA SET DTSM44 AT LEVEL 002 AS OF 11/14/00 00002 +* DATA SET DTSM44 AT LEVEL 010 AS OF 11/13/00 00003 +* DATA SET DTSM44 AT LEVEL 008 AS OF 10/27/00 00004 +* DATA SET DTSM44 AT LEVEL 007 AS OF 09/29/99 00005 +DTSM44 DFHMDI SIZE=(24,80), X00006 + LINE=01, X00007 + COLUMN=01 00008 +F440101 DFHMDF POS=(01,01), X00009 + ATTRB=(ASKIP,FSET), X00010 + LENGTH=002, X00011 + INITIAL='44' 00012 + DFHMDF POS=(01,19), X00013 + ATTRB=(ASKIP), X00014 + LENGTH=019, X00015 + INITIAL='LIEN INQUIRY/UPDATE' 00016 +F440162 DFHMDF POS=(01,62), X00017 + ATTRB=(ASKIP), X00018 + LENGTH=008 00019 +F440172 DFHMDF POS=(01,72), X00020 + ATTRB=(ASKIP), X00021 + LENGTH=008 00022 + DFHMDF POS=(02,01), X00023 + ATTRB=(ASKIP), X00024 + LENGTH=007, X00025 + INITIAL='EMP NO:' 00026 +F440209 DFHMDF POS=(02,09), X00027 + ATTRB=(ASKIP), X00028 + LENGTH=003 00029 +F440213 DFHMDF POS=(02,13), X00030 + ATTRB=(ASKIP), X00031 + LENGTH=003 00032 + DFHMDF POS=(02,17), X00033 + ATTRB=(ASKIP), X00034 + LENGTH=001 00035 +F440219 DFHMDF POS=(02,19), X00036 + ATTRB=(ASKIP), X00037 + LENGTH=040 00038 +F440272 DFHMDF POS=(02,72), X00039 + ATTRB=(ASKIP), X00040 + LENGTH=008 00041 + DFHMDF POS=(03,02), X00042 + ATTRB=(ASKIP), X00043 + LENGTH=012, X00044 + INITIAL='LIEN STATUS:' 00045 +F440315 DFHMDF POS=(03,15), X00046 + ATTRB=(ASKIP), X00047 + LENGTH=001 00048 + DFHMDF POS=(03,17), X00049 + ATTRB=(ASKIP), X00050 + LENGTH=001 00051 +F440319 DFHMDF POS=(03,19), X00052 + ATTRB=(ASKIP), X00053 + LENGTH=010 00054 + DFHMDF POS=(03,30), X00055 + ATTRB=(ASKIP), X00056 + LENGTH=001 00057 +F440372 DFHMDF POS=(03,72), X00058 + ATTRB=(ASKIP), X00059 + LENGTH=002 00060 + DFHMDF POS=(03,75), X00061 ATTRB=(ASKIP), X00062 - LENGTH=002 00063 -F440355 DFHMDF POS=(03,55), X00064 - ATTRB=(ASKIP), X00065 - LENGTH=010 00066 -F440372 DFHMDF POS=(03,72), X00067 - ATTRB=(ASKIP), X00068 - LENGTH=002 00069 - DFHMDF POS=(03,75), X00070 - ATTRB=(ASKIP), X00071 - LENGTH=002, X00072 - INITIAL='OF' 00073 -F440378 DFHMDF POS=(03,78), X00074 - ATTRB=(ASKIP), X00075 - LENGTH=002 00076 - DFHMDF POS=(05,02), X00077 - ATTRB=(ASKIP), X00078 - LENGTH=013, X00079 - INITIAL='LIEN STMT DT:' 00080 -F440516 DFHMDF POS=(05,16), X00081 + LENGTH=002, X00063 + INITIAL='OF' 00064 +F440378 DFHMDF POS=(03,78), X00065 + ATTRB=(ASKIP), X00066 + LENGTH=002 00067 + DFHMDF POS=(05,02), X00068 + ATTRB=(ASKIP), X00069 + LENGTH=013, X00070 + INITIAL='LIEN STMT DT:' 00071 +F440516 DFHMDF POS=(05,16), X00072 + ATTRB=(ASKIP), X00073 + LENGTH=002 00074 +F440519 DFHMDF POS=(05,19), X00075 + ATTRB=(ASKIP), X00076 + LENGTH=002 00077 +F440522 DFHMDF POS=(05,22), X00078 + ATTRB=(ASKIP), X00079 + LENGTH=002 00080 + DFHMDF POS=(05,25), X00081 ATTRB=(ASKIP), X00082 - LENGTH=002 00083 -F440519 DFHMDF POS=(05,19), X00084 + LENGTH=001 00083 + DFHMDF POS=(05,43), X00084 ATTRB=(ASKIP), X00085 - LENGTH=002 00086 -F440522 DFHMDF POS=(05,22), X00087 - ATTRB=(ASKIP), X00088 - LENGTH=002 00089 - DFHMDF POS=(05,25), X00090 - ATTRB=(ASKIP), X00091 - LENGTH=001 00092 - DFHMDF POS=(05,43), X00093 - ATTRB=(ASKIP), X00094 - LENGTH=020, X00095 - INITIAL='LEIN ADDRESS TYPE:' 00096 -F440565 DFHMDF POS=(05,64), X00097 - ATTRB=(ASKIP), X00098 - LENGTH=001 00099 - DFHMDF POS=(05,66), X00100 - ATTRB=(ASKIP), X00101 - LENGTH=001 00102 - DFHMDF POS=(05,71), X00103 - ATTRB=(ASKIP), X00104 - LENGTH=003, X00105 - INITIAL='ID:' 00106 -F440574 DFHMDF POS=(05,75), X00107 - ATTRB=(ASKIP), X00108 - LENGTH=003 00109 - DFHMDF POS=(05,79), X00110 - ATTRB=(ASKIP), X00111 - LENGTH=001 00112 - DFHMDF POS=(06,02), X00113 - ATTRB=(ASKIP), X00114 - LENGTH=013, X00115 - INITIAL='LIEN COMP DT:' 00116 -F440616 DFHMDF POS=(06,16), X00117 + LENGTH=020, X00086 + INITIAL='LEIN ADDRESS TYPE:' 00087 +F440565 DFHMDF POS=(05,64), X00088 + ATTRB=(ASKIP), X00089 + LENGTH=001 00090 + DFHMDF POS=(05,66), X00091 + ATTRB=(ASKIP), X00092 + LENGTH=001 00093 + DFHMDF POS=(05,71), X00094 + ATTRB=(ASKIP), X00095 + LENGTH=003, X00096 + INITIAL='ID:' 00097 +F440574 DFHMDF POS=(05,75), X00098 + ATTRB=(ASKIP), X00099 + LENGTH=003 00100 + DFHMDF POS=(05,79), X00101 + ATTRB=(ASKIP), X00102 + LENGTH=001 00103 + DFHMDF POS=(06,02), X00104 + ATTRB=(ASKIP), X00105 + LENGTH=013, X00106 + INITIAL='LIEN COMP DT:' 00107 +F440616 DFHMDF POS=(06,16), X00108 + ATTRB=(ASKIP), X00109 + LENGTH=002 00110 +F440619 DFHMDF POS=(06,19), X00111 + ATTRB=(ASKIP), X00112 + LENGTH=002 00113 +F440622 DFHMDF POS=(06,22), X00114 + ATTRB=(ASKIP), X00115 + LENGTH=002 00116 + DFHMDF POS=(06,25), X00117 ATTRB=(ASKIP), X00118 - LENGTH=002 00119 -F440619 DFHMDF POS=(06,19), X00120 + LENGTH=001 00119 + DFHMDF POS=(06,38), X00120 ATTRB=(ASKIP), X00121 - LENGTH=002 00122 -F440622 DFHMDF POS=(06,22), X00123 - ATTRB=(ASKIP), X00124 - LENGTH=002 00125 - DFHMDF POS=(06,25), X00126 - ATTRB=(ASKIP), X00127 - LENGTH=001 00128 - DFHMDF POS=(06,38), X00129 - ATTRB=(ASKIP), X00130 - LENGTH=001, X00131 - INITIAL=':' 00132 -F440640 DFHMDF POS=(06,40), X00133 - ATTRB=(ASKIP), X00134 - LENGTH=040 00135 - DFHMDF POS=(07,02), X00136 - ATTRB=(ASKIP), X00137 - LENGTH=013, X00138 - INITIAL='LIEN BAL DUE:' 00139 -F440716 DFHMDF POS=(07,16), X00140 - ATTRB=(ASKIP), X00141 - LENGTH=012 00142 - DFHMDF POS=(07,29), X00143 - ATTRB=(ASKIP), X00144 - LENGTH=001 00145 - DFHMDF POS=(07,38), X00146 - ATTRB=(ASKIP), X00147 - LENGTH=001, X00148 - INITIAL=':' 00149 -F440740 DFHMDF POS=(07,40), X00150 - ATTRB=(ASKIP), X00151 - LENGTH=040 00152 - DFHMDF POS=(08,01), X00153 - ATTRB=(ASKIP), X00154 - LENGTH=001 00155 - DFHMDF POS=(08,07), X00156 - ATTRB=(ASKIP), X00157 - LENGTH=008, X00158 - INITIAL='LICENSE?' 00159 -F440816 DFHMDF POS=(08,16), X00160 - ATTRB=(ASKIP), X00161 - LENGTH=001 00162 - DFHMDF POS=(08,18), X00163 - ATTRB=(ASKIP), X00164 - LENGTH=001 00165 - DFHMDF POS=(08,38), X00166 - ATTRB=(ASKIP), X00167 - LENGTH=001, X00168 - INITIAL=':' 00169 -F440840 DFHMDF POS=(08,40), X00170 - ATTRB=(ASKIP), X00171 - LENGTH=040 00172 - DFHMDF POS=(09,01), X00173 - ATTRB=(ASKIP), X00174 - LENGTH=1 00175 - DFHMDF POS=(09,38), X00176 - ATTRB=(ASKIP), X00177 - LENGTH=001, X00178 - INITIAL=':' 00179 -F440940 DFHMDF POS=(09,40), X00180 - ATTRB=(ASKIP), X00181 - LENGTH=040 00182 - DFHMDF POS=(10,01), X00183 - ATTRB=(ASKIP), X00184 - LENGTH=016, X00185 - INITIAL=' CERTIFICATE # :' 00186 -F441017 DFHMDF POS=(10,18), X00187 + LENGTH=001, X00122 + INITIAL=':' 00123 +F440640 DFHMDF POS=(06,40), X00124 + ATTRB=(ASKIP), X00125 + LENGTH=040 00126 + DFHMDF POS=(07,02), X00127 + ATTRB=(ASKIP), X00128 + LENGTH=013, X00129 + INITIAL='LIEN BAL DUE:' 00130 +F440716 DFHMDF POS=(07,16), X00131 + ATTRB=(ASKIP), X00132 + LENGTH=012 00133 + DFHMDF POS=(07,29), X00134 + ATTRB=(ASKIP), X00135 + LENGTH=001 00136 + DFHMDF POS=(07,38), X00137 + ATTRB=(ASKIP), X00138 + LENGTH=001, X00139 + INITIAL=':' 00140 +F440740 DFHMDF POS=(07,40), X00141 + ATTRB=(ASKIP), X00142 + LENGTH=040 00143 + DFHMDF POS=(08,01), X00144 + ATTRB=(ASKIP), X00145 + LENGTH=001 00146 + DFHMDF POS=(08,07), X00147 + ATTRB=(ASKIP), X00148 + LENGTH=008, X00149 + INITIAL='LICENSE?' 00150 +F440816 DFHMDF POS=(08,16), X00151 + ATTRB=(ASKIP), X00152 + LENGTH=001 00153 + DFHMDF POS=(08,18), X00154 + ATTRB=(ASKIP), X00155 + LENGTH=001 00156 + DFHMDF POS=(08,38), X00157 + ATTRB=(ASKIP), X00158 + LENGTH=001, X00159 + INITIAL=':' 00160 +F440840 DFHMDF POS=(08,40), X00161 + ATTRB=(ASKIP), X00162 + LENGTH=040 00163 + DFHMDF POS=(09,01), X00164 + ATTRB=(ASKIP), X00165 + LENGTH=1 00166 + DFHMDF POS=(09,38), X00167 + ATTRB=(ASKIP), X00168 + LENGTH=001, X00169 + INITIAL=':' 00170 +F440940 DFHMDF POS=(09,40), X00171 + ATTRB=(ASKIP), X00172 + LENGTH=040 00173 + DFHMDF POS=(10,01), X00174 + ATTRB=(ASKIP), X00175 + LENGTH=016, X00176 + INITIAL=' CERTIFICATE # :' 00177 +F441017 DFHMDF POS=(10,18), X00178 + ATTRB=(ASKIP), X00179 + LENGTH=002 00180 +F441020 DFHMDF POS=(10,21), X00181 + ATTRB=(ASKIP), X00182 + LENGTH=004 00183 + DFHMDF POS=(10,26), X00184 + ATTRB=(ASKIP), X00185 + LENGTH=001 00186 + DFHMDF POS=(10,38), X00187 ATTRB=(ASKIP), X00188 - LENGTH=002 00189 -F441020 DFHMDF POS=(10,21), X00190 - ATTRB=(ASKIP), X00191 - LENGTH=004 00192 - DFHMDF POS=(10,26), X00193 - ATTRB=(ASKIP), X00194 - LENGTH=001 00195 - DFHMDF POS=(10,38), X00196 - ATTRB=(ASKIP), X00197 - LENGTH=001, X00198 - INITIAL=':' 00199 -F441040 DFHMDF POS=(10,40), X00200 - ATTRB=(ASKIP), X00201 - LENGTH=040 00202 - DFHMDF POS=(11,01), X00203 - ATTRB=(ASKIP), X00204 - LENGTH=016, X00205 - INITIAL=' REC OF DEEDS #:' 00206 -F441118 DFHMDF POS=(11,18), X00207 - ATTRB=(ASKIP), X00208 - LENGTH=010 00209 - DFHMDF POS=(11,29), X00210 - ATTRB=(ASKIP), X00211 - LENGTH=001 00212 - DFHMDF POS=(11,37), X00213 - ATTRB=(ASKIP), X00214 - LENGTH=018, X00215 - INITIAL='CERTIFICATE DATE :' 00216 -F441162 DFHMDF POS=(11,56), X00217 + LENGTH=001, X00189 + INITIAL=':' 00190 +F441040 DFHMDF POS=(10,40), X00191 + ATTRB=(ASKIP), X00192 + LENGTH=040 00193 + DFHMDF POS=(11,01), X00194 + ATTRB=(ASKIP), X00195 + LENGTH=016, X00196 + INITIAL=' REC OF DEEDS #:' 00197 +F441118 DFHMDF POS=(11,18), X00198 + ATTRB=(ASKIP), X00199 + LENGTH=010 00200 + DFHMDF POS=(11,29), X00201 + ATTRB=(ASKIP), X00202 + LENGTH=001 00203 + DFHMDF POS=(11,37), X00204 + ATTRB=(ASKIP), X00205 + LENGTH=018, X00206 + INITIAL='CERTIFICATE DATE :' 00207 +F441162 DFHMDF POS=(11,56), X00208 + ATTRB=(ASKIP), X00209 + LENGTH=002 00210 +F441165 DFHMDF POS=(11,59), X00211 + ATTRB=(ASKIP), X00212 + LENGTH=002 00213 +F441168 DFHMDF POS=(11,62), X00214 + ATTRB=(ASKIP), X00215 + LENGTH=002 00216 + DFHMDF POS=(11,65), X00217 ATTRB=(ASKIP), X00218 - LENGTH=002 00219 -F441165 DFHMDF POS=(11,59), X00220 + LENGTH=001 00219 + DFHMDF POS=(12,01), X00220 ATTRB=(ASKIP), X00221 - LENGTH=002 00222 -F441168 DFHMDF POS=(11,62), X00223 + LENGTH=1 00222 + DFHMDF POS=(12,37), X00223 ATTRB=(ASKIP), X00224 - LENGTH=002 00225 - DFHMDF POS=(11,65), X00226 - ATTRB=(ASKIP), X00227 - LENGTH=001 00228 - DFHMDF POS=(12,01), X00229 - ATTRB=(ASKIP), X00230 - LENGTH=1 00231 - DFHMDF POS=(12,37), X00232 - ATTRB=(ASKIP), X00233 - LENGTH=018, X00234 - INITIAL='CERT MAIL # :' 00235 -F441262 DFHMDF POS=(12,56), X00236 - ATTRB=(ASKIP), X00237 - LENGTH=024 00238 - DFHMDF POS=(13,01), X00239 - ATTRB=(ASKIP), X00240 - LENGTH=015, X00241 - INITIAL=' CURR COMP DT:' 00242 -F441317 DFHMDF POS=(13,17), X00243 + LENGTH=018, X00225 + INITIAL='CERT MAIL # :' 00226 +F441262 DFHMDF POS=(12,56), X00227 + ATTRB=(ASKIP), X00228 + LENGTH=024 00229 + DFHMDF POS=(13,01), X00230 + ATTRB=(ASKIP), X00231 + LENGTH=015, X00232 + INITIAL=' CURR COMP DT:' 00233 +F441317 DFHMDF POS=(13,17), X00234 + ATTRB=(ASKIP), X00235 + LENGTH=002 00236 +F441320 DFHMDF POS=(13,20), X00237 + ATTRB=(ASKIP), X00238 + LENGTH=002 00239 +F441323 DFHMDF POS=(13,23), X00240 + ATTRB=(ASKIP), X00241 + LENGTH=002 00242 + DFHMDF POS=(13,26), X00243 ATTRB=(ASKIP), X00244 - LENGTH=002 00245 -F441320 DFHMDF POS=(13,20), X00246 + LENGTH=001 00245 + DFHMDF POS=(13,37), X00246 ATTRB=(ASKIP), X00247 - LENGTH=002 00248 -F441323 DFHMDF POS=(13,23), X00249 - ATTRB=(ASKIP), X00250 - LENGTH=002 00251 - DFHMDF POS=(13,26), X00252 - ATTRB=(ASKIP), X00253 - LENGTH=001 00254 - DFHMDF POS=(13,37), X00255 - ATTRB=(ASKIP), X00256 - LENGTH=018, X00257 - INITIAL='CERT MAIL DATE :' 00258 -F441362 DFHMDF POS=(13,56), X00259 + LENGTH=018, X00248 + INITIAL='CERT MAIL DATE :' 00249 +F441362 DFHMDF POS=(13,56), X00250 + ATTRB=(ASKIP), X00251 + LENGTH=002 00252 +F441365 DFHMDF POS=(13,59), X00253 + ATTRB=(ASKIP), X00254 + LENGTH=002 00255 +F441368 DFHMDF POS=(13,62), X00256 + ATTRB=(ASKIP), X00257 + LENGTH=002 00258 + DFHMDF POS=(13,65), X00259 ATTRB=(ASKIP), X00260 - LENGTH=002 00261 -F441365 DFHMDF POS=(13,59), X00262 + LENGTH=001 00261 + DFHMDF POS=(14,03), X00262 ATTRB=(ASKIP), X00263 - LENGTH=002 00264 -F441368 DFHMDF POS=(13,62), X00265 - ATTRB=(ASKIP), X00266 - LENGTH=002 00267 - DFHMDF POS=(13,65), X00268 - ATTRB=(ASKIP), X00269 - LENGTH=001 00270 - DFHMDF POS=(14,03), X00271 - ATTRB=(ASKIP), X00272 - LENGTH=013, X00273 - INITIAL='CURR TOT DUE:' 00274 -F441417 DFHMDF POS=(14,17), X00275 - ATTRB=(ASKIP), X00276 - LENGTH=012 00277 - DFHMDF POS=(14,30), X00278 - ATTRB=(ASKIP), X00279 - LENGTH=001 00280 - DFHMDF POS=(14,37), X00281 - ATTRB=(ASKIP), X00282 - LENGTH=018, X00283 - INITIAL='RECEIPT RETURN DT:' 00284 -F441462 DFHMDF POS=(14,56), X00285 + LENGTH=013, X00264 + INITIAL='CURR TOT DUE:' 00265 +F441417 DFHMDF POS=(14,17), X00266 + ATTRB=(ASKIP), X00267 + LENGTH=012 00268 + DFHMDF POS=(14,30), X00269 + ATTRB=(ASKIP), X00270 + LENGTH=001 00271 + DFHMDF POS=(14,37), X00272 + ATTRB=(ASKIP), X00273 + LENGTH=018, X00274 + INITIAL='RECEIPT RETURN DT:' 00275 +F441462 DFHMDF POS=(14,56), X00276 + ATTRB=(ASKIP), X00277 + LENGTH=002 00278 +F441465 DFHMDF POS=(14,59), X00279 + ATTRB=(ASKIP), X00280 + LENGTH=002 00281 +F441468 DFHMDF POS=(14,62), X00282 + ATTRB=(ASKIP), X00283 + LENGTH=002 00284 + DFHMDF POS=(14,65), X00285 ATTRB=(ASKIP), X00286 - LENGTH=002 00287 -F441465 DFHMDF POS=(14,59), X00288 + LENGTH=001 00287 + DFHMDF POS=(16,01), X00288 ATTRB=(ASKIP), X00289 - LENGTH=002 00290 -F441468 DFHMDF POS=(14,62), X00291 - ATTRB=(ASKIP), X00292 - LENGTH=002 00293 - DFHMDF POS=(14,65), X00294 + LENGTH=075, X00290 + INITIAL='YR/Q AMOUNT DUE YR/Q AMOUNT DUE YR/Q AMX00291 + OUNT DUE YR/Q AMOUNT DUE ' 00292 +**TABLED AREA 00293 +F441701 DFHMDF POS=(17,01), X00294 ATTRB=(ASKIP), X00295 - LENGTH=001 00296 - DFHMDF POS=(16,01), X00297 + LENGTH=002 00296 +F441704 DFHMDF POS=(17,04), X00297 ATTRB=(ASKIP), X00298 - LENGTH=075, X00299 - INITIAL='YR/Q AMOUNT DUE YR/Q AMOUNT DUE YR/Q AMX00300 - OUNT DUE YR/Q AMOUNT DUE ' 00301 -**TABLED AREA 00302 -F441701 DFHMDF POS=(17,01), X00303 + LENGTH=001 00299 +F441706 DFHMDF POS=(17,06), X00300 + ATTRB=(ASKIP), X00301 + LENGTH=010 00302 +F441717 DFHMDF POS=(17,17), X00303 ATTRB=(ASKIP), X00304 - LENGTH=002 00305 -F441704 DFHMDF POS=(17,04), X00306 + LENGTH=001 00305 +F441721 DFHMDF POS=(17,21), X00306 ATTRB=(ASKIP), X00307 - LENGTH=001 00308 -F441706 DFHMDF POS=(17,06), X00309 + LENGTH=002 00308 +F441724 DFHMDF POS=(17,24), X00309 ATTRB=(ASKIP), X00310 - LENGTH=010 00311 -F441717 DFHMDF POS=(17,17), X00312 + LENGTH=001 00311 +F441726 DFHMDF POS=(17,26), X00312 ATTRB=(ASKIP), X00313 - LENGTH=001 00314 -F441721 DFHMDF POS=(17,21), X00315 + LENGTH=010 00314 +F441737 DFHMDF POS=(17,37), X00315 ATTRB=(ASKIP), X00316 - LENGTH=002 00317 -F441724 DFHMDF POS=(17,24), X00318 + LENGTH=001 00317 +F441741 DFHMDF POS=(17,41), X00318 ATTRB=(ASKIP), X00319 - LENGTH=001 00320 -F441726 DFHMDF POS=(17,26), X00321 + LENGTH=002 00320 +F441744 DFHMDF POS=(17,44), X00321 ATTRB=(ASKIP), X00322 - LENGTH=010 00323 -F441737 DFHMDF POS=(17,37), X00324 + LENGTH=001 00323 +F441746 DFHMDF POS=(17,46), X00324 ATTRB=(ASKIP), X00325 - LENGTH=001 00326 -F441741 DFHMDF POS=(17,41), X00327 + LENGTH=010 00326 +F441757 DFHMDF POS=(17,57), X00327 ATTRB=(ASKIP), X00328 - LENGTH=002 00329 -F441744 DFHMDF POS=(17,44), X00330 + LENGTH=001 00329 +F441761 DFHMDF POS=(17,61), X00330 ATTRB=(ASKIP), X00331 - LENGTH=001 00332 -F441746 DFHMDF POS=(17,46), X00333 + LENGTH=002 00332 +F441764 DFHMDF POS=(17,64), X00333 ATTRB=(ASKIP), X00334 - LENGTH=010 00335 -F441757 DFHMDF POS=(17,57), X00336 + LENGTH=001 00335 +F441766 DFHMDF POS=(17,66), X00336 ATTRB=(ASKIP), X00337 - LENGTH=001 00338 -F441761 DFHMDF POS=(17,61), X00339 + LENGTH=010 00338 +F441777 DFHMDF POS=(17,77), X00339 ATTRB=(ASKIP), X00340 - LENGTH=002 00341 -F441764 DFHMDF POS=(17,64), X00342 - ATTRB=(ASKIP), X00343 - LENGTH=001 00344 -F441766 DFHMDF POS=(17,66), X00345 - ATTRB=(ASKIP), X00346 - LENGTH=010 00347 -F441777 DFHMDF POS=(17,77), X00348 - ATTRB=(ASKIP), X00349 - LENGTH=001 00350 -** 00351 -F441801 DFHMDF POS=(18,01), X00352 + LENGTH=001 00341 +** 00342 +F441801 DFHMDF POS=(18,01), X00343 + ATTRB=(ASKIP), X00344 + LENGTH=002 00345 +F441804 DFHMDF POS=(18,04), X00346 + ATTRB=(ASKIP), X00347 + LENGTH=001 00348 +F441806 DFHMDF POS=(18,06), X00349 + ATTRB=(ASKIP), X00350 + LENGTH=010 00351 +F441817 DFHMDF POS=(18,17), X00352 ATTRB=(ASKIP), X00353 - LENGTH=002 00354 -F441804 DFHMDF POS=(18,04), X00355 + LENGTH=001 00354 +F441821 DFHMDF POS=(18,21), X00355 ATTRB=(ASKIP), X00356 - LENGTH=001 00357 -F441806 DFHMDF POS=(18,06), X00358 + LENGTH=002 00357 +F441824 DFHMDF POS=(18,24), X00358 ATTRB=(ASKIP), X00359 - LENGTH=010 00360 -F441817 DFHMDF POS=(18,17), X00361 + LENGTH=001 00360 +F441826 DFHMDF POS=(18,26), X00361 ATTRB=(ASKIP), X00362 - LENGTH=001 00363 -F441821 DFHMDF POS=(18,21), X00364 + LENGTH=010 00363 +F441837 DFHMDF POS=(18,37), X00364 ATTRB=(ASKIP), X00365 - LENGTH=002 00366 -F441824 DFHMDF POS=(18,24), X00367 + LENGTH=001 00366 +F441841 DFHMDF POS=(18,41), X00367 ATTRB=(ASKIP), X00368 - LENGTH=001 00369 -F441826 DFHMDF POS=(18,26), X00370 + LENGTH=002 00369 +F441844 DFHMDF POS=(18,44), X00370 ATTRB=(ASKIP), X00371 - LENGTH=010 00372 -F441837 DFHMDF POS=(18,37), X00373 + LENGTH=001 00372 +F441846 DFHMDF POS=(18,46), X00373 ATTRB=(ASKIP), X00374 - LENGTH=001 00375 -F441841 DFHMDF POS=(18,41), X00376 + LENGTH=010 00375 +F441857 DFHMDF POS=(18,57), X00376 ATTRB=(ASKIP), X00377 - LENGTH=002 00378 -F441844 DFHMDF POS=(18,44), X00379 + LENGTH=001 00378 +F441861 DFHMDF POS=(18,61), X00379 ATTRB=(ASKIP), X00380 - LENGTH=001 00381 -F441846 DFHMDF POS=(18,46), X00382 + LENGTH=002 00381 +F441864 DFHMDF POS=(18,64), X00382 ATTRB=(ASKIP), X00383 - LENGTH=010 00384 -F441857 DFHMDF POS=(18,57), X00385 + LENGTH=001 00384 +F441866 DFHMDF POS=(18,66), X00385 ATTRB=(ASKIP), X00386 - LENGTH=001 00387 -F441861 DFHMDF POS=(18,61), X00388 + LENGTH=010 00387 +F441877 DFHMDF POS=(18,77), X00388 ATTRB=(ASKIP), X00389 - LENGTH=002 00390 -F441864 DFHMDF POS=(18,64), X00391 - ATTRB=(ASKIP), X00392 - LENGTH=001 00393 -F441866 DFHMDF POS=(18,66), X00394 - ATTRB=(ASKIP), X00395 - LENGTH=010 00396 -F441877 DFHMDF POS=(18,77), X00397 - ATTRB=(ASKIP), X00398 - LENGTH=001 00399 -** 00400 -F441901 DFHMDF POS=(19,01), X00401 + LENGTH=001 00390 +** 00391 +F441901 DFHMDF POS=(19,01), X00392 + ATTRB=(ASKIP), X00393 + LENGTH=002 00394 +F441904 DFHMDF POS=(19,04), X00395 + ATTRB=(ASKIP), X00396 + LENGTH=001 00397 +F441906 DFHMDF POS=(19,06), X00398 + ATTRB=(ASKIP), X00399 + LENGTH=010 00400 +F441917 DFHMDF POS=(19,17), X00401 ATTRB=(ASKIP), X00402 - LENGTH=002 00403 -F441904 DFHMDF POS=(19,04), X00404 + LENGTH=001 00403 +F441921 DFHMDF POS=(19,21), X00404 ATTRB=(ASKIP), X00405 - LENGTH=001 00406 -F441906 DFHMDF POS=(19,06), X00407 + LENGTH=002 00406 +F441924 DFHMDF POS=(19,24), X00407 ATTRB=(ASKIP), X00408 - LENGTH=010 00409 -F441917 DFHMDF POS=(19,17), X00410 + LENGTH=001 00409 +F441926 DFHMDF POS=(19,26), X00410 ATTRB=(ASKIP), X00411 - LENGTH=001 00412 -F441921 DFHMDF POS=(19,21), X00413 + LENGTH=010 00412 +F441937 DFHMDF POS=(19,37), X00413 ATTRB=(ASKIP), X00414 - LENGTH=002 00415 -F441924 DFHMDF POS=(19,24), X00416 + LENGTH=001 00415 +F441941 DFHMDF POS=(19,41), X00416 ATTRB=(ASKIP), X00417 - LENGTH=001 00418 -F441926 DFHMDF POS=(19,26), X00419 + LENGTH=002 00418 +F441944 DFHMDF POS=(19,44), X00419 ATTRB=(ASKIP), X00420 - LENGTH=010 00421 -F441937 DFHMDF POS=(19,37), X00422 + LENGTH=001 00421 +F441946 DFHMDF POS=(19,46), X00422 ATTRB=(ASKIP), X00423 - LENGTH=001 00424 -F441941 DFHMDF POS=(19,41), X00425 + LENGTH=010 00424 +F441957 DFHMDF POS=(19,57), X00425 ATTRB=(ASKIP), X00426 - LENGTH=002 00427 -F441944 DFHMDF POS=(19,44), X00428 + LENGTH=001 00427 +F441961 DFHMDF POS=(19,61), X00428 ATTRB=(ASKIP), X00429 - LENGTH=001 00430 -F441946 DFHMDF POS=(19,46), X00431 + LENGTH=002 00430 +F441964 DFHMDF POS=(19,64), X00431 ATTRB=(ASKIP), X00432 - LENGTH=010 00433 -F441957 DFHMDF POS=(19,57), X00434 + LENGTH=001 00433 +F441966 DFHMDF POS=(19,66), X00434 ATTRB=(ASKIP), X00435 - LENGTH=001 00436 -F441961 DFHMDF POS=(19,61), X00437 + LENGTH=010 00436 +F441977 DFHMDF POS=(19,77), X00437 ATTRB=(ASKIP), X00438 - LENGTH=002 00439 -F441964 DFHMDF POS=(19,64), X00440 - ATTRB=(ASKIP), X00441 - LENGTH=001 00442 -F441966 DFHMDF POS=(19,66), X00443 - ATTRB=(ASKIP), X00444 - LENGTH=010 00445 -F441977 DFHMDF POS=(19,77), X00446 - ATTRB=(ASKIP), X00447 - LENGTH=001 00448 -** 00449 -F442001 DFHMDF POS=(20,01), X00450 + LENGTH=001 00439 +** 00440 +F442001 DFHMDF POS=(20,01), X00441 + ATTRB=(ASKIP), X00442 + LENGTH=002 00443 +F442004 DFHMDF POS=(20,04), X00444 + ATTRB=(ASKIP), X00445 + LENGTH=001 00446 +F442006 DFHMDF POS=(20,06), X00447 + ATTRB=(ASKIP), X00448 + LENGTH=010 00449 +F442017 DFHMDF POS=(20,17), X00450 ATTRB=(ASKIP), X00451 - LENGTH=002 00452 -F442004 DFHMDF POS=(20,04), X00453 + LENGTH=001 00452 +F442021 DFHMDF POS=(20,21), X00453 ATTRB=(ASKIP), X00454 - LENGTH=001 00455 -F442006 DFHMDF POS=(20,06), X00456 + LENGTH=002 00455 +F442024 DFHMDF POS=(20,24), X00456 ATTRB=(ASKIP), X00457 - LENGTH=010 00458 -F442017 DFHMDF POS=(20,17), X00459 + LENGTH=001 00458 +F442026 DFHMDF POS=(20,26), X00459 ATTRB=(ASKIP), X00460 - LENGTH=001 00461 -F442021 DFHMDF POS=(20,21), X00462 + LENGTH=010 00461 +F442037 DFHMDF POS=(20,37), X00462 ATTRB=(ASKIP), X00463 - LENGTH=002 00464 -F442024 DFHMDF POS=(20,24), X00465 + LENGTH=001 00464 +F442041 DFHMDF POS=(20,41), X00465 ATTRB=(ASKIP), X00466 - LENGTH=001 00467 -F442026 DFHMDF POS=(20,26), X00468 + LENGTH=002 00467 +F442044 DFHMDF POS=(20,44), X00468 ATTRB=(ASKIP), X00469 - LENGTH=010 00470 -F442037 DFHMDF POS=(20,37), X00471 + LENGTH=001 00470 +F442046 DFHMDF POS=(20,46), X00471 ATTRB=(ASKIP), X00472 - LENGTH=001 00473 -F442041 DFHMDF POS=(20,41), X00474 + LENGTH=010 00473 +F442057 DFHMDF POS=(20,57), X00474 ATTRB=(ASKIP), X00475 - LENGTH=002 00476 -F442044 DFHMDF POS=(20,44), X00477 + LENGTH=001 00476 +F442061 DFHMDF POS=(20,61), X00477 ATTRB=(ASKIP), X00478 - LENGTH=001 00479 -F442046 DFHMDF POS=(20,46), X00480 + LENGTH=002 00479 +F442064 DFHMDF POS=(20,64), X00480 ATTRB=(ASKIP), X00481 - LENGTH=010 00482 -F442057 DFHMDF POS=(20,57), X00483 + LENGTH=001 00482 +F442066 DFHMDF POS=(20,66), X00483 ATTRB=(ASKIP), X00484 - LENGTH=001 00485 -F442061 DFHMDF POS=(20,61), X00486 + LENGTH=010 00485 +F442077 DFHMDF POS=(20,77), X00486 ATTRB=(ASKIP), X00487 - LENGTH=002 00488 -F442064 DFHMDF POS=(20,64), X00489 - ATTRB=(ASKIP), X00490 - LENGTH=001 00491 -F442066 DFHMDF POS=(20,66), X00492 - ATTRB=(ASKIP), X00493 - LENGTH=010 00494 -F442077 DFHMDF POS=(20,77), X00495 - ATTRB=(ASKIP), X00496 - LENGTH=001 00497 -** 00498 -F442101 DFHMDF POS=(21,01), X00499 + LENGTH=001 00488 +** 00489 +F442101 DFHMDF POS=(21,01), X00490 + ATTRB=(ASKIP), X00491 + LENGTH=002 00492 +F442104 DFHMDF POS=(21,04), X00493 + ATTRB=(ASKIP), X00494 + LENGTH=001 00495 +F442106 DFHMDF POS=(21,06), X00496 + ATTRB=(ASKIP), X00497 + LENGTH=010 00498 +F442117 DFHMDF POS=(21,17), X00499 ATTRB=(ASKIP), X00500 - LENGTH=002 00501 -F442104 DFHMDF POS=(21,04), X00502 + LENGTH=001 00501 +F442121 DFHMDF POS=(21,21), X00502 ATTRB=(ASKIP), X00503 - LENGTH=001 00504 -F442106 DFHMDF POS=(21,06), X00505 + LENGTH=002 00504 +F442124 DFHMDF POS=(21,24), X00505 ATTRB=(ASKIP), X00506 - LENGTH=010 00507 -F442117 DFHMDF POS=(21,17), X00508 + LENGTH=001 00507 +F442126 DFHMDF POS=(21,26), X00508 ATTRB=(ASKIP), X00509 - LENGTH=001 00510 -F442121 DFHMDF POS=(21,21), X00511 + LENGTH=010 00510 +F442137 DFHMDF POS=(21,37), X00511 ATTRB=(ASKIP), X00512 - LENGTH=002 00513 -F442124 DFHMDF POS=(21,24), X00514 + LENGTH=001 00513 +F442141 DFHMDF POS=(21,41), X00514 ATTRB=(ASKIP), X00515 - LENGTH=001 00516 -F442126 DFHMDF POS=(21,26), X00517 + LENGTH=002 00516 +F442144 DFHMDF POS=(21,44), X00517 ATTRB=(ASKIP), X00518 - LENGTH=010 00519 -F442137 DFHMDF POS=(21,37), X00520 + LENGTH=001 00519 +F442146 DFHMDF POS=(21,46), X00520 ATTRB=(ASKIP), X00521 - LENGTH=001 00522 -F442141 DFHMDF POS=(21,41), X00523 + LENGTH=010 00522 +F442157 DFHMDF POS=(21,57), X00523 ATTRB=(ASKIP), X00524 - LENGTH=002 00525 -F442144 DFHMDF POS=(21,44), X00526 + LENGTH=001 00525 +F442161 DFHMDF POS=(21,61), X00526 ATTRB=(ASKIP), X00527 - LENGTH=001 00528 -F442146 DFHMDF POS=(21,46), X00529 + LENGTH=002 00528 +F442164 DFHMDF POS=(21,64), X00529 ATTRB=(ASKIP), X00530 - LENGTH=010 00531 -F442157 DFHMDF POS=(21,57), X00532 + LENGTH=001 00531 +F442166 DFHMDF POS=(21,66), X00532 ATTRB=(ASKIP), X00533 - LENGTH=001 00534 -F442161 DFHMDF POS=(21,61), X00535 + LENGTH=010 00534 +F442177 DFHMDF POS=(21,77), X00535 ATTRB=(ASKIP), X00536 - LENGTH=002 00537 -F442164 DFHMDF POS=(21,64), X00538 - ATTRB=(ASKIP), X00539 - LENGTH=001 00540 -F442166 DFHMDF POS=(21,66), X00541 - ATTRB=(ASKIP), X00542 - LENGTH=010 00543 -F442177 DFHMDF POS=(21,77), X00544 - ATTRB=(ASKIP), X00545 - LENGTH=001 00546 -** 00547 - DFHMDF POS=(22,02), X00548 - ATTRB=(ASKIP), X00549 - LENGTH=010, X00550 - INITIAL='STATUS DT:' 00551 -F442211 DFHMDF POS=(22,13), X00552 - ATTRB=(ASKIP), X00553 - LENGTH=008 00554 - DFHMDF POS=(22,23), X00555 - ATTRB=(ASKIP), X00556 - LENGTH=012, X00557 - INITIAL='STATUS OPID:' 00558 -F442232 DFHMDF POS=(22,36), X00559 - ATTRB=(ASKIP), X00560 - LENGTH=008 00561 - DFHMDF POS=(22,46), X00562 - ATTRB=(ASKIP), X00563 - LENGTH=017, X00564 - INITIAL='CREATE DATE/TIME:' 00565 -F442261 DFHMDF POS=(22,64), X00566 + LENGTH=001 00537 +** 00538 + DFHMDF POS=(22,02), X00539 + ATTRB=(ASKIP), X00540 + LENGTH=010, X00541 + INITIAL='STATUS DT:' 00542 +F442211 DFHMDF POS=(22,13), X00543 + ATTRB=(ASKIP), X00544 + LENGTH=008 00545 + DFHMDF POS=(22,23), X00546 + ATTRB=(ASKIP), X00547 + LENGTH=012, X00548 + INITIAL='STATUS OPID:' 00549 +F442232 DFHMDF POS=(22,36), X00550 + ATTRB=(ASKIP), X00551 + LENGTH=008 00552 + DFHMDF POS=(22,46), X00553 + ATTRB=(ASKIP), X00554 + LENGTH=017, X00555 + INITIAL='CREATE DATE/TIME:' 00556 +F442261 DFHMDF POS=(22,64), X00557 + ATTRB=(ASKIP), X00558 + LENGTH=015 00559 +F442301 DFHMDF POS=(23,01), X00560 + ATTRB=(ASKIP), X00561 + LENGTH=008 00562 +F442310 DFHMDF POS=(23,10), X00563 + ATTRB=(ASKIP), X00564 + LENGTH=007 00565 +F442318 DFHMDF POS=(23,18), X00566 ATTRB=(ASKIP), X00567 - LENGTH=015 00568 -F442301 DFHMDF POS=(23,01), X00569 + LENGTH=007 00568 +F442326 DFHMDF POS=(23,26), X00569 ATTRB=(ASKIP), X00570 - LENGTH=008 00571 -F442310 DFHMDF POS=(23,10), X00572 + LENGTH=007 00571 +F442334 DFHMDF POS=(23,34), X00572 ATTRB=(ASKIP), X00573 - LENGTH=007 00574 -F442318 DFHMDF POS=(23,18), X00575 + LENGTH=006 00574 +F442341 DFHMDF POS=(23,41), X00575 ATTRB=(ASKIP), X00576 LENGTH=007 00577 -F442326 DFHMDF POS=(23,26), X00578 +F442349 DFHMDF POS=(23,49), X00578 ATTRB=(ASKIP), X00579 LENGTH=007 00580 -F442334 DFHMDF POS=(23,34), X00581 +F442401 DFHMDF POS=(24,01), X00581 ATTRB=(ASKIP), X00582 - LENGTH=006 00583 -F442341 DFHMDF POS=(23,41), X00584 + LENGTH=008 00583 +F442410 DFHMDF POS=(24,10), X00584 ATTRB=(ASKIP), X00585 - LENGTH=007 00586 -F442349 DFHMDF POS=(23,49), X00587 + LENGTH=058 00586 + DFHMDF POS=(24,69), X00587 ATTRB=(ASKIP), X00588 - LENGTH=007 00589 -F442401 DFHMDF POS=(24,01), X00590 - ATTRB=(ASKIP), X00591 - LENGTH=008 00592 -F442410 DFHMDF POS=(24,10), X00593 - ATTRB=(ASKIP), X00594 - LENGTH=058 00595 - DFHMDF POS=(24,69), X00596 - ATTRB=(ASKIP), X00597 - LENGTH=006, X00598 - INITIAL='GO TO:' 00599 -F442476 DFHMDF POS=(24,76), X00600 - ATTRB=(ASKIP), X00601 - LENGTH=002 00602 - DFHMDF POS=(24,79), X00603 - ATTRB=(ASKIP), X00604 - LENGTH=001 00605 + LENGTH=006, X00589 + INITIAL='GO TO:' 00590 +F442476 DFHMDF POS=(24,76), X00591 + ATTRB=(ASKIP), X00592 + LENGTH=002 00593 + DFHMDF POS=(24,79), X00594 + ATTRB=(ASKIP), X00595 + LENGTH=001 00596 diff --git a/Maps/DTSMSET.cpy b/Maps/DTSMSET.cpy index 00cb5ae..4746674 100644 --- a/Maps/DTSMSET.cpy +++ b/Maps/DTSMSET.cpy @@ -12298,16 +12298,6 @@ 02 FILLER REDEFINES F440319F. 04 F440319A PIC X. 02 F440319I PIC X(10). - 02 F440352L PIC S9(4) COMP-5. - 02 F440352F PIC X(1). - 02 FILLER REDEFINES F440352F. - 04 F440352A PIC X. - 02 F440352I PIC X(2). - 02 F440355L PIC S9(4) COMP-5. - 02 F440355F PIC X(1). - 02 FILLER REDEFINES F440355F. - 04 F440355A PIC X. - 02 F440355I PIC X(10). 02 F440372L PIC S9(4) COMP-5. 02 F440372F PIC X(1). 02 FILLER REDEFINES F440372F. @@ -12964,10 +12954,6 @@ 02 FILLER PIC X(3). 02 F440319O PIC X(10). 02 FILLER PIC X(3). - 02 F440352O PIC X(2). - 02 FILLER PIC X(3). - 02 F440355O PIC X(10). - 02 FILLER PIC X(3). 02 F440372O PIC X(2). 02 FILLER PIC X(3). 02 F440378O PIC X(2). diff --git a/Maps/DTSMSET.xml b/Maps/DTSMSET.xml index 386accf..5b42414 100644 --- a/Maps/DTSMSET.xml +++ b/Maps/DTSMSET.xml @@ -34863,41 +34863,6 @@ Intensity="NORM" /> - - - - - - - - -