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
