From 3d00916cd1a9c3632edd73cb0a037ad8c94a6450 Mon Sep 17 00:00:00 2001 From: faizana Date: Tue, 9 Sep 2025 05:10:10 -0400 Subject: [PATCH] DTSCS37.cob screen crashing fixed. https://inow.myjetbrains.com/youtrack/issue/DR-57 --- CICS/DTSCS37.cob | 1492 +++++++++++++++++++++++----------------------- 1 file changed, 756 insertions(+), 736 deletions(-) diff --git a/CICS/DTSCS37.cob b/CICS/DTSCS37.cob index 663ae30..4744189 100644 --- a/CICS/DTSCS37.cob +++ b/CICS/DTSCS37.cob @@ -1,6 +1,6 @@ -00001 IDENTIFICATION DIVISION. 04/05/04 +00001 IDENTIFICATION DIVISION. 12/29/16 00002 PROGRAM-ID. DTSCS37. DTSCS37 -00003 AUTHOR. TRW. LV003 +00003 AUTHOR. TRW. LV024 00004 DATE-WRITTEN. APRIL 2003. DTSCS37 00005 DATE-COMPILED. DTSCS37 00006 SKIP3 DTSCS37 @@ -14,9 +14,9 @@ 00014 * 04/25/2003 INITIAL DEVELOPMENT. DTSCS37 00015 * REFERENCE: EFT PROGRAMMER: GD DTSCS37 00016 * DTSCS37 -00017 * MM/DD/YYYY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS37 -00018 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX DTSCS37 -00019 * REFERENCE: XXXXXXXXXXXXXXX PROGRAMMER: XXX DTSCS37 +00017 * 11/10/2016 PAYMENT SCREEN UPDATE FOR MULTIPLE EMPLOYERS CL*10 +00018 * FOR SAME PAYMENT ID CL*10 +00019 * REFERENCE: PROGRAMMER:N GUPTA CL*10 00020 * DTSCS37 00021 * DTSCS37 00022 * DESCRIPTION: DTSCS37 @@ -161,7 +161,7 @@ 00161 DATA DIVISION. DTSCS37 00162 SKIP3 DTSCS37 00163 WORKING-STORAGE SECTION. DTSCS37 -001635 77 PAN-VALET PICTURE X(24) VALUE '003DTSCS37 04/05/04'. DTSCS37 +001635 77 PAN-VALET PICTURE X(24) VALUE '024DTSCS37 12/29/16'. DTSCS37 00164 SKIP3 DTSCS37 00165 01 WRK-AREA. DTSCS37 00166 05 WRK-ABEND-CD PIC X(04) VALUE 'S37 '. DTSCS37 @@ -440,6 +440,7 @@ 00439 TO SCR-ACCESS-IND. DTSCS37 00440 DTSCS37 00441 MOVE SPACE TO REQ-IND. DTSCS37 +000000 MOVE +0 TO PAGE-LINE-CNT. DTSCS37 00442 DTSCS37 00443 PERFORM P1000-ANALYZE-REQUEST THRU P1000-EXIT. DTSCS37 00444 DTSCS37 @@ -1013,739 +1014,758 @@ 01012 DTSCS37 01013 IF L810-NO-REC-88 DTSCS37 01014 PERFORM S821-END-BROWSE THRU S821-EXIT DTSCS37 -01015 GO TO P7100-EXIT DTSCS37 -01016 ELSE DTSCS37 -01017 MOVE ISKL-REC TO ITRT-REC DTSCS37 -01018 PERFORM S821-END-BROWSE THRU S821-EXIT DTSCS37 -01019 IF ITRT-TRACE-NO = WRK-TRACE-NO DTSCS37 -01020 NEXT SENTENCE DTSCS37 -01021 ELSE DTSCS37 -01022 GO TO P7100-EXIT. DTSCS37 -01023 DTSCS37 -01024 PERFORM P7110-FIND-MPAY THRU P7110-EXIT. DTSCS37 -01025 DTSCS37 -01026 PERFORM P7900-FIND-MREV THRU P7900-EXIT. DTSCS37 -01027 DTSCS37 -01028 IF PAGE-LINE-CNT > +0 DTSCS37 -01029 PERFORM P8100-STORE-PAGE-AREA THRU P8100-EXIT. DTSCS37 -01030 DTSCS37 -01031 P7100-EXIT. DTSCS37 -01032 EXIT. DTSCS37 -01033 SKIP3 DTSCS37 -01034 P7110-FIND-MPAY. DTSCS37 -01035 MOVE LOW-VALUE TO MPAY-REC. DTSCS37 -01036 MOVE ITRT-EMP-NO TO MPAY-EMP-NO. DTSCS37 -01037 SET MPAY-PAY-88 TO TRUE. DTSCS37 -01038 MOVE ITRT-BATCH-NO TO MPAY-BATCH-NO. DTSCS37 -01039 MOVE ITRT-ITEM-NO TO MPAY-ITEM-NO. DTSCS37 -01040 MOVE MPAY-KEY-AREA TO MSKL-KEY-AREA. DTSCS37 -01041 PERFORM S810-READ THRU S810-EXIT. DTSCS37 -01042 IF L810-OK-88 DTSCS37 -01043 MOVE MSKL-REC TO MPAY-REC DTSCS37 -01044 PERFORM P7800-MPAY-TO-PAGE-LINE THRU P7800-EXIT. DTSCS37 -01045 DTSCS37 -01046 P7110-EXIT. DTSCS37 -01047 EXIT. DTSCS37 -01048 SKIP3 DTSCS37 -01049 SKIP3 DTSCS37 -01050 P7200-EMP-NO-SEARCH. DTSCS37 -01051 MOVE LOW-VALUES TO ITRE-KEY-AREA. DTSCS37 -01052 SET ITRE-TRE-88 TO TRUE. DTSCS37 -01053 MOVE WRK-EMP-NO TO ITRE-EMP-NO. DTSCS37 -01054 MOVE ZERO TO ITRE-RCVD-DATE-XOR DTSCS37 -01055 ITRE-TRACE-NO DTSCS37 -01056 ITRE-BATCH-NO DTSCS37 -01057 ITRE-ITEM-NO. DTSCS37 -01058 MOVE ITRE-KEY-AREA TO ISKL-KEY-AREA. DTSCS37 +01015 GO TO P7100-EXIT. CL**8 +01016 PERFORM CL*18 +01017 UNTIL L821-NO-REC-88 CL*18 +01018 MOVE ISKL-REC TO ITRT-REC CL*18 +01019 * PERFORM UNTIL ITRT-TRACE-NO NOT= WRK-TRACE-NO CL*18 +01020 IF ITRT-TRACE-NO = WRK-TRACE-NO CL*11 +01021 SET WRK-SELECT-NO-88 TO TRUE CL*18 +01022 PERFORM P7110-FIND-MPAY THRU P7110-EXIT CL*14 +01023 IF WRK-SELECT-YES-88 CL*18 +01024 PERFORM P7900-FIND-MREV THRU P7900-EXIT CL*11 +01025 END-IF CL*18 +01026 PERFORM S821-READ-NEXT THRU S821-EXIT CL**5 +01027 ELSE CL*18 +01028 SET L821-NO-REC-88 TO TRUE CL*18 +01029 END-IF CL*18 +01030 * MOVE ISKL-REC TO ITRT-REC CL*18 +01031 END-PERFORM. CL*18 +01032 PERFORM S821-END-BROWSE THRU S821-EXIT CL**4 +01033 * CL**8 +01034 * ELSE CL*11 +01035 * GO TO P7100-EXIT. CL*11 +01036 DTSCS37 +01037 IF PAGE-LINE-CNT > +0 DTSCS37 +01038 PERFORM P8100-STORE-PAGE-AREA THRU P8100-EXIT. DTSCS37 +01039 DTSCS37 +01040 P7100-EXIT. DTSCS37 +01041 EXIT. DTSCS37 +01042 SKIP3 DTSCS37 +01043 P7110-FIND-MPAY. DTSCS37 +01044 MOVE LOW-VALUE TO MPAY-REC. DTSCS37 +01045 MOVE LOW-VALUE TO MSKL-REC. CL*15 +01046 MOVE ITRT-EMP-NO TO MPAY-EMP-NO. DTSCS37 +01047 SET MPAY-PAY-88 TO TRUE. DTSCS37 +01048 MOVE ITRT-BATCH-NO TO MPAY-BATCH-NO. DTSCS37 +01049 MOVE ITRT-ITEM-NO TO MPAY-ITEM-NO. DTSCS37 +01050 MOVE MPAY-KEY-AREA TO MSKL-KEY-AREA. DTSCS37 +01051 PERFORM S810-READ THRU S810-EXIT. DTSCS37 +01052 IF L810-OK-88 DTSCS37 +01053 MOVE MSKL-REC TO MPAY-REC DTSCS37 +01054 PERFORM P7211-CHECK-TYPE THRU P7211-EXIT CL*19 +01055 IF WRK-SELECT-YES-88 CL*19 +01056 PERFORM P7212-CHECK-DATES THRU P7212-EXIT CL*19 +01057 IF WRK-SELECT-YES-88 CL*19 +01058 PERFORM P7800-MPAY-TO-PAGE-LINE THRU P7800-EXIT. CL*19 01059 DTSCS37 -01060 PERFORM S821-START-BROWSE THRU S821-EXIT. DTSCS37 -01061 DTSCS37 -01062 IF L810-NO-REC-88 DTSCS37 -01063 PERFORM S821-END-BROWSE THRU S821-EXIT DTSCS37 -01064 GO TO P7200-EXIT DTSCS37 -01065 ELSE DTSCS37 -01066 PERFORM DTSCS37 -01067 UNTIL L821-NO-REC-88 DTSCS37 -01068 MOVE ISKL-REC TO ITRE-REC DTSCS37 -01069 IF ITRE-EMP-NO = WRK-EMP-NO DTSCS37 -01070 SET WRK-SELECT-NO-88 TO TRUE DTSCS37 -01071 PERFORM P7210-FIND-MPAY THRU P7210-EXIT DTSCS37 -01072 IF WRK-SELECT-YES-88 DTSCS37 -01073 PERFORM P7900-FIND-MREV THRU P7900-EXIT DTSCS37 -01074 END-IF DTSCS37 -01075 PERFORM S821-READ-NEXT THRU S821-EXIT DTSCS37 -01076 ELSE DTSCS37 -01077 SET L821-NO-REC-88 TO TRUE DTSCS37 -01078 END-IF DTSCS37 -01079 END-PERFORM. DTSCS37 -01080 DTSCS37 -01081 PERFORM S821-END-BROWSE THRU S821-EXIT DTSCS37 -01082 DTSCS37 -01083 IF PAGE-LINE-CNT > +0 DTSCS37 -01084 PERFORM P8100-STORE-PAGE-AREA THRU P8100-EXIT. DTSCS37 -01085 DTSCS37 -01086 P7200-EXIT. DTSCS37 -01087 EXIT. DTSCS37 -01088 DTSCS37 -01089 P7210-FIND-MPAY. DTSCS37 -01090 MOVE LOW-VALUE TO MPAY-REC. DTSCS37 -01091 MOVE ITRE-EMP-NO TO MPAY-EMP-NO. DTSCS37 -01092 SET MPAY-PAY-88 TO TRUE. DTSCS37 -01093 MOVE ITRE-BATCH-NO TO MPAY-BATCH-NO. DTSCS37 -01094 MOVE ITRE-ITEM-NO TO MPAY-ITEM-NO. DTSCS37 -01095 MOVE MPAY-KEY-AREA TO MSKL-KEY-AREA. DTSCS37 -01096 PERFORM S810-READ THRU S810-EXIT. DTSCS37 -01097 IF L810-OK-88 DTSCS37 -01098 MOVE MSKL-REC TO MPAY-REC DTSCS37 -01099 PERFORM P7211-CHECK-TYPE THRU P7211-EXIT DTSCS37 -01100 IF WRK-SELECT-YES-88 DTSCS37 -01101 PERFORM P7212-CHECK-DATES THRU P7212-EXIT DTSCS37 -01102 IF WRK-SELECT-YES-88 DTSCS37 -01103 PERFORM P7800-MPAY-TO-PAGE-LINE THRU P7800-EXIT. DTSCS37 -01104 DTSCS37 -01105 P7210-EXIT. DTSCS37 -01106 EXIT. DTSCS37 -01107 SKIP3 DTSCS37 -01108 P7211-CHECK-TYPE. DTSCS37 -01109 IF MPAY-PAYMENT-88 DTSCS37 -01110 OR MPAY-REF-REV-88 DTSCS37 -01111 SET WRK-SELECT-YES-88 TO TRUE DTSCS37 -01112 ELSE DTSCS37 -01113 SET WRK-SELECT-NO-88 TO TRUE DTSCS37 -01114 END-IF. DTSCS37 -01115 DTSCS37 -01116 P7211-EXIT. DTSCS37 -01117 EXIT. DTSCS37 -01118 SKIP3 DTSCS37 -01119 P7212-CHECK-DATES. DTSCS37 -01120 IF WRK-DATE1 NOT = ZERO DTSCS37 -01121 IF WRK-DATE2 = ZERO DTSCS37 -01122 IF MPAY-RECEIVED-DATE = WRK-DATE1 DTSCS37 -01123 SET WRK-SELECT-YES-88 TO TRUE DTSCS37 -01124 ELSE DTSCS37 -01125 SET WRK-SELECT-NO-88 TO TRUE DTSCS37 -01126 END-IF DTSCS37 -01127 ELSE DTSCS37 -01128 IF MPAY-RECEIVED-DATE >= WRK-DATE1 DTSCS37 -01129 AND MPAY-RECEIVED-DATE <= WRK-DATE2 DTSCS37 -01130 SET WRK-SELECT-YES-88 TO TRUE DTSCS37 -01131 ELSE DTSCS37 -01132 SET WRK-SELECT-NO-88 TO TRUE DTSCS37 -01133 END-IF DTSCS37 -01134 END-IF DTSCS37 -01135 ELSE DTSCS37 -01136 SET WRK-SELECT-YES-88 TO TRUE DTSCS37 -01137 END-IF. DTSCS37 -01138 DTSCS37 -01139 P7212-EXIT. DTSCS37 -01140 EXIT. DTSCS37 -01141 SKIP3 DTSCS37 -01142 P7800-MPAY-TO-PAGE-LINE. DTSCS37 -01143 IF PAGE-LINE-CNT < LINES-PER-PAGE DTSCS37 -01144 NEXT SENTENCE DTSCS37 -01145 ELSE DTSCS37 -01146 PERFORM P8100-STORE-PAGE-AREA THRU P8100-EXIT DTSCS37 -01147 MOVE +0 TO PAGE-LINE-CNT. DTSCS37 -01148 DTSCS37 -01149 ADD +1 TO PAGE-LINE-CNT. DTSCS37 -01150 DTSCS37 -01151 MOVE MPAY-EMP-NO TO PAGE-EMP-NO (PAGE-LINE-CNT). DTSCS37 -01152 MOVE MPAY-PAY-TYPE TO PAGE-PAY-TYPE (PAGE-LINE-CNT). DTSCS37 -01153 MOVE MPAY-BATCH-NO TO PAGE-BATCH-NO (PAGE-LINE-CNT). DTSCS37 -01154 MOVE MPAY-ITEM-NO TO PAGE-ITEM-NO (PAGE-LINE-CNT). DTSCS37 -01155 MOVE MPAY-TRACE-NO TO PAGE-TRACE-NO (PAGE-LINE-CNT). DTSCS37 -01156 MOVE MPAY-REMIT-AMT DTSCS37 -01157 TO PAGE-AMT (PAGE-LINE-CNT). DTSCS37 -01158 MOVE MPAY-RECEIVED-DATE DTSCS37 -01159 TO PAGE-RECEIVED-DATE (PAGE-LINE-CNT). DTSCS37 -01160 MOVE MPAY-ESTB-DATE DTSCS37 -01161 TO PAGE-PROCESSED-DATE (PAGE-LINE-CNT). DTSCS37 -01162 DTSCS37 -01163 P7800-EXIT. DTSCS37 -01164 EXIT. DTSCS37 +01060 P7110-EXIT. DTSCS37 +01061 EXIT. DTSCS37 +01062 SKIP3 DTSCS37 +01063 SKIP3 DTSCS37 +01064 P7200-EMP-NO-SEARCH. DTSCS37 +01065 MOVE LOW-VALUES TO ITRE-KEY-AREA. DTSCS37 +01066 SET ITRE-TRE-88 TO TRUE. DTSCS37 +01067 MOVE WRK-EMP-NO TO ITRE-EMP-NO. DTSCS37 +01068 MOVE ZERO TO ITRE-RCVD-DATE-XOR DTSCS37 +01069 ITRE-TRACE-NO DTSCS37 +01070 ITRE-BATCH-NO DTSCS37 +01071 ITRE-ITEM-NO. DTSCS37 +01072 MOVE ITRE-KEY-AREA TO ISKL-KEY-AREA. DTSCS37 +01073 DTSCS37 +01074 PERFORM S821-START-BROWSE THRU S821-EXIT. DTSCS37 +01075 DTSCS37 +01076 IF L810-NO-REC-88 DTSCS37 +01077 PERFORM S821-END-BROWSE THRU S821-EXIT DTSCS37 +01078 GO TO P7200-EXIT DTSCS37 +01079 ELSE DTSCS37 +01080 PERFORM DTSCS37 +01081 UNTIL L821-NO-REC-88 DTSCS37 +01082 MOVE ISKL-REC TO ITRE-REC DTSCS37 +01083 IF ITRE-EMP-NO = WRK-EMP-NO DTSCS37 +01084 SET WRK-SELECT-NO-88 TO TRUE DTSCS37 +01085 PERFORM P7210-FIND-MPAY THRU P7210-EXIT DTSCS37 +01086 IF WRK-SELECT-YES-88 DTSCS37 +01087 PERFORM P7900-FIND-MREV THRU P7900-EXIT DTSCS37 +01088 END-IF DTSCS37 +01089 PERFORM S821-READ-NEXT THRU S821-EXIT DTSCS37 +01090 ELSE DTSCS37 +01091 SET L821-NO-REC-88 TO TRUE DTSCS37 +01092 END-IF DTSCS37 +01093 END-PERFORM. DTSCS37 +01094 DTSCS37 +01095 PERFORM S821-END-BROWSE THRU S821-EXIT DTSCS37 +01096 DTSCS37 +01097 IF PAGE-LINE-CNT > +0 DTSCS37 +01098 PERFORM P8100-STORE-PAGE-AREA THRU P8100-EXIT. DTSCS37 +01099 DTSCS37 +01100 P7200-EXIT. DTSCS37 +01101 EXIT. DTSCS37 +01102 DTSCS37 +01103 P7210-FIND-MPAY. DTSCS37 +01104 MOVE LOW-VALUE TO MPAY-REC. DTSCS37 +01105 MOVE LOW-VALUE TO MSKL-REC. CL*15 +01106 MOVE ITRE-EMP-NO TO MPAY-EMP-NO. DTSCS37 +01107 SET MPAY-PAY-88 TO TRUE. DTSCS37 +01108 MOVE ITRE-BATCH-NO TO MPAY-BATCH-NO. DTSCS37 +01109 MOVE ITRE-ITEM-NO TO MPAY-ITEM-NO. DTSCS37 +01110 MOVE MPAY-KEY-AREA TO MSKL-KEY-AREA. DTSCS37 +01111 PERFORM S810-READ THRU S810-EXIT. DTSCS37 +01112 IF L810-OK-88 DTSCS37 +01113 MOVE MSKL-REC TO MPAY-REC DTSCS37 +01114 PERFORM P7211-CHECK-TYPE THRU P7211-EXIT DTSCS37 +01115 IF WRK-SELECT-YES-88 DTSCS37 +01116 PERFORM P7212-CHECK-DATES THRU P7212-EXIT DTSCS37 +01117 IF WRK-SELECT-YES-88 DTSCS37 +01118 PERFORM P7800-MPAY-TO-PAGE-LINE THRU P7800-EXIT. DTSCS37 +01119 DTSCS37 +01120 P7210-EXIT. DTSCS37 +01121 EXIT. DTSCS37 +01122 SKIP3 DTSCS37 +01123 P7211-CHECK-TYPE. DTSCS37 +01124 IF MPAY-PAYMENT-88 DTSCS37 +01125 OR MPAY-REF-REV-88 DTSCS37 +01126 SET WRK-SELECT-YES-88 TO TRUE DTSCS37 +01127 ELSE DTSCS37 +01128 SET WRK-SELECT-NO-88 TO TRUE DTSCS37 +01129 END-IF. DTSCS37 +01130 DTSCS37 +01131 P7211-EXIT. DTSCS37 +01132 EXIT. DTSCS37 +01133 SKIP3 DTSCS37 +01134 P7212-CHECK-DATES. DTSCS37 +01135 IF WRK-DATE1 NOT = ZERO DTSCS37 +01136 IF WRK-DATE2 = ZERO DTSCS37 +01137 IF MPAY-RECEIVED-DATE = WRK-DATE1 DTSCS37 +01138 SET WRK-SELECT-YES-88 TO TRUE DTSCS37 +01139 ELSE DTSCS37 +01140 SET WRK-SELECT-NO-88 TO TRUE DTSCS37 +01141 END-IF DTSCS37 +01142 ELSE DTSCS37 +01143 IF MPAY-RECEIVED-DATE >= WRK-DATE1 DTSCS37 +01144 AND MPAY-RECEIVED-DATE <= WRK-DATE2 DTSCS37 +01145 SET WRK-SELECT-YES-88 TO TRUE DTSCS37 +01146 ELSE DTSCS37 +01147 SET WRK-SELECT-NO-88 TO TRUE DTSCS37 +01148 END-IF DTSCS37 +01149 END-IF DTSCS37 +01150 ELSE DTSCS37 +01151 SET WRK-SELECT-YES-88 TO TRUE DTSCS37 +01152 END-IF. DTSCS37 +01153 DTSCS37 +01154 P7212-EXIT. DTSCS37 +01155 EXIT. DTSCS37 +01156 SKIP3 DTSCS37 +01157 P7800-MPAY-TO-PAGE-LINE. DTSCS37 +01158 IF PAGE-LINE-CNT < LINES-PER-PAGE DTSCS37 +01159 NEXT SENTENCE DTSCS37 +01160 ELSE DTSCS37 +01161 PERFORM P8100-STORE-PAGE-AREA THRU P8100-EXIT DTSCS37 +01162 MOVE +0 TO PAGE-LINE-CNT. DTSCS37 +01163 DTSCS37 +01164 ADD +1 TO PAGE-LINE-CNT. DTSCS37 01165 DTSCS37 -01166 P7900-FIND-MREV. DTSCS37 -01167 MOVE LOW-VALUE TO MREV-REC. DTSCS37 -01168 MOVE MPAY-EMP-NO TO MREV-EMP-NO. DTSCS37 -01169 SET MREV-REV-88 TO TRUE. DTSCS37 -01170 MOVE MPAY-BATCH-NO TO MREV-PA-BATCH-NO. DTSCS37 -01171 MOVE MPAY-ITEM-NO TO MREV-PA-ITEM-NO. DTSCS37 -01172 MOVE MREV-KEY-AREA TO MSKL-KEY-AREA. DTSCS37 -01173 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS37 -01174 DTSCS37 -01175 PERFORM DTSCS37 -01176 UNTIL L810-NO-REC-88 DTSCS37 -01177 MOVE MSKL-REC TO MREV-REC DTSCS37 -01178 PERFORM P7910-MREV-TO-PAGE-LINE THRU P7910-EXIT DTSCS37 -01179 PERFORM S810-READ-NEXT THRU S810-EXIT DTSCS37 -01180 END-PERFORM. DTSCS37 -01181 PERFORM S810-END-BROWSE THRU S810-EXIT. DTSCS37 -01182 DTSCS37 -01183 P7900-EXIT. DTSCS37 -01184 EXIT. DTSCS37 -01185 SKIP3 DTSCS37 -01186 P7910-MREV-TO-PAGE-LINE. DTSCS37 -01187 IF PAGE-LINE-CNT < LINES-PER-PAGE DTSCS37 -01188 NEXT SENTENCE DTSCS37 -01189 ELSE DTSCS37 -01190 PERFORM P8100-STORE-PAGE-AREA THRU P8100-EXIT DTSCS37 -01191 MOVE +0 TO PAGE-LINE-CNT. DTSCS37 -01192 DTSCS37 -01193 ADD +1 TO PAGE-LINE-CNT. DTSCS37 -01194 DTSCS37 -01195 MOVE MREV-EMP-NO TO PAGE-EMP-NO (PAGE-LINE-CNT). DTSCS37 -01196 MOVE MREV-FATE TO PAGE-PAY-TYPE (PAGE-LINE-CNT). DTSCS37 -01197 MOVE MREV-PU-RF-PR-BATCH-NO DTSCS37 -01198 TO PAGE-BATCH-NO (PAGE-LINE-CNT). DTSCS37 -01199 MOVE MREV-PU-RF-PR-ITEM-NO DTSCS37 -01200 TO PAGE-ITEM-NO (PAGE-LINE-CNT). DTSCS37 -01201 MOVE ZERO TO PAGE-TRACE-NO (PAGE-LINE-CNT). DTSCS37 -01202 COMPUTE PAGE-AMT (PAGE-LINE-CNT) = DTSCS37 -01203 (MREV-AMT * -1). DTSCS37 -01204 *& MOVE MPAY-RECEIVED-DATE DTSCS37 -01205 *& TO PAGE-RECEIVED-DATE (PAGE-LINE-CNT). DTSCS37 -01206 MOVE MREV-ESTB-DATE DTSCS37 -01207 TO PAGE-PROCESSED-DATE (PAGE-LINE-CNT). DTSCS37 -01208 DTSCS37 -01209 P7910-EXIT. DTSCS37 -01210 EXIT. DTSCS37 -01211 DTSCS37 -01212 P8100-STORE-PAGE-AREA. DTSCS37 -01213 IF ITEM-CNT < ITEM-MAX-LCCM DTSCS37 -01214 ADD +1 TO ITEM-CNT DTSCS37 -01215 MOVE PAGE-AREA TO LCCM-SCR-HOLD-PAGE-AREA (ITEM-CNT) DTSCS37 -01216 GO TO P8100-EXIT. DTSCS37 -01217 DTSCS37 -01218 IF ITEM-CNT < ITEM-MAX DTSCS37 -01219 ADD +1 TO ITEM-CNT DTSCS37 -01220 MOVE PAGE-AREA TO L829-REC DTSCS37 -01221 PERFORM S829-WRITE THRU S829-EXIT. DTSCS37 -01222 P8100-EXIT. DTSCS37 -01223 EXIT. DTSCS37 -01224 SKIP3 DTSCS37 -01225 P8200-RETREIVE-PAGE-AREA. DTSCS37 -01226 IF ITEM-SUB > ITEM-MAX-LCCM DTSCS37 -01227 COMPUTE L829-ITEM-NO = ITEM-SUB - ITEM-MAX-LCCM DTSCS37 -01228 PERFORM S829-READ-ITEM THRU S829-EXIT DTSCS37 -01229 IF L829-NO-REC-88 DTSCS37 -01230 GO TO S899-ABEND DTSCS37 -01231 ELSE DTSCS37 -01232 MOVE L829-REC TO PAGE-AREA DTSCS37 -01233 ELSE DTSCS37 -01234 MOVE LCCM-SCR-HOLD-PAGE-AREA (ITEM-SUB) TO PAGE-AREA. DTSCS37 -01235 P8200-EXIT. DTSCS37 -01236 EXIT. DTSCS37 -01237 /*****************************************************************DTSCS37 -01238 * LINKS TO UTILITY MODULES DTSCS37 -01239 ******************************************************************DTSCS37 -01240 SKIP1 DTSCS37 -01241 S001-FROM-FED-8. DTSCS37 -01242 SET L001-FROM-FED-8 TO TRUE. DTSCS37 -01243 GO TO S001-DATE. DTSCS37 -01244 SKIP1 DTSCS37 -01245 *S001-FROM-ABS-DATE. DTSCS37 -01246 *****SET L001-FROM-ABS-DAY TO TRUE. DTSCS37 -01247 *****GO TO S001-DATE. DTSCS37 -01248 *****SKIP1 DTSCS37 -01249 S001-DATE. DTSCS37 -01250 EXEC CICS LINK DTSCS37 -01251 PROGRAM('DTSCU001') DTSCS37 -01252 COMMAREA(L001-COMM-AREA) DTSCS37 -01253 END-EXEC. DTSCS37 -01254 S001-EXIT. DTSCS37 -01255 EXIT. DTSCS37 -01256 SKIP3 DTSCS37 -01257 S004-FROM-5. DTSCS37 -01258 SET L004-FROM-5 TO TRUE. DTSCS37 -01259 GO TO S004-QTR. DTSCS37 -01260 SKIP1 DTSCS37 -01261 S004-FROM-ABS. DTSCS37 -01262 SET L004-FROM-ABS TO TRUE. DTSCS37 -01263 GO TO S004-QTR. DTSCS37 -01264 SKIP1 DTSCS37 -01265 S004-QTR. DTSCS37 -01266 EXEC CICS LINK DTSCS37 -01267 PROGRAM('DTSCU004') DTSCS37 -01268 COMMAREA(L004-COMM-AREA) DTSCS37 -01269 END-EXEC. DTSCS37 -01270 S004-EXIT. DTSCS37 -01271 EXIT. DTSCS37 -01272 SKIP3 DTSCS37 -01273 S015-DATE-FROM-SCREEN. DTSCS37 -01274 EXEC CICS LINK DTSCS37 -01275 PROGRAM('DTSCU015') DTSCS37 -01276 COMMAREA(L015-COMM-AREA) DTSCS37 -01277 END-EXEC. DTSCS37 -01278 S015-EXIT. DTSCS37 -01279 EXIT. DTSCS37 -01280 SKIP3 DTSCS37 -01281 S018-EMP-NO-FROM-SCREEN. DTSCS37 -01282 EXEC CICS LINK DTSCS37 -01283 PROGRAM('DTSCU018') DTSCS37 -01284 COMMAREA(L018-COMM-AREA) DTSCS37 -01285 END-EXEC. DTSCS37 -01286 S018-EXIT. DTSCS37 -01287 EXIT. DTSCS37 -01288 SKIP3 DTSCS37 -01289 S803-REQ-SCR-ID-EDIT. DTSCS37 -01290 EXEC CICS LINK DTSCS37 -01291 PROGRAM ('DTSCU803') DTSCS37 -01292 COMMAREA (DFHCOMMAREA) DTSCS37 -01293 END-EXEC. DTSCS37 -01294 S803-EXIT. DTSCS37 -01295 EXIT. DTSCS37 -01296 SKIP3 DTSCS37 -01297 S804-INVALID-KEY. DTSCS37 -01298 EXEC CICS LINK DTSCS37 -01299 PROGRAM ('DTSCU804') DTSCS37 -01300 COMMAREA (DFHCOMMAREA) DTSCS37 -01301 END-EXEC. DTSCS37 -01302 S804-EXIT. DTSCS37 -01303 EXIT. DTSCS37 -01304 SKIP3 DTSCS37 -01305 S805-MSG-AREA. DTSCS37 -01306 MOVE LCCM-MSG-AREA TO L805-MSG-AREA DTSCS37 -01307 SKIP1 DTSCS37 +01166 MOVE MPAY-EMP-NO TO PAGE-EMP-NO (PAGE-LINE-CNT). DTSCS37 +01167 MOVE MPAY-PAY-TYPE TO PAGE-PAY-TYPE (PAGE-LINE-CNT). DTSCS37 +01168 MOVE MPAY-BATCH-NO TO PAGE-BATCH-NO (PAGE-LINE-CNT). DTSCS37 +01169 MOVE MPAY-ITEM-NO TO PAGE-ITEM-NO (PAGE-LINE-CNT). DTSCS37 +01170 MOVE MPAY-TRACE-NO TO PAGE-TRACE-NO (PAGE-LINE-CNT). DTSCS37 +01171 MOVE MPAY-REMIT-AMT DTSCS37 +01172 TO PAGE-AMT (PAGE-LINE-CNT). DTSCS37 +01173 MOVE MPAY-RECEIVED-DATE DTSCS37 +01174 TO PAGE-RECEIVED-DATE (PAGE-LINE-CNT). DTSCS37 +01175 MOVE MPAY-ESTB-DATE DTSCS37 +01176 TO PAGE-PROCESSED-DATE (PAGE-LINE-CNT). DTSCS37 +01177 DTSCS37 +01178 P7800-EXIT. DTSCS37 +01179 EXIT. DTSCS37 +01180 DTSCS37 +01181 P7900-FIND-MREV. DTSCS37 +01182 MOVE LOW-VALUE TO MREV-REC. DTSCS37 +01183 MOVE LOW-VALUE TO MSKL-REC. CL*15 +01184 MOVE MPAY-EMP-NO TO MREV-EMP-NO. DTSCS37 +01185 SET MREV-REV-88 TO TRUE. DTSCS37 +01186 MOVE MPAY-BATCH-NO TO MREV-PA-BATCH-NO. DTSCS37 +01187 MOVE MPAY-ITEM-NO TO MREV-PA-ITEM-NO. DTSCS37 +01188 MOVE MREV-KEY-AREA TO MSKL-KEY-AREA. DTSCS37 +01189 PERFORM S810-START-BROWSE THRU S810-EXIT. DTSCS37 +01190 DTSCS37 +01191 PERFORM DTSCS37 +01192 UNTIL L810-NO-REC-88 CL*21 +01193 MOVE MSKL-REC TO MREV-REC DTSCS37 +01194 IF MREV-PA-DOC-NO = MPAY-DOC-NO CL*24 +01195 PERFORM P7910-MREV-TO-PAGE-LINE THRU P7910-EXIT DTSCS37 +01196 END-IF CL*24 +01197 PERFORM S810-READ-NEXT THRU S810-EXIT CL*24 +01198 END-PERFORM. DTSCS37 +01199 PERFORM S810-END-BROWSE THRU S810-EXIT. DTSCS37 +01200 DTSCS37 +01201 P7900-EXIT. DTSCS37 +01202 EXIT. DTSCS37 +01203 SKIP3 DTSCS37 +01204 P7910-MREV-TO-PAGE-LINE. DTSCS37 +01205 IF PAGE-LINE-CNT < LINES-PER-PAGE DTSCS37 +01206 NEXT SENTENCE DTSCS37 +01207 ELSE DTSCS37 +01208 PERFORM P8100-STORE-PAGE-AREA THRU P8100-EXIT DTSCS37 +01209 MOVE +0 TO PAGE-LINE-CNT. DTSCS37 +01210 DTSCS37 +01211 ADD +1 TO PAGE-LINE-CNT. DTSCS37 +01212 DTSCS37 +01213 MOVE MREV-EMP-NO TO PAGE-EMP-NO (PAGE-LINE-CNT). DTSCS37 +01214 MOVE MREV-FATE TO PAGE-PAY-TYPE (PAGE-LINE-CNT). DTSCS37 +01215 MOVE MREV-PU-RF-PR-BATCH-NO DTSCS37 +01216 TO PAGE-BATCH-NO (PAGE-LINE-CNT). DTSCS37 +01217 MOVE MREV-PU-RF-PR-ITEM-NO DTSCS37 +01218 TO PAGE-ITEM-NO (PAGE-LINE-CNT). DTSCS37 +01219 MOVE ZERO TO PAGE-TRACE-NO (PAGE-LINE-CNT). DTSCS37 +01220 COMPUTE PAGE-AMT (PAGE-LINE-CNT) = DTSCS37 +01221 (MREV-AMT * -1). DTSCS37 +01222 *& MOVE MPAY-RECEIVED-DATE DTSCS37 +01223 *& TO PAGE-RECEIVED-DATE (PAGE-LINE-CNT). DTSCS37 +01224 MOVE MREV-ESTB-DATE DTSCS37 +01225 TO PAGE-PROCESSED-DATE (PAGE-LINE-CNT). DTSCS37 +01226 DTSCS37 +01227 P7910-EXIT. DTSCS37 +01228 EXIT. DTSCS37 +01229 DTSCS37 +01230 P8100-STORE-PAGE-AREA. DTSCS37 +01231 IF ITEM-CNT < ITEM-MAX-LCCM DTSCS37 +01232 ADD +1 TO ITEM-CNT DTSCS37 +01233 MOVE PAGE-AREA TO LCCM-SCR-HOLD-PAGE-AREA (ITEM-CNT) DTSCS37 +01234 GO TO P8100-EXIT. DTSCS37 +01235 DTSCS37 +01236 IF ITEM-CNT < ITEM-MAX DTSCS37 +01237 ADD +1 TO ITEM-CNT DTSCS37 +01238 MOVE PAGE-AREA TO L829-REC DTSCS37 +01239 PERFORM S829-WRITE THRU S829-EXIT. DTSCS37 +01240 P8100-EXIT. DTSCS37 +01241 EXIT. DTSCS37 +01242 SKIP3 DTSCS37 +01243 P8200-RETREIVE-PAGE-AREA. DTSCS37 +01244 IF ITEM-SUB > ITEM-MAX-LCCM DTSCS37 +01245 COMPUTE L829-ITEM-NO = ITEM-SUB - ITEM-MAX-LCCM DTSCS37 +01246 PERFORM S829-READ-ITEM THRU S829-EXIT DTSCS37 +01247 IF L829-NO-REC-88 DTSCS37 +01248 GO TO S899-ABEND DTSCS37 +01249 ELSE DTSCS37 +01250 MOVE L829-REC TO PAGE-AREA DTSCS37 +01251 ELSE DTSCS37 +01252 MOVE LCCM-SCR-HOLD-PAGE-AREA (ITEM-SUB) TO PAGE-AREA. DTSCS37 +01253 P8200-EXIT. DTSCS37 +01254 EXIT. DTSCS37 +01255 /*****************************************************************DTSCS37 +01256 * LINKS TO UTILITY MODULES DTSCS37 +01257 ******************************************************************DTSCS37 +01258 SKIP1 DTSCS37 +01259 S001-FROM-FED-8. DTSCS37 +01260 SET L001-FROM-FED-8 TO TRUE. DTSCS37 +01261 GO TO S001-DATE. DTSCS37 +01262 SKIP1 DTSCS37 +01263 *S001-FROM-ABS-DATE. DTSCS37 +01264 *****SET L001-FROM-ABS-DAY TO TRUE. DTSCS37 +01265 *****GO TO S001-DATE. DTSCS37 +01266 *****SKIP1 DTSCS37 +01267 S001-DATE. DTSCS37 +01268 EXEC CICS LINK DTSCS37 +01269 PROGRAM('DTSCU001') DTSCS37 +01270 COMMAREA(L001-COMM-AREA) DTSCS37 +01271 END-EXEC. DTSCS37 +01272 S001-EXIT. DTSCS37 +01273 EXIT. DTSCS37 +01274 SKIP3 DTSCS37 +01275 S004-FROM-5. DTSCS37 +01276 SET L004-FROM-5 TO TRUE. DTSCS37 +01277 GO TO S004-QTR. DTSCS37 +01278 SKIP1 DTSCS37 +01279 S004-FROM-ABS. DTSCS37 +01280 SET L004-FROM-ABS TO TRUE. DTSCS37 +01281 GO TO S004-QTR. DTSCS37 +01282 SKIP1 DTSCS37 +01283 S004-QTR. DTSCS37 +01284 EXEC CICS LINK DTSCS37 +01285 PROGRAM('DTSCU004') DTSCS37 +01286 COMMAREA(L004-COMM-AREA) DTSCS37 +01287 END-EXEC. DTSCS37 +01288 S004-EXIT. DTSCS37 +01289 EXIT. DTSCS37 +01290 SKIP3 DTSCS37 +01291 S015-DATE-FROM-SCREEN. DTSCS37 +01292 EXEC CICS LINK DTSCS37 +01293 PROGRAM('DTSCU015') DTSCS37 +01294 COMMAREA(L015-COMM-AREA) DTSCS37 +01295 END-EXEC. DTSCS37 +01296 S015-EXIT. DTSCS37 +01297 EXIT. DTSCS37 +01298 SKIP3 DTSCS37 +01299 S018-EMP-NO-FROM-SCREEN. DTSCS37 +01300 EXEC CICS LINK DTSCS37 +01301 PROGRAM('DTSCU018') DTSCS37 +01302 COMMAREA(L018-COMM-AREA) DTSCS37 +01303 END-EXEC. DTSCS37 +01304 S018-EXIT. DTSCS37 +01305 EXIT. DTSCS37 +01306 SKIP3 DTSCS37 +01307 S803-REQ-SCR-ID-EDIT. DTSCS37 01308 EXEC CICS LINK DTSCS37 -01309 PROGRAM ('DTSCU805') DTSCS37 -01310 COMMAREA (L805-COMM-AREA) DTSCS37 +01309 PROGRAM ('DTSCU803') DTSCS37 +01310 COMMAREA (DFHCOMMAREA) DTSCS37 01311 END-EXEC. DTSCS37 -01312 SKIP1 DTSCS37 -01313 MOVE L805-S-MSG-AREA TO MAP-MSG-AREA. DTSCS37 -01314 S805-EXIT. DTSCS37 -01315 EXIT. DTSCS37 -01316 EJECT DTSCS37 -01317 S810-READ. DTSCS37 -01318 SET L810-READ-88 TO TRUE. DTSCS37 -01319 GO TO S810-IO. DTSCS37 -01320 SKIP1 DTSCS37 -01321 S810-START-BROWSE. DTSCS37 -01322 SET L810-START-BROWSE-88 TO TRUE. DTSCS37 -01323 GO TO S810-IO. DTSCS37 -01324 SKIP1 DTSCS37 -01325 S810-READ-NEXT. DTSCS37 -01326 SET L810-READ-NEXT-88 TO TRUE. DTSCS37 -01327 GO TO S810-IO. DTSCS37 -01328 SKIP1 DTSCS37 -01329 S810-READ-PREV. DTSCS37 -01330 SET L810-READ-PREV-88 TO TRUE. DTSCS37 -01331 GO TO S810-IO. DTSCS37 -01332 SKIP1 DTSCS37 -01333 S810-END-BROWSE. DTSCS37 -01334 SET L810-END-BROWSE-88 TO TRUE. DTSCS37 -01335 GO TO S810-IO. DTSCS37 -01336 SKIP1 DTSCS37 -01337 S810-COUNT. DTSCS37 -01338 SET L810-COUNT-88 TO TRUE. DTSCS37 -01339 GO TO S810-IO. DTSCS37 -01340 SKIP1 DTSCS37 -01341 *S810-REWRITE. DTSCS37 -01342 *****SET L810-REWRITE-88 TO TRUE. DTSCS37 -01343 *****GO TO S810-IO. DTSCS37 -01344 *****SKIP1 DTSCS37 -01345 *S810-WRITE. DTSCS37 -01346 *****SET L810-WRITE-88 TO TRUE. DTSCS37 -01347 *****GO TO S810-IO. DTSCS37 -01348 *****SKIP1 DTSCS37 -01349 *S810-DELETE. DTSCS37 -01350 *****SET L810-DELETE-88 TO TRUE. DTSCS37 -01351 *****GO TO S810-IO. DTSCS37 -01352 SKIP1 DTSCS37 -01353 S810-IO. DTSCS37 +01312 S803-EXIT. DTSCS37 +01313 EXIT. DTSCS37 +01314 SKIP3 DTSCS37 +01315 S804-INVALID-KEY. DTSCS37 +01316 EXEC CICS LINK DTSCS37 +01317 PROGRAM ('DTSCU804') DTSCS37 +01318 COMMAREA (DFHCOMMAREA) DTSCS37 +01319 END-EXEC. DTSCS37 +01320 S804-EXIT. DTSCS37 +01321 EXIT. DTSCS37 +01322 SKIP3 DTSCS37 +01323 S805-MSG-AREA. DTSCS37 +01324 MOVE LCCM-MSG-AREA TO L805-MSG-AREA DTSCS37 +01325 SKIP1 DTSCS37 +01326 EXEC CICS LINK DTSCS37 +01327 PROGRAM ('DTSCU805') DTSCS37 +01328 COMMAREA (L805-COMM-AREA) DTSCS37 +01329 END-EXEC. DTSCS37 +01330 SKIP1 DTSCS37 +01331 MOVE L805-S-MSG-AREA TO MAP-MSG-AREA. DTSCS37 +01332 S805-EXIT. DTSCS37 +01333 EXIT. DTSCS37 +01334 EJECT DTSCS37 +01335 S810-READ. DTSCS37 +01336 SET L810-READ-88 TO TRUE. DTSCS37 +01337 GO TO S810-IO. DTSCS37 +01338 SKIP1 DTSCS37 +01339 S810-START-BROWSE. DTSCS37 +01340 SET L810-START-BROWSE-88 TO TRUE. DTSCS37 +01341 GO TO S810-IO. DTSCS37 +01342 SKIP1 DTSCS37 +01343 S810-READ-NEXT. DTSCS37 +01344 SET L810-READ-NEXT-88 TO TRUE. DTSCS37 +01345 GO TO S810-IO. DTSCS37 +01346 SKIP1 DTSCS37 +01347 S810-READ-PREV. DTSCS37 +01348 SET L810-READ-PREV-88 TO TRUE. DTSCS37 +01349 GO TO S810-IO. DTSCS37 +01350 SKIP1 DTSCS37 +01351 S810-END-BROWSE. DTSCS37 +01352 SET L810-END-BROWSE-88 TO TRUE. DTSCS37 +01353 GO TO S810-IO. DTSCS37 01354 SKIP1 DTSCS37 -01355 EXEC CICS LINK DTSCS37 -01356 PROGRAM ('DTSCU810') DTSCS37 -01357 COMMAREA (L810-COMM-AREA) DTSCS37 -01358 END-EXEC. DTSCS37 -01359 SKIP1 DTSCS37 -01360 IF L810-FILE-CLOSED-88 DTSCS37 -01361 MOVE L810-MSG-AREA TO LCCM-MSG-AREA DTSCS37 -01362 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS37 -01363 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS37 -01364 GO TO MAINLINE-EXIT. DTSCS37 -01365 S810-EXIT. DTSCS37 -01366 EXIT. DTSCS37 -01367 EJECT DTSCS37 -01368 S821-START-BROWSE. DTSCS37 -01369 SET L821-START-BROWSE-88 TO TRUE. DTSCS37 -01370 GO TO S821-AIX-IO. DTSCS37 -01371 SKIP1 DTSCS37 -01372 S821-READ-NEXT. DTSCS37 -01373 SET L821-READ-NEXT-88 TO TRUE. DTSCS37 -01374 GO TO S821-AIX-IO. DTSCS37 -01375 SKIP1 DTSCS37 -01376 S821-READ-PREV. DTSCS37 -01377 SET L821-READ-PREV-88 TO TRUE. DTSCS37 -01378 GO TO S821-AIX-IO. DTSCS37 -01379 SKIP1 DTSCS37 -01380 S821-END-BROWSE. DTSCS37 -01381 SET L821-END-BROWSE-88 TO TRUE. DTSCS37 -01382 GO TO S821-AIX-IO. DTSCS37 -01383 SKIP1 DTSCS37 -01384 SKIP1 DTSCS37 -01385 S821-AIX-IO. DTSCS37 -01386 SKIP1 DTSCS37 -01387 EXEC CICS LINK DTSCS37 -01388 PROGRAM ('DTSCU821') DTSCS37 -01389 COMMAREA (L821-COMM-AREA) DTSCS37 -01390 END-EXEC. DTSCS37 -01391 SKIP1 DTSCS37 -01392 IF L821-FILE-CLOSED-88 DTSCS37 -01393 MOVE L821-MSG-AREA TO LCCM-MSG-AREA DTSCS37 -01394 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS37 -01395 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS37 -01396 GO TO MAINLINE-EXIT. DTSCS37 -01397 S821-EXIT. DTSCS37 -01398 EXIT. DTSCS37 -01399 EJECT DTSCS37 -01400 S829-READ-ITEM. DTSCS37 -01401 SET L829-READ-ITEM-88 TO TRUE. DTSCS37 -01402 GO TO S829-IO. DTSCS37 -01403 DTSCS37 -01404 S829-WRITE. DTSCS37 -01405 SET L829-WRITE-88 TO TRUE. DTSCS37 -01406 GO TO S829-IO. DTSCS37 -01407 DTSCS37 -01408 S829-DELETE-QUEUE. DTSCS37 -01409 SET L829-DELETE-QUEUE-88 TO TRUE. DTSCS37 -01410 GO TO S829-IO. DTSCS37 -01411 DTSCS37 -01412 S829-IO. DTSCS37 -01413 * COMPUTE L829-COMM-AREA-LENGTH DTSCS37 -01414 * = L829-CONTROL-BLOCK-LENGTH + ITEM-LENGTH. DTSCS37 -01415 MOVE LCCM-TS-NAME-PREFIX TO L829-QUEUE-NAME-PREFIX. DTSCS37 -01416 MOVE 'S' TO L829-QUEUE-NAME-SUFFIX. DTSCS37 -01417 MOVE ITEM-LENGTH TO L829-REC-LENGTH. DTSCS37 -01418 SET L829-DEFAULT-STORAGE-88 TO TRUE. DTSCS37 -01419 DTSCS37 -01420 EXEC CICS DTSCS37 -01421 LINK DTSCS37 -01422 PROGRAM ('DTSCU829') DTSCS37 -01423 COMMAREA (L829-COMM-AREA) DTSCS37 -01424 END-EXEC. DTSCS37 -01425 S829-EXIT. DTSCS37 -01426 EXIT. DTSCS37 -01427 EJECT DTSCS37 -01428 S851-SCREEN-PROCESSING. DTSCS37 -01429 EXEC CICS LINK DTSCS37 -01430 PROGRAM ('DTSCU851') DTSCS37 -01431 COMMAREA (L851-COMM-AREA) DTSCS37 -01432 END-EXEC. DTSCS37 -01433 S851-EXIT. DTSCS37 -01434 EXIT. DTSCS37 -01435 SKIP3 DTSCS37 -01436 S899-ABEND. DTSCS37 -01437 EXEC CICS ABEND DTSCS37 -01438 ABCODE(WRK-ABEND-CD) DTSCS37 -01439 END-EXEC. DTSCS37 -01440 S899-EXIT. DTSCS37 -01441 EXIT. DTSCS37 -01442 EJECT DTSCS37 -01443 S1100-EDIT-KEY. DTSCS37 -01444 PERFORM S1101-TRACE-NO THRU S1101-EXIT. DTSCS37 -01445 PERFORM S1102-EMP-NO THRU S1102-EXIT. DTSCS37 -01446 PERFORM S1103-DATE1 THRU S1103-EXIT. DTSCS37 -01447 PERFORM S1104-DATE2 THRU S1104-EXIT. DTSCS37 -01448 DTSCS37 -01449 IF WRK-TRACE-NO = ZERO DTSCS37 -01450 AND WRK-EMP-NO = ZERO DTSCS37 -01451 MOVE MSG-E371-AREA TO WRK-MSG-AREA DTSCS37 -01452 PERFORM S1101A-ERROR THRU S1101A-EXIT. DTSCS37 -01453 S1100-EXIT. EXIT. DTSCS37 -01454 /*****************************************************************DTSCS37 -01455 * DTSCS37 -01456 ******************************************************************DTSCS37 -01457 S1101-TRACE-NO. DTSCS37 -01458 SET WRK-TRACE-NO-NULL-88 TO TRUE. DTSCS37 -01459 MOVE ZERO TO WRK-TRACE-NO-OUT. DTSCS37 -01460 MOVE +14 TO OUT-SUB. DTSCS37 -01461 DTSCS37 -01462 INSPECT MAP-SRCH-TRACE-NO DTSCS37 -01463 CONVERTING LOW-VALUE TO SPACE. DTSCS37 -01464 IF MAP-SRCH-TRACE-NO = SPACES DTSCS37 -01465 GO TO S1101-EXIT DTSCS37 -01466 ELSE DTSCS37 -01467 MOVE MAP-SRCH-TRACE-NO TO WRK-TRACE-NO-IN. DTSCS37 -01468 DTSCS37 -01469 PERFORM DTSCS37 -01470 VARYING IN-SUB FROM +13 BY -1 DTSCS37 -01471 UNTIL IN-SUB < +1 DTSCS37 -01472 IF WRK-TRACE-NO-IN (IN-SUB : 1) NUMERIC DTSCS37 -01473 SUBTRACT +1 FROM OUT-SUB DTSCS37 -01474 MOVE WRK-TRACE-NO-IN (IN-SUB : 1) TO DTSCS37 -01475 WRK-TRACE-NO-OUT (OUT-SUB : 1) DTSCS37 -01476 ELSE DTSCS37 -01477 IF OUT-SUB < +14 DTSCS37 -01478 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS37 -01479 PERFORM S1101A-ERROR THRU S1101A-EXIT DTSCS37 -01480 GO TO S1101-EXIT DTSCS37 -01481 END-IF DTSCS37 -01482 END-IF DTSCS37 -01483 END-PERFORM. DTSCS37 -01484 DTSCS37 -01485 IF WRK-TRACE-NO > ZERO DTSCS37 -01486 SET WRK-TRACE-NO-ENTERED-88 TO TRUE. DTSCS37 -01487 DTSCS37 -01488 S1101-EXIT. EXIT. DTSCS37 -01489 SKIP3 DTSCS37 -01490 S1101A-ERROR. DTSCS37 -01491 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-SRCH-TRACE-NO-A. DTSCS37 -01492 DTSCS37 -01493 IF LCCM-NO-MSG DTSCS37 -01494 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS37 -01495 MOVE CATB-CURSOR TO MAP-SRCH-TRACE-NO-L DTSCS37 -01496 SET CURSOR-SET-YES TO TRUE. DTSCS37 -01497 S1101A-EXIT. EXIT. DTSCS37 -01498 DTSCS37 -01499 S1102-EMP-NO. DTSCS37 -01500 MOVE ZERO TO WRK-EMP-NO. DTSCS37 -01501 DTSCS37 -01502 MOVE MAP-SEARCH-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS37 -01503 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS37 -01504 DTSCS37 -01505 IF L018-NO-ENTRY DTSCS37 -01506 IF WRK-TRACE-NO-NULL-88 DTSCS37 -01507 MOVE MSG-E371-AREA TO WRK-MSG-AREA DTSCS37 -01508 PERFORM S1102A-ERROR THRU S1102A-EXIT DTSCS37 -01509 GO TO S1102-EXIT DTSCS37 -01510 ELSE DTSCS37 -01511 GO TO S1102-EXIT DTSCS37 -01512 END-IF DTSCS37 -01513 ELSE DTSCS37 -01514 IF WRK-TRACE-NO-ENTERED-88 DTSCS37 -01515 MOVE MSG-E374-AREA TO WRK-MSG-AREA DTSCS37 -01516 PERFORM S1102A-ERROR THRU S1102A-EXIT DTSCS37 -01517 GO TO S1102-EXIT DTSCS37 -01518 END-IF DTSCS37 -01519 END-IF. DTSCS37 -01520 DTSCS37 -01521 IF L018-NOT-VALID DTSCS37 -01522 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS37 -01523 PERFORM S1102A-ERROR THRU S1102A-EXIT DTSCS37 -01524 GO TO S1102-EXIT DTSCS37 -01525 ELSE DTSCS37 -01526 MOVE L018-EMP-NO TO WRK-EMP-NO DTSCS37 -01527 PERFORM S1110-READ-MPRF THRU S1110-EXIT. DTSCS37 -01528 DTSCS37 -01529 S1102-EXIT. EXIT. DTSCS37 -01530 SKIP3 DTSCS37 -01531 DTSCS37 -01532 S1102A-ERROR. DTSCS37 -01533 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-SRCH-EMP-NO-1-A DTSCS37 -01534 MAP-SRCH-EMP-NO-2-A. DTSCS37 -01535 IF LCCM-NO-MSG DTSCS37 -01536 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS37 -01537 MOVE CATB-CURSOR TO MAP-SRCH-EMP-NO-1-L DTSCS37 -01538 SET CURSOR-SET-YES TO TRUE. DTSCS37 -01539 S1102A-EXIT. EXIT. DTSCS37 -01540 DTSCS37 -01541 S1103-DATE1. DTSCS37 -01542 MOVE ZERO TO WRK-DATE1. DTSCS37 -01543 DTSCS37 -01544 MOVE MAP-SEARCH-DATE1-AREA TO L015-S-DATE-AREA. DTSCS37 -01545 DTSCS37 -01546 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS37 -01547 IF L015-NO-ENTRY DTSCS37 -01548 GO TO S1103-EXIT DTSCS37 -01549 ELSE DTSCS37 -01550 IF WRK-EMP-NO = ZERO DTSCS37 -01551 MOVE MSG-E373-AREA TO WRK-MSG-AREA DTSCS37 -01552 PERFORM S1103A-ERROR THRU S1103A-EXIT DTSCS37 -01553 GO TO S1103-EXIT DTSCS37 -01554 ELSE DTSCS37 -01555 IF L015-NOT-VALID DTSCS37 -01556 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS37 -01557 PERFORM S1103A-ERROR THRU S1103A-EXIT DTSCS37 -01558 GO TO S1103-EXIT DTSCS37 -01559 ELSE DTSCS37 -01560 MOVE L015-DATE TO WRK-DATE1 DTSCS37 -01561 END-IF DTSCS37 -01562 END-IF DTSCS37 -01563 END-IF. DTSCS37 -01564 DTSCS37 -01565 S1103-EXIT. EXIT. DTSCS37 -01566 SKIP3 DTSCS37 -01567 S1103A-ERROR. DTSCS37 -01568 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-SRCH-DATE1-MO-A. DTSCS37 -01569 DTSCS37 -01570 IF LCCM-NO-MSG DTSCS37 -01571 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS37 -01572 MOVE CATB-CURSOR TO MAP-SRCH-DATE1-MO-L DTSCS37 -01573 SET CURSOR-SET-YES TO TRUE. DTSCS37 -01574 S1103A-EXIT. EXIT. DTSCS37 -01575 DTSCS37 -01576 S1104-DATE2. DTSCS37 -01577 MOVE ZERO TO WRK-DATE2. DTSCS37 -01578 DTSCS37 -01579 MOVE MAP-SEARCH-DATE2-AREA TO L015-S-DATE-AREA. DTSCS37 -01580 DTSCS37 -01581 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS37 -01582 IF L015-NO-ENTRY DTSCS37 -01583 GO TO S1104-EXIT DTSCS37 -01584 ELSE DTSCS37 -01585 IF WRK-EMP-NO = ZERO DTSCS37 -01586 MOVE MSG-E373-AREA TO WRK-MSG-AREA DTSCS37 -01587 PERFORM S1104A-ERROR THRU S1104A-EXIT DTSCS37 -01588 GO TO S1104-EXIT DTSCS37 -01589 ELSE DTSCS37 -01590 IF L015-NOT-VALID DTSCS37 -01591 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS37 -01592 PERFORM S1104A-ERROR THRU S1104A-EXIT DTSCS37 -01593 GO TO S1104-EXIT DTSCS37 -01594 ELSE DTSCS37 -01595 MOVE L015-DATE TO WRK-DATE2 DTSCS37 -01596 END-IF DTSCS37 -01597 END-IF DTSCS37 -01598 END-IF. DTSCS37 -01599 DTSCS37 -01600 S1104-EXIT. EXIT. DTSCS37 -01601 SKIP3 DTSCS37 -01602 S1104A-ERROR. DTSCS37 -01603 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-SRCH-DATE2-MO-A. DTSCS37 -01604 DTSCS37 -01605 IF LCCM-NO-MSG DTSCS37 -01606 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS37 -01607 MOVE CATB-CURSOR TO MAP-SRCH-DATE2-MO-L DTSCS37 -01608 SET CURSOR-SET-YES TO TRUE. DTSCS37 -01609 S1104A-EXIT. EXIT. DTSCS37 -01610 DTSCS37 -01611 S1110-READ-MPRF. DTSCS37 -01612 MOVE LOW-VALUES TO MPRF-KEY-AREA. DTSCS37 -01613 MOVE WRK-EMP-NO TO MPRF-EMP-NO. DTSCS37 -01614 SET MPRF-PRF-88 TO TRUE. DTSCS37 -01615 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSCS37 -01616 PERFORM S810-READ THRU S810-EXIT. DTSCS37 -01617 IF L810-NO-REC-88 DTSCS37 -01618 MOVE EMSG-NO-EMPLOYER TO WRK-MSG-AREA DTSCS37 -01619 PERFORM S1102A-ERROR THRU S1102A-EXIT DTSCS37 -01620 ELSE DTSCS37 -01621 MOVE MSKL-REC TO MPRF-REC DTSCS37 -01622 SET WRK-MPRF-YES-88 TO TRUE DTSCS37 -01623 MOVE WRK-EMP-NO TO LCCM-EMP-NO. DTSCS37 -01624 S1110-EXIT. DTSCS37 -01625 EXIT. DTSCS37 -01626 /*****************************************************************DTSCS37 -01627 * SET ATTRIBUTE BYTES FOR INQUIRY STATUS *DTSCS37 -01628 ******************************************************************DTSCS37 -01629 S5300-SET-INQ-ATTRB. DTSCS37 -01630 MOVE CATB-ASKIP-BRT-MDTOFF TO WRK-ATB-AN DTSCS37 -01631 WRK-ATB-NUM. DTSCS37 -01632 DTSCS37 -01633 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS37 -01634 S5300-EXIT. DTSCS37 -01635 EXIT. DTSCS37 -01636 SKIP3 DTSCS37 -01637 S5900-SET-ATTRB. DTSCS37 -01638 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-SRCH-TRACE-NO-A DTSCS37 -01639 MAP-SRCH-TRACE-NO-A DTSCS37 -01640 MAP-SRCH-EMP-NO-1-A DTSCS37 -01641 MAP-SRCH-EMP-NO-2-A DTSCS37 -01642 MAP-SRCH-DATE1-MO-A DTSCS37 -01643 MAP-SRCH-DATE1-DA-A DTSCS37 -01644 MAP-SRCH-DATE1-YR-A DTSCS37 -01645 MAP-SRCH-DATE2-MO-A DTSCS37 -01646 MAP-SRCH-DATE2-DA-A DTSCS37 -01647 MAP-SRCH-DATE2-YR-A. DTSCS37 -01648 DTSCS37 -01649 DTSCS37 -01650 PERFORM DTSCS37 -01651 VARYING LINE-OCC FROM 1 BY 1 DTSCS37 -01652 UNTIL LINE-OCC > LINES-PER-PAGE DTSCS37 -01653 MOVE CATB-ASKIP-BRT-MDTOFF DTSCS37 -01654 TO MAP-LINE-A (LINE-OCC) DTSCS37 -01655 END-PERFORM. DTSCS37 -01656 DTSCS37 -01657 MOVE CATB-UNPROT-BRT-AN-MDTOFF TO MAP-GOTO-A. DTSCS37 -01658 S5900-EXIT. DTSCS37 -01659 EXIT. DTSCS37 -01660 /*****************************************************************DTSCS37 -01661 * MAP ROUTINES *DTSCS37 -01662 ******************************************************************DTSCS37 -01663 S9100-RECEIVE. DTSCS37 -01664 SET L851-RECEIVE-88 TO TRUE. DTSCS37 -01665 SKIP1 DTSCS37 -01666 MOVE WRK-SCR-ID TO L851-SCR-ID. DTSCS37 -01667 SKIP1 DTSCS37 -01668 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS37 -01669 SKIP1 DTSCS37 -01670 MOVE L851-AID TO LCCM-AID. DTSCS37 -01671 MOVE L851-CURSOR TO LCCM-CURSOR. DTSCS37 -01672 S9100-EXIT. DTSCS37 -01673 EXIT. DTSCS37 -01674 SKIP3 DTSCS37 -01675 S9200-SEND-DATAONLY. DTSCS37 -01676 MOVE LOW-VALUES TO MAP-AREA. DTSCS37 -01677 SKIP1 DTSCS37 -01678 IF LCCM-NO-MSG DTSCS37 -01679 NEXT SENTENCE DTSCS37 -01680 ELSE DTSCS37 -01681 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS37 -01682 SKIP1 DTSCS37 -01683 IF CURSOR-SET-GOTO DTSCS37 -01684 MOVE CATB-CURSOR TO MAP-GOTO-L DTSCS37 -01685 ELSE DTSCS37 -01686 MOVE CATB-CURSOR TO MAP-SRCH-TRACE-NO-L. DTSCS37 -01687 SKIP1 DTSCS37 -01688 SET L851-SEND-DATAONLY-88 TO TRUE. DTSCS37 -01689 SKIP1 DTSCS37 -01690 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS37 -01691 SKIP1 DTSCS37 -01692 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS37 -01693 S9200-EXIT. DTSCS37 -01694 EXIT. DTSCS37 -01695 SKIP3 DTSCS37 -01696 S9300-SEND-MAP. DTSCS37 -01697 MOVE LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE. DTSCS37 -01698 MOVE LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME. DTSCS37 -01699 MOVE LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME. DTSCS37 -01700 SKIP1 DTSCS37 -01701 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS37 -01702 SKIP1 DTSCS37 -01703 PERFORM S9330-DSCR-FIELDS THRU S9330-EXIT. DTSCS37 -01704 SKIP1 DTSCS37 -01705 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS37 +01355 S810-COUNT. DTSCS37 +01356 SET L810-COUNT-88 TO TRUE. DTSCS37 +01357 GO TO S810-IO. DTSCS37 +01358 SKIP1 DTSCS37 +01359 *S810-REWRITE. DTSCS37 +01360 *****SET L810-REWRITE-88 TO TRUE. DTSCS37 +01361 *****GO TO S810-IO. DTSCS37 +01362 *****SKIP1 DTSCS37 +01363 *S810-WRITE. DTSCS37 +01364 *****SET L810-WRITE-88 TO TRUE. DTSCS37 +01365 *****GO TO S810-IO. DTSCS37 +01366 *****SKIP1 DTSCS37 +01367 *S810-DELETE. DTSCS37 +01368 *****SET L810-DELETE-88 TO TRUE. DTSCS37 +01369 *****GO TO S810-IO. DTSCS37 +01370 SKIP1 DTSCS37 +01371 S810-IO. DTSCS37 +01372 SKIP1 DTSCS37 +01373 EXEC CICS LINK DTSCS37 +01374 PROGRAM ('DTSCU810') DTSCS37 +01375 COMMAREA (L810-COMM-AREA) DTSCS37 +01376 END-EXEC. DTSCS37 +01377 SKIP1 DTSCS37 +01378 IF L810-FILE-CLOSED-88 DTSCS37 +01379 MOVE L810-MSG-AREA TO LCCM-MSG-AREA DTSCS37 +01380 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS37 +01381 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS37 +01382 GO TO MAINLINE-EXIT. DTSCS37 +01383 S810-EXIT. DTSCS37 +01384 EXIT. DTSCS37 +01385 EJECT DTSCS37 +01386 S821-START-BROWSE. DTSCS37 +01387 SET L821-START-BROWSE-88 TO TRUE. DTSCS37 +01388 GO TO S821-AIX-IO. DTSCS37 +01389 SKIP1 DTSCS37 +01390 S821-READ-NEXT. DTSCS37 +01391 SET L821-READ-NEXT-88 TO TRUE. DTSCS37 +01392 GO TO S821-AIX-IO. DTSCS37 +01393 SKIP1 DTSCS37 +01394 S821-READ-PREV. DTSCS37 +01395 SET L821-READ-PREV-88 TO TRUE. DTSCS37 +01396 GO TO S821-AIX-IO. DTSCS37 +01397 SKIP1 DTSCS37 +01398 S821-END-BROWSE. DTSCS37 +01399 SET L821-END-BROWSE-88 TO TRUE. DTSCS37 +01400 GO TO S821-AIX-IO. DTSCS37 +01401 SKIP1 DTSCS37 +01402 SKIP1 DTSCS37 +01403 S821-AIX-IO. DTSCS37 +01404 SKIP1 DTSCS37 +01405 EXEC CICS LINK DTSCS37 +01406 PROGRAM ('DTSCU821') DTSCS37 +01407 COMMAREA (L821-COMM-AREA) DTSCS37 +01408 END-EXEC. DTSCS37 +01409 SKIP1 DTSCS37 +01410 IF L821-FILE-CLOSED-88 DTSCS37 +01411 MOVE L821-MSG-AREA TO LCCM-MSG-AREA DTSCS37 +01412 SET LCCM-REQ-SCR-SF-88 TO TRUE DTSCS37 +01413 SET LCCM-LINK-SCREEN-88 TO TRUE DTSCS37 +01414 GO TO MAINLINE-EXIT. DTSCS37 +01415 S821-EXIT. DTSCS37 +01416 EXIT. DTSCS37 +01417 EJECT DTSCS37 +01418 S829-READ-ITEM. DTSCS37 +01419 SET L829-READ-ITEM-88 TO TRUE. DTSCS37 +01420 GO TO S829-IO. DTSCS37 +01421 DTSCS37 +01422 S829-WRITE. DTSCS37 +01423 SET L829-WRITE-88 TO TRUE. DTSCS37 +01424 GO TO S829-IO. DTSCS37 +01425 DTSCS37 +01426 S829-DELETE-QUEUE. DTSCS37 +01427 SET L829-DELETE-QUEUE-88 TO TRUE. DTSCS37 +01428 GO TO S829-IO. DTSCS37 +01429 DTSCS37 +01430 S829-IO. DTSCS37 +01431 * COMPUTE L829-COMM-AREA-LENGTH DTSCS37 +01432 * = L829-CONTROL-BLOCK-LENGTH + ITEM-LENGTH. DTSCS37 +01433 MOVE LCCM-TS-NAME-PREFIX TO L829-QUEUE-NAME-PREFIX. DTSCS37 +01434 MOVE 'S' TO L829-QUEUE-NAME-SUFFIX. DTSCS37 +01435 MOVE ITEM-LENGTH TO L829-REC-LENGTH. DTSCS37 +01436 SET L829-DEFAULT-STORAGE-88 TO TRUE. DTSCS37 +01437 DTSCS37 +01438 EXEC CICS DTSCS37 +01439 LINK DTSCS37 +01440 PROGRAM ('DTSCU829') DTSCS37 +01441 COMMAREA (L829-COMM-AREA) DTSCS37 +01442 END-EXEC. DTSCS37 +01443 S829-EXIT. DTSCS37 +01444 EXIT. DTSCS37 +01445 EJECT DTSCS37 +01446 S851-SCREEN-PROCESSING. DTSCS37 +01447 EXEC CICS LINK DTSCS37 +01448 PROGRAM ('DTSCU851') DTSCS37 +01449 COMMAREA (L851-COMM-AREA) DTSCS37 +01450 END-EXEC. DTSCS37 +01451 S851-EXIT. DTSCS37 +01452 EXIT. DTSCS37 +01453 SKIP3 DTSCS37 +01454 S899-ABEND. DTSCS37 +01455 EXEC CICS ABEND DTSCS37 +01456 ABCODE(WRK-ABEND-CD) DTSCS37 +01457 END-EXEC. DTSCS37 +01458 S899-EXIT. DTSCS37 +01459 EXIT. DTSCS37 +01460 EJECT DTSCS37 +01461 S1100-EDIT-KEY. DTSCS37 +01462 PERFORM S1101-TRACE-NO THRU S1101-EXIT. DTSCS37 +01463 PERFORM S1102-EMP-NO THRU S1102-EXIT. DTSCS37 +01464 PERFORM S1103-DATE1 THRU S1103-EXIT. DTSCS37 +01465 PERFORM S1104-DATE2 THRU S1104-EXIT. DTSCS37 +01466 DTSCS37 +01467 IF WRK-TRACE-NO = ZERO DTSCS37 +01468 AND WRK-EMP-NO = ZERO DTSCS37 +01469 MOVE MSG-E371-AREA TO WRK-MSG-AREA DTSCS37 +01470 PERFORM S1101A-ERROR THRU S1101A-EXIT. DTSCS37 +01471 S1100-EXIT. EXIT. DTSCS37 +01472 /*****************************************************************DTSCS37 +01473 * DTSCS37 +01474 ******************************************************************DTSCS37 +01475 S1101-TRACE-NO. DTSCS37 +01476 SET WRK-TRACE-NO-NULL-88 TO TRUE. DTSCS37 +01477 MOVE ZERO TO WRK-TRACE-NO-OUT. DTSCS37 +01478 MOVE +14 TO OUT-SUB. DTSCS37 +01479 DTSCS37 +01480 INSPECT MAP-SRCH-TRACE-NO DTSCS37 +01481 CONVERTING LOW-VALUE TO SPACE. DTSCS37 +01482 IF MAP-SRCH-TRACE-NO = SPACES DTSCS37 +01483 GO TO S1101-EXIT DTSCS37 +01484 ELSE DTSCS37 +01485 MOVE MAP-SRCH-TRACE-NO TO WRK-TRACE-NO-IN. DTSCS37 +01486 DTSCS37 +01487 PERFORM DTSCS37 +01488 VARYING IN-SUB FROM +13 BY -1 DTSCS37 +01489 UNTIL IN-SUB < +1 DTSCS37 +01490 IF WRK-TRACE-NO-IN (IN-SUB : 1) NUMERIC DTSCS37 +01491 SUBTRACT +1 FROM OUT-SUB DTSCS37 +01492 MOVE WRK-TRACE-NO-IN (IN-SUB : 1) TO DTSCS37 +01493 WRK-TRACE-NO-OUT (OUT-SUB : 1) DTSCS37 +01494 ELSE DTSCS37 +01495 IF OUT-SUB < +14 DTSCS37 +01496 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS37 +01497 PERFORM S1101A-ERROR THRU S1101A-EXIT DTSCS37 +01498 GO TO S1101-EXIT DTSCS37 +01499 END-IF DTSCS37 +01500 END-IF DTSCS37 +01501 END-PERFORM. DTSCS37 +01502 DTSCS37 +01503 IF WRK-TRACE-NO > ZERO DTSCS37 +01504 SET WRK-TRACE-NO-ENTERED-88 TO TRUE. DTSCS37 +01505 DTSCS37 +01506 S1101-EXIT. EXIT. DTSCS37 +01507 SKIP3 DTSCS37 +01508 S1101A-ERROR. DTSCS37 +01509 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-SRCH-TRACE-NO-A. DTSCS37 +01510 DTSCS37 +01511 IF LCCM-NO-MSG DTSCS37 +01512 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS37 +01513 MOVE CATB-CURSOR TO MAP-SRCH-TRACE-NO-L DTSCS37 +01514 SET CURSOR-SET-YES TO TRUE. DTSCS37 +01515 S1101A-EXIT. EXIT. DTSCS37 +01516 DTSCS37 +01517 S1102-EMP-NO. DTSCS37 +01518 MOVE ZERO TO WRK-EMP-NO. DTSCS37 +01519 DTSCS37 +01520 MOVE MAP-SEARCH-EMP-NO-AREA TO L018-S-EMP-NO-AREA. DTSCS37 +01521 PERFORM S018-EMP-NO-FROM-SCREEN THRU S018-EXIT. DTSCS37 +01522 DTSCS37 +01523 IF L018-NO-ENTRY DTSCS37 +01524 IF WRK-TRACE-NO-NULL-88 DTSCS37 +01525 MOVE MSG-E371-AREA TO WRK-MSG-AREA DTSCS37 +01526 PERFORM S1102A-ERROR THRU S1102A-EXIT DTSCS37 +01527 GO TO S1102-EXIT DTSCS37 +01528 ELSE DTSCS37 +01529 GO TO S1102-EXIT DTSCS37 +01530 END-IF DTSCS37 +01531 ELSE DTSCS37 +01532 IF WRK-TRACE-NO-ENTERED-88 DTSCS37 +01533 MOVE MSG-E374-AREA TO WRK-MSG-AREA DTSCS37 +01534 PERFORM S1102A-ERROR THRU S1102A-EXIT DTSCS37 +01535 GO TO S1102-EXIT DTSCS37 +01536 END-IF DTSCS37 +01537 END-IF. DTSCS37 +01538 DTSCS37 +01539 IF L018-NOT-VALID DTSCS37 +01540 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS37 +01541 PERFORM S1102A-ERROR THRU S1102A-EXIT DTSCS37 +01542 GO TO S1102-EXIT DTSCS37 +01543 ELSE DTSCS37 +01544 MOVE L018-EMP-NO TO WRK-EMP-NO DTSCS37 +01545 PERFORM S1110-READ-MPRF THRU S1110-EXIT. DTSCS37 +01546 DTSCS37 +01547 S1102-EXIT. EXIT. DTSCS37 +01548 SKIP3 DTSCS37 +01549 DTSCS37 +01550 S1102A-ERROR. DTSCS37 +01551 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-SRCH-EMP-NO-1-A DTSCS37 +01552 MAP-SRCH-EMP-NO-2-A. DTSCS37 +01553 IF LCCM-NO-MSG DTSCS37 +01554 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS37 +01555 MOVE CATB-CURSOR TO MAP-SRCH-EMP-NO-1-L DTSCS37 +01556 SET CURSOR-SET-YES TO TRUE. DTSCS37 +01557 S1102A-EXIT. EXIT. DTSCS37 +01558 DTSCS37 +01559 S1103-DATE1. DTSCS37 +01560 MOVE ZERO TO WRK-DATE1. DTSCS37 +01561 DTSCS37 +01562 MOVE MAP-SEARCH-DATE1-AREA TO L015-S-DATE-AREA. DTSCS37 +01563 DTSCS37 +01564 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS37 +01565 IF L015-NO-ENTRY DTSCS37 +01566 GO TO S1103-EXIT DTSCS37 +01567 ELSE DTSCS37 +01568 IF WRK-EMP-NO = ZERO DTSCS37 +01569 MOVE MSG-E373-AREA TO WRK-MSG-AREA DTSCS37 +01570 PERFORM S1103A-ERROR THRU S1103A-EXIT DTSCS37 +01571 GO TO S1103-EXIT DTSCS37 +01572 ELSE DTSCS37 +01573 IF L015-NOT-VALID DTSCS37 +01574 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS37 +01575 PERFORM S1103A-ERROR THRU S1103A-EXIT DTSCS37 +01576 GO TO S1103-EXIT DTSCS37 +01577 ELSE DTSCS37 +01578 MOVE L015-DATE TO WRK-DATE1 DTSCS37 +01579 END-IF DTSCS37 +01580 END-IF DTSCS37 +01581 END-IF. DTSCS37 +01582 DTSCS37 +01583 S1103-EXIT. EXIT. DTSCS37 +01584 SKIP3 DTSCS37 +01585 S1103A-ERROR. DTSCS37 +01586 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-SRCH-DATE1-MO-A. DTSCS37 +01587 DTSCS37 +01588 IF LCCM-NO-MSG DTSCS37 +01589 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS37 +01590 MOVE CATB-CURSOR TO MAP-SRCH-DATE1-MO-L DTSCS37 +01591 SET CURSOR-SET-YES TO TRUE. DTSCS37 +01592 S1103A-EXIT. EXIT. DTSCS37 +01593 DTSCS37 +01594 S1104-DATE2. DTSCS37 +01595 MOVE ZERO TO WRK-DATE2. DTSCS37 +01596 DTSCS37 +01597 MOVE MAP-SEARCH-DATE2-AREA TO L015-S-DATE-AREA. DTSCS37 +01598 DTSCS37 +01599 PERFORM S015-DATE-FROM-SCREEN THRU S015-EXIT. DTSCS37 +01600 IF L015-NO-ENTRY DTSCS37 +01601 GO TO S1104-EXIT DTSCS37 +01602 ELSE DTSCS37 +01603 IF WRK-EMP-NO = ZERO DTSCS37 +01604 MOVE MSG-E373-AREA TO WRK-MSG-AREA DTSCS37 +01605 PERFORM S1104A-ERROR THRU S1104A-EXIT DTSCS37 +01606 GO TO S1104-EXIT DTSCS37 +01607 ELSE DTSCS37 +01608 IF L015-NOT-VALID DTSCS37 +01609 MOVE EMSG-FIELD-NOT-VALID TO WRK-MSG-AREA DTSCS37 +01610 PERFORM S1104A-ERROR THRU S1104A-EXIT DTSCS37 +01611 GO TO S1104-EXIT DTSCS37 +01612 ELSE DTSCS37 +01613 MOVE L015-DATE TO WRK-DATE2 DTSCS37 +01614 END-IF DTSCS37 +01615 END-IF DTSCS37 +01616 END-IF. DTSCS37 +01617 DTSCS37 +01618 S1104-EXIT. EXIT. DTSCS37 +01619 SKIP3 DTSCS37 +01620 S1104A-ERROR. DTSCS37 +01621 MOVE CATB-UNPROT-NORM-NUM-MDTON TO MAP-SRCH-DATE2-MO-A. DTSCS37 +01622 DTSCS37 +01623 IF LCCM-NO-MSG DTSCS37 +01624 MOVE WRK-MSG-AREA TO LCCM-MSG-AREA DTSCS37 +01625 MOVE CATB-CURSOR TO MAP-SRCH-DATE2-MO-L DTSCS37 +01626 SET CURSOR-SET-YES TO TRUE. DTSCS37 +01627 S1104A-EXIT. EXIT. DTSCS37 +01628 DTSCS37 +01629 S1110-READ-MPRF. DTSCS37 +01630 MOVE LOW-VALUES TO MPRF-KEY-AREA. DTSCS37 +01631 MOVE LOW-VALUES TO MSKL-KEY-AREA. CL*15 +01632 MOVE WRK-EMP-NO TO MPRF-EMP-NO. DTSCS37 +01633 SET MPRF-PRF-88 TO TRUE. DTSCS37 +01634 MOVE MPRF-KEY-AREA TO MSKL-KEY-AREA. DTSCS37 +01635 PERFORM S810-READ THRU S810-EXIT. DTSCS37 +01636 IF L810-NO-REC-88 DTSCS37 +01637 MOVE EMSG-NO-EMPLOYER TO WRK-MSG-AREA DTSCS37 +01638 PERFORM S1102A-ERROR THRU S1102A-EXIT DTSCS37 +01639 ELSE DTSCS37 +01640 MOVE MSKL-REC TO MPRF-REC DTSCS37 +01641 SET WRK-MPRF-YES-88 TO TRUE DTSCS37 +01642 MOVE WRK-EMP-NO TO LCCM-EMP-NO. DTSCS37 +01643 S1110-EXIT. DTSCS37 +01644 EXIT. DTSCS37 +01645 /*****************************************************************DTSCS37 +01646 * SET ATTRIBUTE BYTES FOR INQUIRY STATUS *DTSCS37 +01647 ******************************************************************DTSCS37 +01648 S5300-SET-INQ-ATTRB. DTSCS37 +01649 MOVE CATB-ASKIP-BRT-MDTOFF TO WRK-ATB-AN DTSCS37 +01650 WRK-ATB-NUM. DTSCS37 +01651 DTSCS37 +01652 PERFORM S5900-SET-ATTRB THRU S5900-EXIT. DTSCS37 +01653 S5300-EXIT. DTSCS37 +01654 EXIT. DTSCS37 +01655 SKIP3 DTSCS37 +01656 S5900-SET-ATTRB. DTSCS37 +01657 MOVE CATB-UNPROT-BRT-AN-MDTON TO MAP-SRCH-TRACE-NO-A DTSCS37 +01658 MAP-SRCH-TRACE-NO-A DTSCS37 +01659 MAP-SRCH-EMP-NO-1-A DTSCS37 +01660 MAP-SRCH-EMP-NO-2-A DTSCS37 +01661 MAP-SRCH-DATE1-MO-A DTSCS37 +01662 MAP-SRCH-DATE1-DA-A DTSCS37 +01663 MAP-SRCH-DATE1-YR-A DTSCS37 +01664 MAP-SRCH-DATE2-MO-A DTSCS37 +01665 MAP-SRCH-DATE2-DA-A DTSCS37 +01666 MAP-SRCH-DATE2-YR-A. DTSCS37 +01667 DTSCS37 +01668 DTSCS37 +01669 PERFORM DTSCS37 +01670 VARYING LINE-OCC FROM 1 BY 1 DTSCS37 +01671 UNTIL LINE-OCC > LINES-PER-PAGE DTSCS37 +01672 MOVE CATB-ASKIP-BRT-MDTOFF DTSCS37 +01673 TO MAP-LINE-A (LINE-OCC) DTSCS37 +01674 END-PERFORM. DTSCS37 +01675 DTSCS37 +01676 MOVE CATB-UNPROT-BRT-AN-MDTOFF TO MAP-GOTO-A. DTSCS37 +01677 S5900-EXIT. DTSCS37 +01678 EXIT. DTSCS37 +01679 /*****************************************************************DTSCS37 +01680 * MAP ROUTINES *DTSCS37 +01681 ******************************************************************DTSCS37 +01682 S9100-RECEIVE. DTSCS37 +01683 SET L851-RECEIVE-88 TO TRUE. DTSCS37 +01684 SKIP1 DTSCS37 +01685 MOVE WRK-SCR-ID TO L851-SCR-ID. DTSCS37 +01686 SKIP1 DTSCS37 +01687 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS37 +01688 SKIP1 DTSCS37 +01689 MOVE L851-AID TO LCCM-AID. DTSCS37 +01690 MOVE L851-CURSOR TO LCCM-CURSOR. DTSCS37 +01691 S9100-EXIT. DTSCS37 +01692 EXIT. DTSCS37 +01693 SKIP3 DTSCS37 +01694 S9200-SEND-DATAONLY. DTSCS37 +01695 MOVE LOW-VALUES TO MAP-AREA. DTSCS37 +01696 SKIP1 DTSCS37 +01697 IF LCCM-NO-MSG DTSCS37 +01698 NEXT SENTENCE DTSCS37 +01699 ELSE DTSCS37 +01700 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS37 +01701 SKIP1 DTSCS37 +01702 IF CURSOR-SET-GOTO DTSCS37 +01703 MOVE CATB-CURSOR TO MAP-GOTO-L DTSCS37 +01704 ELSE DTSCS37 +01705 MOVE CATB-CURSOR TO MAP-SRCH-TRACE-NO-L. DTSCS37 01706 SKIP1 DTSCS37 -01707 IF CURSOR-SET-NO DTSCS37 -01708 MOVE CATB-CURSOR TO MAP-SRCH-TRACE-NO-L. DTSCS37 -01709 SKIP1 DTSCS37 -01710 SET L851-SEND-88 TO TRUE. DTSCS37 -01711 SKIP1 DTSCS37 -01712 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS37 -01713 SKIP1 DTSCS37 -01714 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS37 -01715 S9300-EXIT. DTSCS37 -01716 EXIT. DTSCS37 -01717 SKIP3 DTSCS37 -01718 S9320-INQUIRY-FKEYS. DTSCS37 -01719 MOVE CFKD-FIRST TO MAP-KEY-FIRST. DTSCS37 -01720 MOVE CFKD-LAST TO MAP-KEY-LAST. DTSCS37 -01721 MOVE CFKD-BACKWARD TO MAP-KEY-BACK. DTSCS37 -01722 MOVE CFKD-FORWARD TO MAP-KEY-FWRD. DTSCS37 -01723 MOVE CFKD-NEW-SEARCH TO MAP-KEY-RESET. DTSCS37 -01724 SKIP1 DTSCS37 -01725 * PERFORM S9321-JUMP-KEYS THRU S9321-EXIT. DTSCS37 -01726 S9320-EXIT. DTSCS37 -01727 EXIT. DTSCS37 -01728 SKIP3 DTSCS37 -01729 *S9321-JUMP-KEYS. DTSCS37 -01730 * MOVE 'F9=QTR' TO MAP-KEY-QTR-INQ. DTSCS37 -01731 * MOVE 'F10=RPT' TO MAP-KEY-RPT-INQ. DTSCS37 -01732 * MOVE 'F12=ADJ' TO MAP-KEY-ADJ-INQ. DTSCS37 -01733 *S9321-EXIT. DTSCS37 -01734 * EXIT. DTSCS37 -01735 SKIP3 DTSCS37 -01736 S9330-DSCR-FIELDS. DTSCS37 -01737 * IF WRK-MPRF-YES-88 DTSCS37 -01738 * MOVE MPRF-PRIMARY-NAME TO MAP-PRIMARY-NAME DTSCS37 -01739 * ELSE DTSCS37 -01740 * MOVE LOW-VALUES TO MAP-PRIMARY-NAME. DTSCS37 -01741 S9330-EXIT. DTSCS37 -01742 EXIT. DTSCS37 -01743 SKIP3 DTSCS37 -01744 S9900-PREPARE-SEND. DTSCS37 -01745 MOVE WRK-SCR-ID TO L851-SCR-ID DTSCS37 -01746 LCCM-SCR-ID. DTSCS37 -01747 MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND. DTSCS37 -01748 MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE. DTSCS37 -01749 S9900-EXIT. DTSCS37 -01750 EXIT. DTSCS37 +01707 SET L851-SEND-DATAONLY-88 TO TRUE. DTSCS37 +01708 SKIP1 DTSCS37 +01709 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS37 +01710 SKIP1 DTSCS37 +01711 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS37 +01712 S9200-EXIT. DTSCS37 +01713 EXIT. DTSCS37 +01714 SKIP3 DTSCS37 +01715 S9300-SEND-MAP. DTSCS37 +01716 MOVE LCCM-TASK-START-DISP-DATE TO MAP-SYS-DATE. DTSCS37 +01717 MOVE LCCM-TASK-START-DISP-TIME TO MAP-SYS-TIME. DTSCS37 +01718 MOVE LCCM-CICS-REGION-NAME TO MAP-CICS-REGION-NAME. DTSCS37 +01719 SKIP1 DTSCS37 +01720 PERFORM S9320-INQUIRY-FKEYS THRU S9320-EXIT. DTSCS37 +01721 SKIP1 DTSCS37 +01722 PERFORM S9330-DSCR-FIELDS THRU S9330-EXIT. DTSCS37 +01723 SKIP1 DTSCS37 +01724 PERFORM S805-MSG-AREA THRU S805-EXIT. DTSCS37 +01725 SKIP1 DTSCS37 +01726 IF CURSOR-SET-NO DTSCS37 +01727 MOVE CATB-CURSOR TO MAP-SRCH-TRACE-NO-L. DTSCS37 +01728 SKIP1 DTSCS37 +01729 SET L851-SEND-88 TO TRUE. DTSCS37 +01730 SKIP1 DTSCS37 +01731 PERFORM S9900-PREPARE-SEND THRU S9900-EXIT. DTSCS37 +01732 SKIP1 DTSCS37 +01733 PERFORM S851-SCREEN-PROCESSING THRU S851-EXIT. DTSCS37 +01734 S9300-EXIT. DTSCS37 +01735 EXIT. DTSCS37 +01736 SKIP3 DTSCS37 +01737 S9320-INQUIRY-FKEYS. DTSCS37 +01738 MOVE CFKD-FIRST TO MAP-KEY-FIRST. DTSCS37 +01739 MOVE CFKD-LAST TO MAP-KEY-LAST. DTSCS37 +01740 MOVE CFKD-BACKWARD TO MAP-KEY-BACK. DTSCS37 +01741 MOVE CFKD-FORWARD TO MAP-KEY-FWRD. DTSCS37 +01742 MOVE CFKD-NEW-SEARCH TO MAP-KEY-RESET. DTSCS37 +01743 SKIP1 DTSCS37 +01744 * PERFORM S9321-JUMP-KEYS THRU S9321-EXIT. DTSCS37 +01745 S9320-EXIT. DTSCS37 +01746 EXIT. DTSCS37 +01747 SKIP3 DTSCS37 +01748 *S9321-JUMP-KEYS. DTSCS37 +01749 * MOVE 'F9=QTR' TO MAP-KEY-QTR-INQ. DTSCS37 +01750 * MOVE 'F10=RPT' TO MAP-KEY-RPT-INQ. DTSCS37 +01751 * MOVE 'F12=ADJ' TO MAP-KEY-ADJ-INQ. DTSCS37 +01752 *S9321-EXIT. DTSCS37 +01753 * EXIT. DTSCS37 +01754 SKIP3 DTSCS37 +01755 S9330-DSCR-FIELDS. DTSCS37 +01756 * IF WRK-MPRF-YES-88 DTSCS37 +01757 * MOVE MPRF-PRIMARY-NAME TO MAP-PRIMARY-NAME DTSCS37 +01758 * ELSE DTSCS37 +01759 * MOVE LOW-VALUES TO MAP-PRIMARY-NAME. DTSCS37 +01760 S9330-EXIT. DTSCS37 +01761 EXIT. DTSCS37 +01762 SKIP3 DTSCS37 +01763 S9900-PREPARE-SEND. DTSCS37 +01764 MOVE WRK-SCR-ID TO L851-SCR-ID DTSCS37 +01765 LCCM-SCR-ID. DTSCS37 +01766 MOVE LCCM-OP-ALARM-IND TO L851-ALARM-IND. DTSCS37 +01767 MOVE LCCM-MSG-TYPE TO L851-MSG-TYPE. DTSCS37 +01768 S9900-EXIT. DTSCS37 +01769 EXIT. DTSCS37