IMPAX Import script

' Created by Thomas Axelsen, RegionH
 Option Strict Off
 Imports System
 Imports System.Windows.Forms
 Imports AgfaHC.pacs.framework
 ' This script can be extended to accomodate lists with CPR
 ' numbers, acc. no etc. Importing from other legacy systems
 ' should be possible if readable (ie. text) files are
 ' provided
 Module Script
  Sub Main()
  dim uid as String
  dim objFSO, objFile, strFileName, strContents, objRegExp, id
  ScriptListArea.ClearSearchWorkList()
  const forReading = 1

Dim fd As OpenFileDialog = New OpenFileDialog()
  With fd
  .Title = "Åben arbejdsliste"
  .InitialDirectory = Environ("USERPROFILE") & "\Desktop"
  '.InitialDirectory = "Q:\RH\fs_ris\APPS\Impax 5.2 RH\Sektor 2\"
  .Filter = "Worklist (*.wkl)|*.wkl"
  .FilterIndex = 1
  .RestoreDirectory = True
  End With

If fd.ShowDialog() = DialogResult.OK Then
  strFileName = fd.FileName
  End if

 objFSO = CreateObject("Scripting.FileSystemObject")
  objFile = objFSO.OpenTextFile(strFileName, forReading)
  strContents = objFile.ReadAll
  objFile.Close

objRegExp = CreateObject("VBScript.RegExp")
  objRegExp.Global = True
  Dim patternString
  patternString = "(?:UID\=\" & chr(34) & ")(\S+)(?:\" & chr(34) & ")"
  'msgBox(patternString)
  objRegExp.Pattern = patternString
  dim colMatches, strMatch, strMatches
  colMatches = objRegExp.Execute(strContents)

For Each strMatch in colMatches
  id = strMatch.SubMatches(0)
  'id = strMatch.Value
  'MsgBox(id)
  System.Threading.Thread.Sleep(500) 
  ' Necessary to fill list properly, otherwise Impax
 ' cannot keep up
  ScriptListArea.AddToSearchWorkListWithStudyUid(id)
  Next
  End Sub
 End Module