Rem CSMC Employee Directory RTF File Generator
Rem Copyright (C) 1994-95 Ray Duncan
Rem Version 1.0 12/1/94 derived from OMIM.MDB and GENEMAP.MDB

Option Compare Database   ' use database order for string comparisons
Option Explicit           ' force declaration of all variables


Function Main ()

  ' This is the main routine of the conversion program; it can be invoked 
  ' with a command button or by running a macro. It generates several 
  ' different sorted indexes of employee names, then generates a main 
  ' file containing the detailed information about each employee.

  Call WriteIndexFile("CSMC Directory by Employee Name", "idx_name", "idxname.rtf", "EntireName", "LastName", 1.5)
  Call WriteIndexFile("CSMC Directory by VAX Account", "idx_vax", "idxvax.rtf", "VaxMail1", "VaxMail1", 1.25)
  Call WriteIndexFile("CSMC Directory by Extension", "idx_ext", "idxext.rtf", "Extension", "Extension", 1.5)
  Call WriteIndexFile("CSMC Directory by Location", "idx_locn", "idxlocn.rtf", "Location", "Location", 1.5)
  Call WriteIndexFile("CSMC Directory by Department", "idx_dept", "idxdept.rtf", "Dept", "Department", 3)
  Call WriteBodyFile("csmcdir.rtf", "EntireName")

End Function


Function Mcase (Sarg As Variant) As Variant
  
  ' Converts the argument string to mixed case if and only
  ' if the string is in all caps. We use the "variant" form
  ' of the string functions so that the routine won't crash
  ' if it is passed a "null" string (as opposed to a
  ' zero-length string).

  If StrComp(Sarg, UCase(Sarg), 0) <> 0 Then
    Mcase = Sarg
  Else
    Mcase = UCase(Left(Sarg, 1)) & LCase(Mid(Sarg, 2))
  End If

End Function


Sub WriteBlankLine (FileNum As Integer)

  ' Generates the RTF code for a blank line. For
  ' simplicity, this is just implemented as generation
  ' of an empty paragraph.

  Print #FileNum, "\par"

End Sub


Sub WriteBodyFile (FileName As String, IndexField As String)

  ' This routine builds the main RTF file for the employee
  ' database. Each employee record in the database is converted
  ' to an individual topic in the output file. The context
  ' string and browse index for each topic is a function
  ' of the number of the corresponding record in the database.
  ' The employee last name is used for the keyword footnote.
  ' The full employee name, with the last name first, is used
  ' for the topic heading and for the title footnote (needed
  ' for the history window).
  
  Dim Dbase As Database, Dset1 As Recordset
  Dim TopicTitle As String, ContextString As String
  Dim BrowseSequence As String, KeywordString As String

  ' open database and employee info table, set sort order
  Set Dbase = DBEngine.Workspaces(0).Databases(0)
  Set Dset1 = Dbase.OpenRecordset("CSMC Directory", DB_OPEN_TABLE)
  Dset1.Index = IndexField
  
  ' open RTF output file, truncating any previous file
  ' by the same name to zero length
  Open FileName For Output As #1 Len = 4096

  ' write RTF file identifier, font table, and color table
  Call EmitRTFHeader(1)

  ' now walk through the sorted recordset and write the detail records
  While Dset1.EOF <> True
  
    ' Build topic title, browse sequence number, context string, and 
    ' keyword string. Note: browse sequence & context string are 
    ' synthesized from a counter field.
    TopicTitle = (Mcase(Dset1![LastName]) & ", " & Mcase(Dset1![FirstName]))
    BrowseSequence = "dir:" & Left$("00000", 6 - Len(Str$(Dset1![ID]))) & LTrim$(Str$(Dset1![ID]))
    ContextString = "dir_" & LTrim$(Str$(Dset1![ID]))
    KeywordString = Mcase(Dset1![LastName])

    ' write index topic header, but omit browse sequence number for index topics
    Call EmitRTFTopicDivider(1, TopicTitle, ContextString, KeywordString, TopicTitle, BrowseSequence)

    ' set tab stop at 1"
    Call EmitRTFTabStopInches(1, 1)

    ' turn off line wrap for index entries
    Print #1, "\keep "
    
    Call WriteBlankLine(1)
    Call WriteBodyItem(1, "Credential", Dset1![Credential])
    Call WriteBodyItem(1, "Title #1", Dset1![Title1])
    Call WriteBodyItem(1, "Title #2", Dset1![Title2])
    Call WriteBlankLine(1)
    Call WriteBodyItem(1, "Department", Dset1![Department])
    Call WriteBodyItem(1, "Division", Dset1![Division])
    Call WriteBodyItem(1, "Location", Dset1![Location])
    Call WriteBodyItem(1, "Mail Stop", Dset1![MailStop])
    Call WriteBlankLine(1)
    Call WriteBodyItem(1, "Extension", Dset1![Extension])
    Call WriteBodyItem(1, "Dept. Ext.", Dset1![DeptExt])
    Call WriteBodyItem(1, "FAX", Dset1![FAX])
    Call WriteBodyItem(1, "Pager", Dset1![Pager])
    Call WriteBodyItem(1, "VAXMail #1", Dset1![VaxMail1])
    Call WriteBodyItem(1, "VAXMail #2", Dset1![VaxMail2])
    Call WriteBlankLine(1)
    Call WriteBodyItem(1, "Other Info", Dset1![Other])
    Call WriteBlankLine(1)

    Dset1.MoveNext

  Wend
  
  ' write the RTF file terminators
  Call EmitRTFTrailer(1)
  
  ' close the output file & recordset
  Close #1
  Dset1.Close

End Sub


Sub WriteBodyItem (FileNum As Integer, ItemName As String, 
                   ItemData As Variant)

  ' This handy little routine writes a field title, tabs to the
  ' first tab stop, displays a detail item in boldface, and forces
  ' the end of line.

  Print #FileNum, ItemName & ":\tab " & "{\b " & ItemData & "}"
  Print #FileNum, "\par"

End Sub


Sub WriteIndexFile (TopicTitle As String, ContextString As String, 
                    FileName As String, IndexField As String, 
                    InfoField As String, TabStop As Single)

  ' This routine writes a index to the employee file, consisting of
  ' a list of hyperlinks and sorted on the specified database field,
  ' to an RTF file as a single topic. The context string for the topic,
  ' the name of the output file, and the distance to the first tab stop
  ' are specified by the caller. The index sorted by employee name
  ' gets some special handling to include the employee's extension,
  ' since this is the index used most commonly.

  Dim Dbase As Database, Dset1 As Recordset
  Dim HotLinkString As String, TargetString As String

  ' open database and employee info table, set sort order
  Set Dbase = DBEngine.Workspaces(0).Databases(0)
  Set Dset1 = Dbase.OpenRecordset("CSMC Directory", DB_OPEN_TABLE)
  Dset1.Index = IndexField
  
  ' open RTF output file for sorted index
  Open FileName For Output As #1 Len = 4096

  ' write RTF file identifier, font table, and color table
  Call EmitRTFHeader(1)

  ' write index topic heading, but omit keyword and browse sequence
  ' footnotes for index topics
  Call EmitRTFTopicDivider(1, TopicTitle, ContextString, "", TopicTitle, "")

  ' set first tab stop as specified by caller
  Call EmitRTFTabStopInches(1, TabStop)

  ' turn off line wrap for index entries
  Print #1, "\keep \cf6"
  
  ' now walk through the sorted recordset and write the index topic
  ' as a list of hyperlinks to the employee detail topics
  While Dset1.EOF <> True

    TargetString = "dir_" & LTrim$(Str$(Dset1![ID]))
    
    ' skip records where the "InfoField" is empty or nonalphanumeric
    If Dset1(InfoField) >= "0" Then

      ' adjust print format for the hotlink if we are sorting by name
      If IndexField = "EntireName" Then
	HotLinkString = Dset1![Extension] & "\tab " & Mcase(Dset1![LastName]) & ", " & Mcase(Dset1![FirstName])
      Else
	HotLinkString = Dset1(InfoField) & "\tab " & Mcase(Dset1![LastName]) & ", " & Mcase(Dset1![FirstName])
      End If
      
      ' generate the hotlink and force end-of-line
      Call EmitRTFHotLink(1, HotLinkString, TargetString)
      Print #1, "\par"
    
    End If

    ' go to the next employee record
    Dset1.MoveNext

  Wend
  
  ' write the RTF file terminators
  Call EmitRTFTrailer(1)
  
  ' close the output file & recordset
  Close #1
  Dset1.Close

End Sub