Sub LSXDB2IO(sql As String)On Error Goto CodeError
Dim lcsession As New LCSession
Dim src As New LCConnection(“db2”)
lcsession.ClearStatus
Dim fldLstRecord As New LCFieldList (1, LCFIELDF_TRUNC_DATA + LCFIELDF_TRUNC_PREC)
Dim field As New LCField (LCTYPE_TEXT, 1)
Dim selectionstatement As String
Dim count As Long
Dim result As String
src.Userid = session.GetEnvironmentString(ENV_RDBUsername$)
src.Password = session.GetEnvironmentString(ENV_RDBPassword$)
src.Database = session.GetEnvironmentString(ENV_RDBEntry$)
src.Connect
selectionstatement = “SELECT * FROM upsvaldta.ucf6cpp WHERE F6AXST = ‘1’”
count = src.Execute (selectionstatement, fldLstRecord)
If count = LCCOUNT_UNKNOWN Then
Print "A result set was generated but the number of results is unknown."
End If
If count <> 0 Then
count = src.Fetch (fldLstRecord, 1, 1)
Set field = fldLstRecord.GetField(1)
result = ""
While (count > 0) And lcsession.status = LCSuccess
result = result + field.text(0) + ","
count = src.Fetch(fldLstRecord, 1, 1)
Wend
Print " Fields are " & result
End If
Exit Sub
CodeError:
Print "CommonIO - LSXDB2IO " & Cstr(Err) & “: '” & Error$ & "’ at line " & Cstr(Erl)
Resume Next
End Sub