OS/2 Shareware BBS: Product/Product.zip/visilotu.zip/LNQMAIN.PRG

Text File | 1995-12-12 | 31KB | 905 lines

!.HEADER
!.SPEC APPDEST 0 D:\DESKTOP\VIS2LONO\LNQ.APL
!.HEADER
!
!
! Program Name     - LNQMAIN.PRG
!
! Program Function - Key Task for the Sample Lotus Notes Query application
!                    This program controls the major portion of the user-interface
!                    and collects information from each of the programs listed below
!                    in order to query the Lotus Notes database and retrieve the
!                    selected documents and fields.
!
! Called by        - <none>
!
! Calls            - FILES.PRG     Selection of the Notes Database & Form
!                    RENFLD.PRG    Renaming of Notes fieldnames
!                    SELFLD.PRG    Selection of Notes fields
!                    SELDOC.PRG    Selection of Notes documents
!                    MSG.PRG       Display of error messages
!
!                    LOTUSNOTES    Object provided by ASL Wrapper to PAS2LONO.DLL
!
!
! The LOTUSNOTES object provides all of the! function necessary to get data from Lotus
! Notes databases.  An overview of the function capabilities follows:
!
!
!   Initiate conversation with Notes         "OPEN"
!   Request a list of servers from Notes     "GetServerList"
!   Request a list of files on a server      "GetFileList"
!   Request a list of forms in a database    "GetFormList"
!   Request a list of fields on a form       "GetFormFieldList"
!   Create an ASL table with query results   "CreateProductTable"
!   Terminate the conversation with Notes    "CLOSE"
!.spec winsize 420 118
!.spec textcol 0 17
!.spec appdest 1 d:\desktop\vis2lono\LNQ.apl
!.HEADER
!
! DEFINITION
! Some ASL commands can be placed outside of the normal block
! structure. This block is provided to allow such commands to
! be accomodated
!
! Assign boolean variables
!
DECLARE TASK NUMERIC yes = 1
DECLARE TASK NUMERIC no  = 0
!
DECLARE TASK CHAR[4] ThisTask = A.System.ThisTask
DECLARE POINTER perror

!
! Open the library and declare the required functions
!
LIBRARY ASL "MyLib..AppDevL",
 Files,
 SaveAs,
 File_Put,
 File_Get,
 Print,
 Help_SetUp,
 App_Help,
 App_Icon
!
! ON SELECT
! This block is triggered whenever the user selects a control
! or menu entry.
!
ON SELECT
DO
  LET A.System.Object = Toolbar'FILTER(           ! Call the Toolbar object to handle SELECTs
   A.System.Event,                                ! on the toolbar and set the standard variables
   A.System.Object,                               ! A.System.Object, etc. to the appropriate objectnames
   A.System.BoxNumber)                            ! set in the TOOLDATA vector
  !
  ! Filter selections on the help menu
  IF App_Help()
    RETURN
    !

  CASE A.System.Object
    !
    WHEN "T.W_lnqmain.HelpButton"
    DO
      ! list box set for single select mode
      LET Rc =  Sys'COMMANDCODE("VIEW " ||        ! view the online help file
       FULLPATH(A.System.StartDS'LOCATION,        ! in INF format
       "LNQ.INF"))
    END
    !
    !
    WHEN "T.W_lnqmain.Save"                       ! currently unavailable
    DO
      ! Respond to Menu entry marked '"Save"'
    END
    !
    WHEN "T.W_lnqmain.CopyTo"                     ! currently unavailable
    DO
      ! Respond to Menu entry marked '"Copy To..."'
    END
    !
    WHEN "T.W_lnqmain.SelectDocuments"
    DO
      ! Respond to Menu entry marked '"Select Documents"'
      IF UNKNOWN(p_SelDoc)
        START PROGRAM p_SelDoc,"I.modules.SelDoc",
         START(
         POINTER(W_lnqmain[0]),                   ! ownerwindow alias
         POINTER(Selection[0]))                   ! pointer to selection vector
      ELSE
        RUN PROGRAM p_SelDoc

    END
    !
    WHEN "T.W_lnqmain.RenameFields"
    DO
      ! Respond to Menu entry marked '"Rename Fields"'

      IF UNKNOWN(p_RenFld)
        START PROGRAM p_RenFld,"I.modules.RenFld",! display dialog to change names
         START(POINTER(ColumnDerivation[0]),      ! original names
         POINTER(ColumnName[0]),                  ! new names
         POINTER(ColumnSelectFlag[0]),            ! selected columns
         POINTER(W_lnqmain[0]))                   ! Ownerwindow alias
      ELSE
        RUN PROGRAM p_RenFld
    END
    !
    WHEN "T.W_lnqmain.SelectFields"
    DO
      ! Respond to Menu entry marked '"Select Fields"'

      IF UNKNOWN(p_SelFld)
        START PROGRAM p_SelFld,"I.modules.SelFld",
         START(POINTER(ColumnSelectFlag[0]),      ! vector of selected columns
         POINTER(ColumnName[0]),                  ! column names
         POINTER(W_lnqmain[0]))                   ! ownerwindow alias
      ELSE
        RUN PROGRAM p_SelFld

      WAIT PROGRAM p_SelFld

      LET T.W_lnqmain.LIST1[0]'ORDERDATA = ColumnSelectFlag[0]
    END
    !
    WHEN "T.W_lnqmain.Run"
    DO
      ! Respond to Menu entry marked '"Run"'
      LET ResultsName = Run_Query()               ! run the query
      CALL Open_Table(ResultsName)          ! and display the results in Table Editor

    END
    WHEN "T.W_lnqmain.Messages"                   ! display the error messages
    DO
      DEFINE A.Lotus.ErrorInfo[0]                      ! Get Error Info from Lotus Object
      pERROR=POINTER(A.Lotus.ErrorInfo[0])      ! Into A.Lotus.ErrorInfo
      FORGIVE                                                !  which will be referenced by the
           CALL LOTUS'GetErrorInfo(pError)         ! Message Program
      IF UNKNOWN(p_Messages)
      ! Respond to Menu entry marked '"Messages"'
        START PROGRAM p_Messages,"I.Modules.Msg",
         START(
         POINTER(W_lnqmain[0]))                   ! ownerwindow alias
      ELSE
        RUN PROGRAM p_Messages
    END

    !
    WHEN "T.W_lnqmain.Print"                      ! currently unavailable
    DO
      ! Respond to Menu entry marked '"Print..."'
    END
    !
    !
    !
    WHEN "T.W_lnqmain.Toolbar"                    ! currently unavailable
    DO
      ! Respond to Menu entry marked '"Toolbar"'
    END
    !
    WHEN "T.W_lnqmain.SelectForm"
    DO
      ! Respond to Menu entry marked '"Select Form..."'
      !

      IF UNKNOWN(p_Files)                         ! if not started
        START PROGRAM p_files,"I.Modules.Files",  ! then start the program
         START(POINTER(W_lnqmain[0]),             ! ownerwindow alias
         POINTER(Lotus[0]))                       ! Lotus Notes Object
      ELSE                                        ! otherwise
        RUN PROGRAM p_Files,QUEUE()               ! just pass control to it

      WAIT PROGRAM p_files                        ! wait for its signal

      IF NOVALUE(Form)                            ! if no form selected
        RETURN                                    ! then go no farther

      LET DataSource = "Data Source - "||Server|| ! update on-screen scalar
       IF(SPLIT(Directory,1,1)\="\","\","")||     ! that displays where data
      Directory||"\"||Form                        ! comes from

      ! check for new form name here

      CALL Get_Field_Info()                       ! get details on Fields from the Form

      CALL Set_Toolbar_State("UP")                ! enable Toolbar

    END
  END
END
!
! ON START
! This block is executed when the program is initially invoked.
! It is normally used to initialize variables needed during
! program execution and to open the main window of the
! application.
!
ON START(FileName, AppIdentifier, AppName)
DO
  !
  ! Open the object store holding the user library
  !
  OPEN OBJECTSTORE MyLib,
   NAME ="UserLib.A95",
   LOCATION = S.Control.Path

  FORGIVE
    OPEN LOTUSNOTES Lotus                         ! Open the Lotus Notes Object
  IF A.System.ErrorNumber
  DO
    ERROR 1,"Unable to open LotusNotes Object. Check that Lotus Notes is installed" ||
            " correctly. The Lotus Notes directory must be in PATH and LIBPATH."
    STOP
  END


  OPEN SYSTEM Sys                                 ! access OS/2 facilities

  OPEN PROFILE Prof
  !
  ! Assign all variables referred by the windows
  !
  LET DataSource = "Data Source - (none)"         ! used by Text control named 'T.W_lnqmain.TEXT3'
  LET Server     = ""
  LET Directory  = ""
  LET Form       = ""
  ! valid characters for ASL column names
  LET ValidCharacters = "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_"

  ! Obtain Current Directory
  g_CurLoc = A.System.StartDs'Location
  IF Split(g_CurLoc,Length(g_CurLoc),1) = "\"
    g_CurLoc = Split(g_CurLoc,1,Length(g_CurLoc)-1)


  DEFINE Selection[1]
  !
  ! Open an instance of the clipboard
  OPEN CLIPBOARD clip
  !
  ! Open the help object and identify (dummy) file holding compiled text
  !
  OPEN HELP Help
  CALL Help_SetUp("SampHelp.Hlp", "Help")
  !
  ! Call procedure to define data for list control(s)
  !
  CALL List_Define

  !
  OPEN WINDOW W_lnqmain,, "I.Windows.lnqmain",
   VISIBLE=No

  LET MarginRight = W_lnqmain'SIZEX -             ! get margins for use
   T.W_lnqmain.LIST1'SIZEX -                      ! when window is resized
   T.W_lnqmain.LIST1'X                            ! and DESKTOP event is triggered

  LET MarginTop = W_lnqmain'SIZEY -
   T.W_lnqmain.LIST1'SIZEY -
   T.W_lnqmain.LIST1'Y

  CALL Open_Toolbar                               ! add a toolbar to the window
  !
  CALL App_Icon(POINTER(W_lnqmain[0]))
  !
  ! assign the column titles for list controlLIST1
  LET T.W_lnqmain.LIST1'COLTITLE1="Title_1"

  CALL Set_Toolbar_State("DISABLED")              ! disable toolbar (except Table & Help)

  MODIFY W_LnqMain,                               ! prohibit window from being
   MINX = W_LnqMain'SIZEX,                        ! sized smaller than when it
   MINY = W_LnqMain'SIZEY,                        ! was opened
   VISIBLE=Yes                                    ! show the window


END
!
! Construct the arrays needed to support list controls
!
PROCEDURE List_Define
DO
  !
  ! Define data to handle list 'T.W_lnqmain.LIST1'
  !
  DEFINE ColumnsC[0]                              ! REFERENCE vector
  DEFINE LayoutC[0]                               ! EXPRESSION vector
  !
  ! fill the EXPRESSION vector
  !
  INSERT LayoutC[0]="WIDTH=100 SEPARATOR=YES JUST=LEFT READONLY=YES"
  INSERT LayoutC[0]="WIDTH=100 SEPARATOR=YES JUST=LEFT READONLY=YES"
  INSERT LayoutC[0]="WIDTH=85 SEPARATOR=YES JUST=LEFT READONLY=YES"
  INSERT LayoutC[0]="WIDTH=200 SEPARATOR=YES JUST=LEFT READONLY=YES"
  !
  ! Initialise the referred vectors. These are the vectors
  ! which will contain the data to be displayed
  !
  DEFINE ColumnName[0]
  DEFINE ColumnDerivation[0]
  DEFINE ColumnType[0]
  DEFINE ColumnComment[0]
  !
  ! fill the REFERENCE vector to point to these vectors
  !
  INSERT ColumnsC[0] = "ColumnName"
  INSERT ColumnsC[0] = "ColumnDerivation"
  INSERT ColumnsC[0] = "ColumnType"
  INSERT ColumnsC[0] = "ColumnComment"
  !
  ! create and fill the titles vector
  !
  DEFINE Title_1[0]
  INSERT Title_1[0] = "Name"
  INSERT Title_1[0] = "Notes Fieldname"
  INSERT Title_1[0] = "Type"
  INSERT Title_1[0] = "Comment"
END
!
! ON QUIT
! This block is executed when the user uses Close in the
! system menu.
! For a secondary window this would imply, 'shut the window'.
! For a primary window the implication is, 'close the
! Application'.
!
ON QUIT
DO
  CASE A.System.Object

    WHEN "T..W_lnqmain"                           ! primary window
      RUN PROGRAM ThisTask, STOP

    OTHERWISE
      SHUT ?A.System.Object

  END
END
!
! ON DESKTOP
! This block is signaled if the user modifies the window in any
! way, for example, resizing or using the maximize or minimize
! icons. Code here will take account of any such actions, for
! example, by resizing controls to account for a new window
! size.
!
ON DESKTOP
DO
  CASE A.System.Object
    WHEN "T..W_lnqmain"
    DO
      CASE A.System.Operation
        WHEN "MAX"
        DO
          ! change the list box dimensions based upon window changes

          MODIFY T.W_lnqmain.LIST1,
           SIZEX = T..W_lnqmain'SIZEX - MarginRight -
           T.W_lnqmain.LIST1'X,
           SIZEY = T..W_lnqmain'SIZEY - MarginTop -
           T.W_lnqmain.LIST1'Y

        END
        !
        WHEN "NORM"
        DO
          ! change the list box dimensions based upon window changes

          MODIFY T.W_lnqmain.LIST1,
           SIZEX = T..W_lnqmain'SIZEX - MarginRight -
           T.W_lnqmain.LIST1'X,
           SIZEY = T..W_lnqmain'SIZEY - MarginTop -
           T.W_lnqmain.LIST1'Y
        END
        !
        WHEN "SIZE"
        DO
          ! change the list box dimensions based upon window changes

          MODIFY T.W_lnqmain.LIST1,
           SIZEX = T..W_lnqmain'SIZEX - MarginRight -
           T.W_lnqmain.LIST1'X,
           SIZEY = T..W_lnqmain'SIZEY - MarginTop -
           T.W_lnqmain.LIST1'Y
        END
        !
      END
    END
  END
END
!
! ERROR event
! This block is executed when there is a run-time error.
! You can trap errors here or allow the error message provided
! to identify the error and stop the program.
!

ON ERROR
DO
  DECLARE CHAR[7] ans
  DECLARE NUMERIC i
  !
  ! Message to identify failing module and line
  !
  LET ans = DIALOG("FTB7004", 0,
   A.System.ErrorModule,
   A.System.ErrorLine)

  DO i = 1 : A.System.ErrorNumber[0]'ENTRIES
    IF ans = "CANCEL"
      TERMINATE
      !
      ! Display system message corresponding to error
      !
    LET ans = DIALOG ("FTB" || A.System.Errornumber[i], 0,
     A.System.ErrorInfo[i])
  END

  RUN PROGRAM ThisTask,STOP
END
!
! ON STOP
! This block is executed when the program is terminated.
! You should use the block to carry out any housekeeping
! required before closing
!
ON STOP
DO
      SHUT Lotus                           ! Close the Lotus Notes Object

  STOP
END
!
! User specified procedures may have up to 20 passed parameters.
! Procedures may be called as functions (using the RETURN
! facility to return a value) or may be called as normal
! procedures.
!
PROCEDURE Open_Toolbar
DO
  ! Now we prepare the toolbar information arrays

  DEFINE tbarUp[0]                                /* array of UP bitmaps          */
  DEFINE tbarDown[0]                              /* array of DOWN bitmaps        */
  DEFINE tbarDis[0]                               /* array of DISABLED bitmaps    */

  DEFINE tbarLatch[0]                             /* array of latchable values    */
  DEFINE tbarGroup[0]                             /* array of button groupings    */
  DEFINE tbarToggle[0]                            /* array of toggle groupings    */
  DEFINE tbarInit[0]                              /* array of initial states      */

  DEFINE tbarNames[0]                             /* array of button object names */
  DEFINE tbarDesc[0]                              /* array of description texts   */
  DEFINE tbarHelp[0]                              /* array of help text res IDs   */

  ! The UP bitmaps. Notice that bitmaps can be identified by
  ! fully-qualified file name, or by DLL name and resource ID
  INSERT tbarUp[0]     = "FTBBMPS<1070>"          ! save
  INSERT tbarUp[0]     = "FTBBMPS<1075>"          ! copy to
  INSERT tbarUp[0]     = "FTBBMPS<1080>"          ! print
  INSERT tbarUp[0]     = "FTBBMPS<1000>"          ! select table
  INSERT tbarUp[0]     = "FTBBMPS<1010>"          ! select rows
  INSERT tbarUp[0]     = "FTBBMPS<1500>"          ! rename columns
  INSERT tbarUp[0]     = "FTBBMPS<1005>"          ! select columns
  INSERT tbarUp[0]     = "FTBBMPS<1030>"          ! run
  INSERT tbarUp[0]     = "FTBBMPS<1105>"          ! help
  ! The DOWN bitmaps.
  INSERT tbarDown[0]     = "FTBBMPS<1071>"        ! save
  INSERT tbarDown[0]     = "FTBBMPS<1076>"        ! copy to
  INSERT tbarDown[0]     = "FTBBMPS<1081>"        ! print
  INSERT tbarDown[0]     = "FTBBMPS<1001>"        ! select table
  INSERT tbarDown[0]     = "FTBBMPS<1011>"        ! select rows
  INSERT tbarDown[0]     = "FTBBMPS<1501>"        ! rename columns
  INSERT tbarDown[0]     = "FTBBMPS<1006>"        ! select columns
  INSERT tbarDown[0]     = "FTBBMPS<1031>"        ! run
  INSERT tbarDown[0]     = "FTBBMPS<1106>"        ! help

  ! The DISABLED bitmaps.

  INSERT tbarDis[0]     = "FTBBMPS<1072>"         ! save
  INSERT tbarDis[0]     = "FTBBMPS<1077>"         ! copy to
  INSERT tbarDis[0]     = "FTBBMPS<1082>"         ! print
  INSERT tbarDis[0]     = "FTBBMPS<1002>"         ! select table
  INSERT tbarDis[0]     = "FTBBMPS<1012>"         ! select rows
  INSERT tbarDis[0]     = "FTBBMPS<1502>"         ! rename columns
  INSERT tbarDis[0]     = "FTBBMPS<1007>"         ! select columns
  INSERT tbarDis[0]     = "FTBBMPS<1032>"         ! run
  INSERT tbarDis[0]     = "FTBBMPS<1107>"         ! help

  ! Our third and fourth buttons are to be latchable
  INSERT tbarLatch[0]  = 0
  INSERT tbarLatch[0]  = 0
  INSERT tbarLatch[0]  = 0
  INSERT tbarLatch[0]  = 0
  INSERT tbarLatch[0]  = 0
  INSERT tbarLatch[0]  = 0
  INSERT tbarLatch[0]  = 0

  INSERT tbarLatch[0]  = 0
  INSERT tbarLatch[0]  = 0

  ! Keep the first one separate, and group the other three together
  INSERT tbarGroup[0]  = 0
  INSERT tbarGroup[0]  = 0                        /* large gap between first and second
  INSERT tbarGroup[0]  = 0                        /* small gap between second and third
  INSERT tbarGroup[0]  = 2                        /* no gap between the two that toggle
  INSERT tbarGroup[0]  = 0                        /* no gap between the two that toggle
  INSERT tbarGroup[0]  = 0
  INSERT tbarGroup[0]  = 0
  INSERT tbarGroup[0]  = 2
  INSERT tbarGroup[0]  = 2

  ! Our second two buttons will toggle each other on and off
  ! All the '1's form a toggle group, and the '2's, and so on
  ! This only makes sense for latchable buttons
  INSERT tbarToggle[0] = 0                        /* 0 = no toggling */
  INSERT tbarToggle[0] = 0
  INSERT tbarToggle[0] = 0
  INSERT tbarToggle[0] = 0
  INSERT tbarToggle[0] = 0
  INSERT tbarToggle[0] = 0
  INSERT tbarToggle[0] = 0

  INSERT tbarToggle[0] = 0
  INSERT tbarToggle[0] = 0

  ! Initial states - all up, except button four which will be down
  INSERT tbarInit[0]   = "UP"
  INSERT tbarInit[0]   = "UP"
  INSERT tbarInit[0]   = "UP"
  INSERT tbarInit[0]   = "UP"
  INSERT tbarInit[0]   = "UP"
  INSERT tbarInit[0]   = "UP"
  INSERT tbarInit[0]   = "UP"

  INSERT tbarInit[0]   = "UP"
  INSERT tbarInit[0]   = "UP"

  ! Object names - we can choose these as we like
  INSERT tbarNames[0]  = "T.w_lnqmain.Save"
  INSERT tbarNames[0]  = "T.w_lnqmain.CopyTo"
  INSERT tbarNames[0]  = "T.w_lnqmain.Print"
  INSERT tbarNames[0]  = "T.W_lnqmain.SelectForm"
  INSERT tbarNames[0]  = "T.w_lnqmain.SelectDocuments"
  INSERT tbarNames[0]  = "T.w_lnqmain.RenameFields"
  INSERT tbarNames[0]  = "T.w_lnqmain.SelectFields"
  INSERT tbarNames[0]  = "T.w_lnqmain.Run"
  INSERT tbarNames[0]  = "T.w_lnqmain.HelpButton"


  ! Button description texts
  INSERT tbarDesc[0]   = "Save"
  INSERT tbarDesc[0]   = "Copy to..."
  INSERT tbarDesc[0]   = "Print"
  INSERT tbarDesc[0]   = "Select Form"
  INSERT tbarDesc[0]   = "Select Documents"
  INSERT tbarDesc[0]   = "Rename Fields"
  INSERT tbarDesc[0]   = "Select Fields"
  INSERT tbarDesc[0]   = "Run"
  INSERT tbarDesc[0]   = "Help"

  ! Button help text res IDs
  INSERT tbarHelp[0]   = 10192
  INSERT tbarHelp[0]   = 10193
  INSERT tbarHelp[0]   = 10194
  INSERT tbarHelp[0]   = 10195
  INSERT tbarHelp[0]   = 10195
  INSERT tbarHelp[0]   = 10195
  INSERT tbarHelp[0]   = 10195
  INSERT tbarHelp[0]   = 10195
  INSERT tbarHelp[0]   = 10195

  ! Now open the tool bar

  OPEN TBAR ToolBar, w_lnqmain,                   /* open tool bar on my window */
   UP         = POINTER(tbarUp[0]),
   DOWN       = POINTER(tbarDown[0]),
   DISABLED   = POINTER(tbarDis[0]),
   LATCH      = POINTER(tbarLatch[0]),
   GROUP      = POINTER(tbarGroup[0]),
   TOGGLE     = POINTER(tbarToggle[0]),
   INISTATE   = POINTER(tbarInit[0]),
   TOOLDATA   = POINTER(tbarNames[0]),
   TOOLTEXT   = POINTER(tbarDesc[0]),
   HELPIDS    = POINTER(tbarHelp[0]),
   HELP       = POINTER(MyHelp[0]),
   HELPGLOBAL = 10191,
   VISIBLE    = 1


END
!
! User specified procedures may have up to 20 passed parameters.
! Procedures may be called as functions (using the RETURN
! facility to return a value) or may be called as normal
! procedures.
!
PROCEDURE Get_Field_Info
DO
  DEFINE FieldList[0]
  DEFINE FieldType[0]
  DEFINE ColumnList[0]

  ! 'push' button marked 'GetFieldList'
  LET Lotus'Servername = Server                   ! Set Attributes
  LET Lotus'Database = Database
  LET Lotus'Formname = Form

  FORGIVE
      CALL Lotus'GetFormFieldList( POINTER(FieldList[0]),  ! pointer to list of fields
                          POINTER(FieldType[0]))  ! pointer to list of fieldtypes

  If LOTUS'CODE > 0
     DO
     MESSAGE "FTB0003",0,LOTUS'REASON
     RETURN
     END



  DEFINE ColumnTypeASL[0]
  DEFINE ColumnName[0]
  DEFINE ColumnDerivation[0]                      ! Notes fieldname (unedited)
  DEFINE ColumnDerivationASL[0]                   ! Notes fieldname (ASL-valid)
  DEFINE ColumnType[0]
  DEFINE ColumnComment[0]
  DEFINE ColumnSelectFlag[0]


  DO cc=1:FieldList[0]'ENTRIES

    IF FieldList[cc]\=""                          ! ensure that no blanks exist
    DO
      LET ColRef = Valid_Name(                    ! test for a valid ASL column name
       FieldList[cc],                             ! passing this current fieldname
       POINTER(ColumnName[0]))                    ! and list of valid names so far

      CASE FieldType[cc]                          ! equate the Notes fieldtype to an ASL type
        WHEN "Text"
          LET ColType = "Character"

        WHEN "Number"
          LET ColType = "Numeric"

        WHEN "Time/Date"
          LET ColType = "Character"

        WHEN "RichText"
          LET ColType="Character"

        WHEN "Multi-Value List"
          LET ColType = "Character"

        OTHERWISE                                 ! default to Character data
          LET ColType = "Character"

      END

      !
      ! then assign values to ASL vectors for use later
      !
      INSERT ColumnName[0]       = ColRef         ! the valid ASL column name
      INSERT ColumnDerivation[0] = FieldList[cc]  ! the fieldname it came from
      INSERT ColumnDerivationASL[0] = ColRef      ! valid ASL name for backup (in case of user rename)
      INSERT ColumnComment[0]    = ""             ! comment for later support
      INSERT ColumnSelectFlag[0] = cc             ! indicates selection of column (default all)
      INSERT ColumnType[0]       = FieldType[cc]  ! Notes fieldtype
      INSERT ColumnTypeASL[0]    = ColType        ! equivalent ASL type
    END
  END
END
!
! User specified procedures may have up to 20 passed parameters.
! Procedures may be called as functions (using the RETURN
! facility to return a value) or may be called as normal
! procedures.
!
PROCEDURE Valid_Name(pOriginalName,pAlreadyExists)
DO
  DECLARE LOCAL NUMERIC InvalidChars=Yes
  !
  ! step one is to get rid of invalid characters for an ASL column
  ! name ($,etc)
  !
  WHILE InvalidChars
  DO
    LET InvalidChars=SCAN(
     pOriginalName,
     ValidCharacters,,,"\=",1)

    IF InvalidChars                               ! if an invalid character
      LET pOriginalName =                         ! is found in the Notes fieldname
       OVERLAY(pOriginalName,"_",InvalidChars)    ! then it should be replaced with an underscore
  END
  !
  ! next step is to truncate the column name to the ASL
  ! limit and see if this new name already exists
  ! if it does exist then begin changing the name starting at
  ! the end using numerics 0-9
  !
  LET CharToChange=20
  LET NextChar=1

  LET NewName=SPLIT(pOriginalName,1,20)           ! get first 20 chars since ASL limit is 20

  LET AlreadyThere=FIND(                          ! look for this column name
   (?pAlreadyExists),                             ! in the vector passed into procedure
   NewName)                                       ! this is the column to look for

  WHILE AlreadyThere                              ! if a column already exists
  DO                                              ! by this same column name
    LET NewName=SPLIT(                            ! generate a new name
     NewName,1,CharToChange-1) || NextChar

    LET AlreadyThere=FIND(                        ! and then look for it
     (?pAlreadyExists),                           ! in the same vector
     NewName)

    LET NextChar+=1                               ! increase counter for trailing character

    IF NextChar=10                                ! if we just bumped up to our limit
    DO                                            ! for a single character
      LET NextChar=1                              ! then reset char to 0
      LET CharToChange-=1                         ! and move to the left to change
    END

  END

  RETURN NewName                                  ! return the new name back to the caller

END
!
! User specified procedures may have up to 20 passed parameters.
! Procedures may be called as functions (using the RETURN
! facility to return a value) or may be called as normal
! procedures.
!
PROCEDURE Run_Query
DO
  DECLARE LOCAL CHARACTER[*] TempTableName = ""   ! define local variables
  DECLARE LOCAL CHARACTER[*] CreateTableRc = ""


  DEFINE A.System.LNErrorInfo[0]                  ! reset error message vector

  DEFINE ColumnsToSelect[0]                       ! create list of columns selected

  DO cc=1:ColumnSelectFlag[0]'ENTRIES             ! and populate it
    INSERT ColumnsToSelect[0] =                   ! for the query
     ColumnDerivation[ColumnSelectFlag[cc]]
  END

  IF \NOVALUE(Selection[1])
    LET SelectionCriteria =                       ! set default selection criteria
     "SELECT Form="""||Form||""" & " ||           ! by inserting the Formname as part of the selection
     Selection[1]                                 ! and then adding the user portion
  ELSE
    LET SelectionCriteria =
     "SELECT Form="""||Form||""""

  LET Lotus'Servername = Server                   ! Set Server Name
  LET Lotus'Database = Database                   ! Set Database
  LET Lotus'Expression = SelectionCriteria        ! Set selection expression
  LET TempTableName = String("_\Result.TAB",g_Curloc)
  ! CALL Sys'INCLUDETEMP( TempTableName )           ! Delete file at application close
  FORGIVE
     CALL Lotus'CreateProductTable(
                      TempTableName,                 ! Table to create
                      POINTER(ColumnsToSelect[0]))   ! pointer to vector of columns to create

  If LOTUS'CODE > 0
     DO
     MESSAGE "FTB0003",0,LOTUS'REASON,LOTUS'CODE
     RETURN
     END


  OPEN TABLE ResultsTable,                        ! open a table over the OS/2 file
   NAME     = NAME(TempTableName),                ! to hold the query results obtained
   LOCATION = LOCATION(TempTableName),            ! via the Lotus Notes interface
   MODE     = "WRITE"                             ! table opened in Write mode


  INSERT A.System.LNErrorInfo[0]=Lotus'Code

  DO cc=1:ColumnSelectFlag[0]'ENTRIES             ! rename the columns on the results
    IF ColumnSelectFlag[cc]\=""
    DO
      LET OldName = "ResultsTable." ||            ! table to those specified by the user
       ColumnDerivationASL[ColumnSelectFlag[cc]]

      LET NewName = "ResultsTable." ||            ! to rename
       ColumnName[ColumnSelectFlag[cc]]

      RENAME ?OldName,?NewName

      IF ColumnTypeASL[cc] = "Numeric"
        FORGIVE LET (?NewName)[0]'TYPE = "Numeric"
    END
  END

  SHUT ResultsTable                               ! shut the Visualizer table

  RETURN TempTableName                            ! return the physical tablename

END
!
! User specified procedures may have up to 20 passed parameters.
! Procedures may be called as functions (using the RETURN
! facility to return a value) or may be called as normal
! procedures.
!
PROCEDURE Open_Table(pIdentifier)
DO
  SHUT Resultsview                                ! shut existing view

  FORGIVE
    OPEN IBMTABLE ResultsView,                    ! use the Table Editor to view
     NAME       = "Query Results",                ! results of Query
     IDENTIFIER = pIdentifier

  IF A.System.ErrorNumber                         ! an error occurred
  DO
    ERROR 10001,"A problem was encountered displaying the query results"
    RETURN
  END

  CALL ResultsView'OPEN()                         ! surface the view
END
!
! User specified procedures may have up to 20 passed parameters.
! Procedures may be called as functions (using the RETURN
! facility to return a value) or may be called as normal
! procedures.
!
PROCEDURE Set_Toolbar_State(pState)
DO
  ! pState is set on call to "UP", "DOWN", or "DISABLED"

  DECLARE LOCAL CHARACTER[10] pState

  LET Grayed = IF(                                ! Gray-out menuitems if
   pState="DISABLED",                             ! buttons are to be disabled
   Yes,
   No,
   No)

  !
  ! set toolbar items
  !
  CALL Toolbar'STATE("T.w_lnqmain.Save","DISABLED")! temporarily disabled
  CALL Toolbar'STATE("T.w_lnqmain.CopyTo","DISABLED")
  CALL Toolbar'STATE("T.w_lnqmain.Print","DISABLED")
  CALL Toolbar'STATE("T.w_lnqmain.SelectDocuments",pState)
  CALL Toolbar'STATE("T.w_lnqmain.RenameFields",pState)
  CALL Toolbar'STATE("T.w_lnqmain.SelectFields",pState)
  CALL Toolbar'STATE("T.w_lnqmain.Run",pState)
  !
  ! set menubar items
  !
  LET T.w_lnqmain.Save[0]'GRAYED = Yes            ! next 4 temporarily disabled
  LET T.w_lnqmain.CopyTo[0]'GRAYED = Yes
  LET T.w_lnqmain.Print[0]'GRAYED = Yes
  LET T.w_lnqmain.Toolbar[0]'GRAYED = Yes
  LET T.w_lnqmain.SelectDocuments[0]'GRAYED = Grayed
  LET T.w_lnqmain.RenameFields[0]'GRAYED = Grayed
  LET T.w_lnqmain.SelectFields[0]'GRAYED = Grayed
  LET T.w_lnqmain.Run[0]'GRAYED = Grayed

END
!
! PROPERTIES event
! This block is executed when there the user presses Mouse Button 2
!
ON PROPERTIES
DO
  LET A.System.Object = Toolbar'FILTER(           ! Call the Toolbar object to handle
   A.System.Event,                                ! this Event for the toolbar buttons
   A.System.Object,                               ! Mouse Button 2 on a toolbar button displays a pulldown menu
   A.System.BoxNumber)                            ! displaying text from the TOOLTEXT attribute

END