CSBCONVERT

Description

Converts a data value from one datatype to another.

Syntax

COPY CTPUBLIC.
01 CONTEXT        PIC S9(9) COMP SYNC.
01 RETCODE        PIC S9(9) COMP SYNC.
01 SRCFMT
    05 SRC-NAME         PIC X(132).
    05 SRC-NAMELEN      PIC S9(9) COMP SYNC.
    05 SRC-TYPE         PIC S9(9) COMP SYNC.
    05 SRC-FORMAT       PIC S9(9) COMP SYNC.
    05 SRC-MAXLEN       PIC S9(9) COMP SYNC.
    05 SRC-SCALE        PIC S9(9) COMP SYNC.
    05 SRC-PRECIS       PIC S9(9) COMP SYNC.
    05 SRC-STATUS       PIC S9(9) COMP SYNC.
    05 SRC-COUNT        PIC S9(9) COMP SYNC.
    05 SRC-UTYPE        PIC S9(9) COMP SYNC.
    05 SRC-LOCALE       PIC S9(9) COMP SYNC.
01 SRCDATA          type.
01 DESTFMT 
    05 DEST-NAME         PIC X(132).
    05 DEST-NAMELEN      PIC S9(9) COMP SYNC.
    05 DEST-TYPE         PIC S9(9) COMP SYNC.
    05 DEST-FORMAT       PIC S9(9) COMP SYNC.
    05 DEST-MAXLEN       PIC S9(9) COMP SYNC.
    05 DEST-SCALE        PIC S9(9) COMP SYNC.
    05 DEST-PRECIS       PIC S9(9) COMP SYNC.
    05 DEST-STATUS       PIC S9(9) COMP SYNC.
    05 DEST-COUNT        PIC S9(9) COMP SYNC.
    05 DEST-UTYPE        PIC S9(9) COMP SYNC.
    05 DEST-LOCALE       PIC S9(9) COMP SYNC.
01 DESTDATA         type.
01 OUTLEN               PIC S9(9) COMP SYNC.
 
CALL 'CSBCONVE' USING CONTEXT RETCODE SRCFMT SRCDATA DESTFMT DESTDATA OUTLEN.

Parameters

CONTEXT

(I) A context structure. The context structure is defined in the program call CSBCTXALLOC.

RETCODE

(O) Variable where the result from an executed function returns. Its value is one of the codes listed under “Return value,” in this section.

SRCFMT

(I) A structure that describes the variable(s) that contain the source data. CSBCONVERT ignores SRCFMT fields that it does not use.

Table 3-20 lists the fields in the SRCFMT structure and indicates whether and how they are used by CSBCONVERT. For a general discussion of this structure, see “DATAFMT structure”.

Table 3-20: Fields in the SRCFMT structure for CSBCONVERT

Field

When used

Value represents

SRC-NAME

Not used (CS-FMT-UNUSED).

Not applicable.

SRC-NAMELEN

Not used (CS-FMT-UNUSED).

Not applicable.

SRC-TYPE

For all datatype conversions.

The datatype of the source data.

CSBCONVERT converts this datatype to the datatype specified for the destination variable (DEST-TYPE).

SRC-FORMAT

Not used (CS-FMT-UNUSED).

Not applicable.

SRC-MAXLEN

When converting non-fixed-length source datatypes to any destination type.

SRC-MAXLEN is ignored when converting fixed-length types.

The length of the source variable, in bytes. If SRCDATA is an array, SRC-MAXLEN is the length of an element in the array.

When converting character or binary datatypes, SRC-MAXLEN must describe the total length of the source variable, including any space required for special terminating bytes, with this exception: when converting a VARYCHAR-type source such as the DB2 VARCHAR, SRC-MAXLEN does not include the length of the “LL” length specification.

In case of Sybase-numeric, Sybase-decimal or packed decimal this value is the actual length.

SRC-SCALE

Only when converting to or from numeric, Sybase-decimal, or packed decimal datatypes.

Number of digits that follow the decimal point in the source data.

SRC-SCALE must be less than or equal to SRC-PRECIS and cannot be greater than 31.

SRC-PRECIS

Only when converting to or from packed decimal, numeric and Sybase-decimal datatypes.

The total number of digits in the source data.

SRC-PRECIS must be greater than or equal to SRC-SCALE and cannot be less than 1 or greater than 31.

SRC-STATUS

Not used (CS-FMT-UNUSED).

Not applicable.

SRC-COUNT

Not used (CS-FMT-UNUSED).

Not applicable.

SRC-UTYPE

Not used (CS-FMT-UNUSED).

Not applicable.

SRC-LOCALE

Not used (CS-FMT-UNUSED).

Not applicable.

SRCDATA

(I) Name of the source variable that contains the data to be converted. This is the variable described in the SRCFMT structure.

DESTFMT

(I) A structure that contains a description of the variable(s) that contain destination (converted) data. CSBCONVERT ignores DESTFMT fields that it does not use.

Table 3-21 lists the fields in the DESTFMT structure and indicates whether and how they are used by CSBCONVERT. For a general discussion of this structure, see “DATAFMT structure”.

Table 3-21: Fields in the DATAFMT structure for CSBCONVERT

Field

When used

Value represents

DEST-NAME

Not used (CS-FMT-UNUSED).

Not applicable.

DEST-NAMELEN

Not used (CS-FMT-UNUSED).

Not applicable.

DEST-TYPE

For all datatype conversions.

The datatype of the destination variable.

CSBCONVERT converts the datatype specified for the source data (SRCTYPE) to this datatype.

DEST-FORMAT

Not used (CS-FMT-UNUSED).

Not applicable.

DEST-MAXLEN

When converting all source datatypes to non-fixed-length datatypes.

DEST-MAXLEN is ignored when converting to fixed-length datatypes.

The length of the destination variable, in bytes. If DESTDATA is an array, DEST-MAXLEN is the length of an element in the array.

When converting character or binary datatypes, DEST-MAXLEN must describe the total length of the destination variable, including any space required for special terminating bytes, with this exception: when converting to a VARYCHAR-type destination such as the DB2 VARCHAR, DEST-MAXLEN does not include the length of the “LL” length specification.

DEST-MAXLEN = 35 when converting to numeric or Sybase-decimal.

DEST-SCALE

Only when converting to or from numeric, Sybase-decimal, or packed decimal datatypes.

Number of digits that follow the decimal point in the destination variable.

DEST-SCALE must be less than or equal to DEST-PRECIS and cannot be greater than 31. Use the same value as in SRC-SCALE

DEST-PRECIS

Only when converting to or from numeric, Sybase-decimal, or packed decimal datatypes.

The total number of digits in the destination data.

DEST-PRECIS must be greater than or equal to DEST-SCALE and cannot be less than 1 or greater than 31. Use the same value as in SRC-PRECIS

DEST-STATUS

Not used (CS-FMT-UNUSED).

Not applicable.

DEST-COUNT

Not used (CS-FMT-UNUSED).

Not applicable.

DEST-UTYPE

Not used (CS-FMT-UNUSED).

Not applicable.

DEST-LOCALE

Not used (CS-FMT-UNUSED).

Not applicable.

DESTDATA

Name of the variable that contains the converted data. This is the variable described in the DESTDATA structure.

OUTLEN

(O) Actual length, in bytes, of the data placed in DESTDATA. If the conversion fails, CSBCONVERT sets OUTLEN to CS-UNUSED.

Returns

CSBCONVERT returns one of the following values listed in Table 3-22.

Table 3-22: CSBCONVERT return values

Value

Meaning

CS-SUCCEED (-1)

The routine completed successfully.

CS-FAIL (-2)

The routine failed.

TDS-INVALID-DATAFMT-VALUE (-181)

A SRCFMT or DESTFMT field contains an illegal value—probably an illegal datatype value.

TDS-INVALID-VAR-ADDRESS (-175)

This value cannot be NULL.

TDS-MONEY-CONVERSION-ERROR (-22)

Converting TDSMONEY4 failed, possibly because the TDS version is not 4.2 or above.

TDS-INVALID-DATA-CONVERSION (-172)

This value cannot be NULL.

TDS-INVALID-LENGTH(-173)

Converting TDSMONEY4 failed, possibly because the TDS version is not 4.2 or above.

Examples

Example 1

The following code fragment demonstrates the use of CSBCONVERT. It is taken from the sample program SYCTSAA5 in Appendix A, “Sample Language Requests.”

      	 *========================================================
       *==                                                    ==
       *== Subroutine to fetch row processing                 ==
       *==                                                    ==
       *========================================================
        FETCH-ROW-PROCESSING.
            CALL 'CTBFETCH' USING CSL-CMD-HANDLE,
                                  CSL-RC,
                                  CS-UNUSED,
                                  CS-UNUSED,
                                  CS-UNUSED,
                                  FF-ROWS-READ.
            EVALUATE CSL-RC
                WHEN CS-SUCCEED
                     MOVE 'Y'             TO SW-FETCH
                     MOVE CS-VARCHAR-TYPE TO DF-DATATYPE
                     MOVE LENGTH OF CF-COL-FIRSTNME-TXT
                                          TO DF-MAXLENGTH
                     MOVE CS-CHAR-TYPE    TO DF2-DATATYPE
                     MOVE LENGTH OF CF-COL-FIRSTNME-CHAR
                                          TO DF2-MAXLENGTH
                     CALL 'CSBCONVE' USING CSL-CTX-HANDLE,
                                           CSL-RC,
                                           DATAFMT,
                                           CF-COL-FIRSTNME,
                                           DATAFMT2,
                                           CF-COL-FIRSTNME-CHAR,
                                           CF-COL-LEN
                     IF CSL-RC NOT EQUAL CS-SUCCEED
                       THEN
                          MOVE SPACES TO MSGSTR
                          STRING 'CSBCONVERT CS-VARCHAR-TYPE failed'
                                      DELIMITED BY SIZE INTO MSGSTR
                          PERFORM PRINT-MSG
                          PERFORM ALL-DONE
                     END-IF
                     COMPUTE FF-ROW-NUM = FF-ROW-NUM + 1
       **************************************
       * save ROW RESULTS for later display *
       ***************************************

Usage

See also

Related functions

Related topics