00001 IDENTIFICATION DIVISION. 12/02/98 00002 PROGRAM-ID. DTSBU143. DTSBU143 00003 AUTHOR. MT DEPT OF LABOR/UI PROGRAMMING SECTION. LV002 00004 DATE-WRITTEN. OCTOBER 1994. DTSBU143 00005 DATE-COMPILED. DTSBU143 00006 SKIP3 DTSBU143 00007 ******************************************************************DTSBU143 00008 * *DTSBU143 00009 * FUNCTION: BUILDS A RECORD FROM VARIABLE LENGTH FIELDS *DTSBU143 00010 * (USEFUL FOR CREATING DOWNLOAD FILES) *DTSBU143 00011 * *DTSBU143 00012 * *DTSBU143 00013 * MODIFICATION HISTORY: *DTSBU143 00014 * 10-25-94 INITIAL DEVELOPMENT *DTSBU143 00015 * REFERENCE RFP #RAP AUTHOR OF CHANGE - SFW *DTSBU143 00016 * *DTSBU143 00017 * 12-02-98 MODIFIED TO MEET DUTAS PROGRAMMING SPECIFICATIONS. * CL**2 00018 * REFERENCE RFP #**** AUTHOR OF CHANGE - DVS * CL**2 00019 * * CL**2 00020 * MM-DD-YY XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX * CL**2 00021 * XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX * CL**2 00022 * REFERENCE RFP #**** AUTHOR OF CHANGE - XXX * CL**2 00023 * *DTSBU143 00024 * IF THE CA-OPTIMIZER IS NOT USED, REMOVE REFERENCES TO *DTSBU143 00025 * THE 'CA-OPTIMIZER-FIX' FIELD. (ERROR MESSAGE CAPP744E.) *DTSBU143 00026 * *DTSBU143 00027 ******************************************************************DTSBU143 00028 SKIP3 DTSBU143 00029 ENVIRONMENT DIVISION. DTSBU143 00030 SKIP3 DTSBU143 00031 DATA DIVISION. DTSBU143 00032 EJECT DTSBU143 00033 WORKING-STORAGE SECTION. DTSBU143 000335 77 PAN-VALET PICTURE X(24) VALUE '002DTSBU143 12/02/98'. DTSBU143 00034 SKIP3 DTSBU143 00035 01 WRK-AREA. DTSBU143 00036 05 WS-END-CHARACTER-IND PIC X(01). DTSBU143 00037 88 WS-END-CHARACTER-SET VALUE 'Y'. DTSBU143 00038 05 WS-START-CHARACTER PIC S9(05) COMP-3. DTSBU143 00039 05 WS-END-CHARACTER PIC S9(05) COMP-3. DTSBU143 00040 05 WS-SPACES-COUNT PIC S9(05) COMP-3. DTSBU143 00041 05 WS-NON-SPACES-COUNT PIC S9(05) COMP-3. DTSBU143 00042 05 WS-START-SEARCH PIC S9(05) COMP-3. DTSBU143 00043 05 WS-ZEROES-COUNT PIC S9(05) COMP-3. DTSBU143 00044 05 WS-INTEGER-SIZE PIC S9(05) COMP-3. DTSBU143 00045 EJECT DTSBU143 00046 LINKAGE SECTION. DTSBU143 00047 SKIP3 DTSBU143 00048 01 L143-LINK-AREA. DTSBU143 00049 ++INCLUDE DTSIL143 CL**2 00050 SKIP2 DTSBU143 00051 01 CA-OPTIMIZER-FIX1 PIC X(01). DTSBU143 00052 01 CA-OPTIMIZER-FIX2 PIC X(01). DTSBU143 00053 01 CA-OPTIMIZER-FIX3 PIC X(01). DTSBU143 00054 EJECT DTSBU143 00055 PROCEDURE DIVISION DTSBU143 00056 USING L143-LINK-AREA. DTSBU143 00057 SKIP1 DTSBU143 00058 SET L143-OK TO TRUE. DTSBU143 00059 SKIP1 DTSBU143 00060 IF L143-STRING-DELIM-NO DTSBU143 00061 NEXT SENTENCE DTSBU143 00062 ELSE DTSBU143 00063 PERFORM P1000-MOVE-STRING-DELIM THRU P1000-EXIT. DTSBU143 00064 IF L143-ERROR DTSBU143 00065 GO TO MAINLINE-EXIT. DTSBU143 00066 SKIP1 DTSBU143 00067 IF L143-EMBED-NO-REPLACE OR (L143-FIELD-SIZE = +0) DTSBU143 00068 NEXT SENTENCE DTSBU143 00069 ELSE DTSBU143 00070 PERFORM P3000-IMBED-REPLACE THRU P3000-EXIT. DTSBU143 00071 SKIP1 DTSBU143 00072 IF L143-TRIM-OUTSIDE-SPACES AND (L143-FIELD-SIZE > +0) DTSBU143 00073 PERFORM P4000-TRIM-SPACES THRU P4000-EXIT DTSBU143 00074 ELSE DTSBU143 00075 IF L143-TRIM-LEADING-ZEROES AND (L143-FIELD-SIZE > +0) DTSBU143 00076 PERFORM P5000-TRIM-LEADING-ZEROES THRU P5000-EXIT DTSBU143 00077 ELSE DTSBU143 00078 MOVE +1 TO WS-START-CHARACTER DTSBU143 00079 MOVE L143-FIELD-SIZE TO WS-END-CHARACTER. DTSBU143 00080 IF L143-ERROR DTSBU143 00081 GO TO MAINLINE-EXIT. DTSBU143 00082 SKIP1 DTSBU143 00083 PERFORM P6000-MOVE-FIELD-CHARS THRU P6000-EXIT DTSBU143 00084 VARYING L143-FIELD-IDX FROM WS-START-CHARACTER BY +1 DTSBU143 00085 UNTIL (L143-FIELD-IDX > WS-END-CHARACTER) OR L143-ERROR. DTSBU143 00086 IF L143-ERROR DTSBU143 00087 GO TO MAINLINE-EXIT. DTSBU143 00088 SKIP1 DTSBU143 00089 IF L143-STRING-DELIM-NO DTSBU143 00090 NEXT SENTENCE DTSBU143 00091 ELSE DTSBU143 00092 PERFORM P1000-MOVE-STRING-DELIM THRU P1000-EXIT. DTSBU143 00093 IF L143-ERROR DTSBU143 00094 GO TO MAINLINE-EXIT. DTSBU143 00095 SKIP1 DTSBU143 00096 IF L143-FIELD-DELIM-NO DTSBU143 00097 NEXT SENTENCE DTSBU143 00098 ELSE DTSBU143 00099 PERFORM P2000-MOVE-FIELD-DELIM THRU P2000-EXIT. DTSBU143 00100 SKIP2 DTSBU143 00101 MAINLINE-EXIT. DTSBU143 00102 GOBACK. DTSBU143 00103 SKIP2 DTSBU143 00104 MOVE SPACE TO CA-OPTIMIZER-FIX1 DTSBU143 00105 CA-OPTIMIZER-FIX2 DTSBU143 00106 CA-OPTIMIZER-FIX3. DTSBU143 00107 EJECT DTSBU143 00108 P1000-MOVE-STRING-DELIM. DTSBU143 00109 SKIP1 DTSBU143 00110 ADD +1 TO L143-REC-SIZE. DTSBU143 00111 IF L143-REC-SIZE > L143-MAX-REC-LENGTH DTSBU143 00112 SET L143-ERROR TO TRUE DTSBU143 00113 ELSE DTSBU143 00114 MOVE L143-STRING-DELIM DTSBU143 00115 TO L143-REC-CHAR (L143-REC-SIZE). DTSBU143 00116 SKIP2 DTSBU143 00117 P1000-EXIT. DTSBU143 00118 EXIT. DTSBU143 00119 EJECT DTSBU143 00120 P2000-MOVE-FIELD-DELIM. DTSBU143 00121 SKIP1 DTSBU143 00122 ADD +1 TO L143-REC-SIZE. DTSBU143 00123 IF L143-REC-SIZE > L143-MAX-REC-LENGTH DTSBU143 00124 SET L143-ERROR TO TRUE DTSBU143 00125 ELSE DTSBU143 00126 MOVE L143-FIELD-DELIM DTSBU143 00127 TO L143-REC-CHAR (L143-REC-SIZE). DTSBU143 00128 SKIP2 DTSBU143 00129 P2000-EXIT. DTSBU143 00130 EXIT. DTSBU143 00131 EJECT DTSBU143 00132 P3000-IMBED-REPLACE. DTSBU143 00133 SKIP1 DTSBU143 00134 IF L143-STRING-DELIM-NO DTSBU143 00135 IF L143-FIELD-DELIM-NO DTSBU143 00136 NEXT SENTENCE DTSBU143 00137 ELSE DTSBU143 00138 INSPECT L143-FIELD (1:L143-FIELD-SIZE) DTSBU143 00139 REPLACING ALL L143-FIELD-DELIM BY L143-EMBED DTSBU143 00140 ELSE DTSBU143 00141 INSPECT L143-FIELD (1:L143-FIELD-SIZE) DTSBU143 00142 REPLACING ALL L143-STRING-DELIM BY L143-EMBED. DTSBU143 00143 SKIP2 DTSBU143 00144 P3000-EXIT. DTSBU143 00145 EXIT. DTSBU143 00146 EJECT DTSBU143 00147 P4000-TRIM-SPACES. DTSBU143 00148 SKIP1 DTSBU143 00149 MOVE +0 TO WS-SPACES-COUNT. DTSBU143 00150 INSPECT L143-FIELD (1:L143-FIELD-SIZE) DTSBU143 00151 TALLYING WS-SPACES-COUNT DTSBU143 00152 FOR LEADING SPACES. DTSBU143 00153 IF WS-SPACES-COUNT = L143-FIELD-SIZE DTSBU143 00154 MOVE +1 TO WS-START-CHARACTER DTSBU143 00155 MOVE +0 TO WS-END-CHARACTER DTSBU143 00156 GO TO P4000-EXIT. DTSBU143 00157 ADD +1 WS-SPACES-COUNT GIVING WS-START-CHARACTER DTSBU143 00158 WS-START-SEARCH. DTSBU143 00159 MOVE 'N' TO WS-END-CHARACTER-IND. DTSBU143 00160 PERFORM P4500-FIND-TRAILING-SPACES THRU P4500-EXIT DTSBU143 00161 UNTIL WS-END-CHARACTER-SET. DTSBU143 00162 SKIP2 DTSBU143 00163 P4000-EXIT. DTSBU143 00164 EXIT. DTSBU143 00165 EJECT DTSBU143 00166 P4500-FIND-TRAILING-SPACES. DTSBU143 00167 SKIP1 DTSBU143 00168 MOVE +0 TO WS-NON-SPACES-COUNT. DTSBU143 00169 INSPECT L143-FIELD DTSBU143 00170 (WS-START-SEARCH:1 + L143-FIELD-SIZE - WS-START-SEARCH) DTSBU143 00171 TALLYING WS-NON-SPACES-COUNT DTSBU143 00172 FOR CHARACTERS BEFORE INITIAL SPACE. DTSBU143 00173 IF WS-START-SEARCH + WS-NON-SPACES-COUNT > L143-FIELD-SIZE DTSBU143 00174 MOVE L143-FIELD-SIZE TO WS-END-CHARACTER DTSBU143 00175 SET WS-END-CHARACTER-SET TO TRUE DTSBU143 00176 GO TO P4500-EXIT. DTSBU143 00177 SKIP1 DTSBU143 00178 ADD WS-NON-SPACES-COUNT TO WS-START-SEARCH. DTSBU143 00179 MOVE +0 TO WS-SPACES-COUNT. DTSBU143 00180 INSPECT L143-FIELD DTSBU143 00181 (WS-START-SEARCH:1 + L143-FIELD-SIZE - WS-START-SEARCH) DTSBU143 00182 TALLYING WS-SPACES-COUNT DTSBU143 00183 FOR LEADING SPACES. DTSBU143 00184 IF WS-START-SEARCH + WS-SPACES-COUNT > L143-FIELD-SIZE DTSBU143 00185 SUBTRACT +1 FROM WS-START-SEARCH GIVING WS-END-CHARACTER DTSBU143 00186 SET WS-END-CHARACTER-SET TO TRUE DTSBU143 00187 ELSE DTSBU143 00188 ADD WS-START-SEARCH WS-SPACES-COUNT DTSBU143 00189 GIVING WS-START-SEARCH. DTSBU143 00190 SKIP2 DTSBU143 00191 P4500-EXIT. DTSBU143 00192 EXIT. DTSBU143 00193 EJECT DTSBU143 00194 P5000-TRIM-LEADING-ZEROES. DTSBU143 00195 SKIP1 DTSBU143 00196 MOVE L143-FIELD-SIZE TO WS-END-CHARACTER. DTSBU143 00197 MOVE +0 TO WS-ZEROES-COUNT. DTSBU143 00198 INSPECT L143-FIELD (1:L143-FIELD-SIZE) DTSBU143 00199 TALLYING WS-ZEROES-COUNT DTSBU143 00200 FOR LEADING ZEROES. DTSBU143 00201 IF WS-ZEROES-COUNT = +0 DTSBU143 00202 MOVE +1 TO WS-START-CHARACTER DTSBU143 00203 GO TO P5000-EXIT. DTSBU143 00204 IF WS-ZEROES-COUNT = L143-FIELD-SIZE DTSBU143 00205 MOVE L143-FIELD-SIZE TO WS-START-CHARACTER DTSBU143 00206 GO TO P5000-EXIT. DTSBU143 00207 SKIP1 DTSBU143 00208 MOVE +0 TO WS-INTEGER-SIZE. DTSBU143 00209 INSPECT L143-FIELD (1:L143-FIELD-SIZE) DTSBU143 00210 TALLYING WS-INTEGER-SIZE DTSBU143 00211 FOR CHARACTERS BEFORE INITIAL '.'. DTSBU143 00212 IF WS-INTEGER-SIZE = WS-ZEROES-COUNT DTSBU143 00213 MOVE WS-ZEROES-COUNT TO WS-START-CHARACTER DTSBU143 00214 ELSE DTSBU143 00215 ADD +1 TO WS-ZEROES-COUNT GIVING WS-START-CHARACTER. DTSBU143 00216 SKIP2 DTSBU143 00217 P5000-EXIT. DTSBU143 00218 EXIT. DTSBU143 00219 EJECT DTSBU143 00220 P6000-MOVE-FIELD-CHARS. DTSBU143 00221 SKIP1 DTSBU143 00222 ADD +1 TO L143-REC-SIZE. DTSBU143 00223 IF L143-REC-SIZE > L143-MAX-REC-LENGTH DTSBU143 00224 SET L143-ERROR TO TRUE DTSBU143 00225 ELSE DTSBU143 00226 MOVE L143-FIELD-CHAR (L143-FIELD-IDX) DTSBU143 00227 TO L143-REC-CHAR (L143-REC-SIZE). DTSBU143 00228 SKIP2 DTSBU143 00229 P6000-EXIT. DTSBU143 00230 EXIT. DTSBU143