VB Scripting: Basic Lookup List Dialogs within Imaging Scan Workstation

From Support

Introduction

The following is a basic code sample that is designed to do the following:

• Query an ODBC database for a list of potential values
• Wrap the query result list in a basic dialog box so that the end user can select an option from the list.

Scripting Best Practices

If you have not done so already, it is recommended that you do not use the scripting file that comes with the RJS Imaging Scan Workstation (RJSIMGSCAN.BAS). Instead, copy it to a new file name or to a new directory and change your RJS Imaging Scan Workstation to point to this copy. This serves two purposes:

• First, if you place it on a network location, you can have all Scan Workstations point to the same file. This allows any changes to propagate to all the stations without the need to overwrite each local copy.
• Second, if you reinstall or upgrade the RJS Imaging Scan Workstation, there is no chance that you will overwrite the script file.

WARNING: Be sure that you save a backup copy of your scripting work before you begin your scripting changes. If a mistake is made, you will want to be able to use your backup copy.

WARNING: Be sure that you save a backup copy of your scripting work after you complete your scripting changes. If you find that somebody has corrupted or deleted the script, you will want a backup available to restore.

Code Sample

This will often be part of the RunIndexFieldLookup() function.

'***********************
'Process various lookups
'***********************
Dim sReturnVariantMulti As Variant
Dim lstTitleArray() As String
Dim i As Integer

Select Case iFieldIndex
    Case fiTitle

        'Run Query against WebDocs lookup list table DOCL00
        'using the iSeries Access ODBC database driver
        sReturnVariantMulti = RJSADODBMultipleRecordLookup("Driver={iSeries Access ODBC Driver};" & _
                                                             "SYSTEM=1.1.1.1;uid=user;pwd=password;", _
                                                           "select lvalue, lseqnbr " & _
                                                             "from library.file " & _
                                                             "where ldoctype = '" & sDocType & "'" & _
                                                             "and lkeyval = 'TITLE' " & _
                                                             "order by lseqnbr, lvalue", _
                                                           100, _
                                                           rjsDisplayErrorsYes)


        'Check for data in lookup table
        If sReturnVariantMulti(0, 0) = "DATAFOUND" Then

            Begin Dialog docTitle 400,231,"Select Title/Desc"     ' %GRID:10,7,1,1
                ListBox 10,7,380,189,lstTitleArray(),.lstTitle,1
                OKButton 100,203,80,21                            'standard OK button
                CancelButton 210,203,90,21                        'standard Cancel button
            End Dialog

            Dim dlgDocTitle As docTitle

            ' Resize listbox contents array
            ReDim lstTitleArray(sReturnVariantMulti(0, 1))

            ' Start out with nothing pre-selected
            dlgDocTitle.lstTitle = -1


            ' Fill the list
            For i = LBound(lstTitleArray) To UBound(lstTitleArray) - 1
                lstTitleArray(i) = sReturnVariantMulti(i + 1, 0)

                ' Pre-select matching item
                If sDocTitle = sReturnVariantMulti(i + 1, 0) Then
                    dlgDocTitle.lstTitle = i
                End If

            Next i

            'Set title to selected value if OK clicked
            Do While Dialog(dlgDocTitle)

                ' No selection
                If dlgDocTitle.lstTitle = -1 Then
                    MsgBox "Please make a selection"

                Else
                    lcarrFieldValues(fvTitle) = sReturnVariantMulti(dlgDocTitle.lstTitle + 1, 0)
                Exit Do

                End If

            Loop

        Else
            'Display error messages
            MsgBox sReturnVariantMulti(0, 2)
        End If

End Select