IMPAX Export-script

EKSPORTÉr undersøgelser fra Impax 5.2

' Author: Thomas Axelsen, RegionH
' v1.0
' Last Update 02.05.17
' Added Try/Catch to enable export of lists containing pure RIS-exams
' Added XML export for fulll set of (shown) columns
' Added export of Impax 5 compatible WKL

' Export Script for Impax 6.6.1
' Export as WKL (suid), works with import-script
' Export as txt (currently only patient-id)
' Export as XML (all currently shown columns - and some more)

Option Strict Off

Imports System
Imports AgfaHC.pacs.framework
Imports system.collections
Imports System.Windows.Forms
Imports System.Text.RegularExpressions

Module Script
 Sub Main()

Dim count As Integer = 0
Dim study As PacsStudy
Dim list As ArrayList
Dim j
Dim MyColumns
Dim Key
Dim columnText As String
Dim colHeader

Dim xmlDoc, objRoot, objRecord, objName, objPid, objRegExp, objIntro, objPatient
Dim pid, lastPid, textString, textFinal, suid, pname As String

Dim sfd As SaveFileDialog = New SaveFileDialog()
 sfd.Filter = "WKL File|*.wkl|Text File|*.txt|XML file|*.xml|IMPAX 5|*.wkl"
 sfd.Title = "Gem Liste"
 
list = ScriptListArea.GetSelectedItemsInActiveWorklist()
If list.Count > 0 Then
If sfd.ShowDialog() = DialogResult.OK Then
 If sfd.FileName <> "" Then
 Select Case sfd.FilterIndex
 Case 1
 xmlDoc = CreateObject("Microsoft.XMLDOM") 
 objRoot = xmlDoc.createElement("WORKLIST") 
 xmlDoc.appendChild(objRoot)
 For Each study In list
 suid = study.ColumnData("study.study_uid").ToString 
 count += 1
 objName = xmlDoc.createElement("EXAM")
 objName.Text = " STUDY_UID=" & chr(34) + suid & chr(34)
 objRoot.appendChild(objName)
 Next
 objIntro = xmlDoc.createProcessingInstruction ("xml","version='1.0'") 
 xmlDoc.insertBefore(objIntro,xmlDoc.childNodes(0))
 xmlDoc.Save(sfd.Filename) 
 Case 2
 For Each study In list
 pid = study.ColumnData("patient.patient_id").ToString
 reformatPid(pid)
 If String.Compare(pid, lastPid) <> 0
 count += 1
 textString = pid + vbCrLf
 lastPid = pid
 textFinal = textFinal + textString
 End If
 Next

 My.Computer.FileSystem.WriteAllText _
 (sfd.FileName, textFinal, False)
 Case 3
 xmlDoc = CreateObject("Microsoft.XMLDOM") 
 objRoot = xmlDoc.createElement("WORKLIST") 
 xmlDoc.appendChild(objRoot)
 For Each study In list
 objPatient = xmlDoc.createElement("PATIENT")
 objRoot.appendChild(objPatient)
 MyColumns = study.ColumnData.Keys()
 For Each Key In MyColumns
 colHeader = chr(34) & Key.ToString & chr(34)
 objName = xmlDoc.createElement(Key)
 Try
 columnText = study.ColumnData(Key).ToString
 Catch ex As Exception
 msgbox(ex.message)
 Continue For
 End Try
 count += 1
 objName.Text = columnText
 objPatient.appendChild(objName)
 Next
 Next
 objIntro = xmlDoc.createProcessingInstruction ("xml","version='1.0'") 
 xmlDoc.insertBefore(objIntro,xmlDoc.childNodes(0))
 xmlDoc.Save(sfd.Filename)
 Case 4
 textFinal = "<WORKLIST><VERSION VALUE=" & chr(34) + "4.5.3" & chr(34) + "/>" + vbCrLf
 For Each study In list
 suid = study.ColumnData("study.study_uid").ToString 
 count += 1
 textString = "<STUDY STUDY_UID=" & chr(34) + suid & chr(34) + " AE_TITLE=" & chr(34) & chr(34) + "/>" + vbCrLf
 textFinal = textFinal + textString
 Next
 textFinal = textFinal + "</WORKLIST>"
 My.Computer.FileSystem.WriteAllText _
 (sfd.FileName, textFinal, False)

 End Select
 End If
End If

Else If list.Count = 0 Then
 MsgBox("Du skal vælge mindst én patient")
End If
End Sub

Sub reformatPid(ByRef pid As String)
 Dim patternString = "[0-9]{7}[0-9|a-zA-Z]{2}[0-9]{1}"
 pid = Regex.Match(pid, patternString).Value
End Sub
End Module