Attribute VB_Name = "mdlDicMWL"
Option Explicit

Private Type SECURITY_ATTRIBUTES
   nLength As Long
   lpSecurityDescriptor As Long
   bInheritHandle As Long
End Type

Public Type SYSTEMTIME
   wYear As Integer
   wMonth As Integer
   wDayOfWeek As Integer
   wDay As Integer
   wHour As Integer
   wMinute As Integer
   wSecond As Integer
   wMilliseconds As Integer
End Type

Public Type FILETIME
   dwLowDateTime As Long
   dwHighDateTime As Long
End Type

Public ModalityArray(19, 2) As String

Private Const REGISTRY_LOCATION = "SOFTWARE\LEAD Technologies, Inc.\VB_DicomMWL"
Private Const HKEY_CURRENT_USER = &H80000001
Private Const KEY_ALL_ACCESS = &H1F003F
Private Const KEY_SET_VALUE = &H2
Private Const KEY_QUERY_VALUE = &H1
Private Const REG_OPTION_NON_VOLATILE = 0
Private Const ERROR_SUCCESS = 0
Private Const REG_SZ As Long = 1
Private Const REG_DWORD As Long = 4
Public Const MAX_PATH = 260
Public Const EM_LINESCROLL = &HB6
Public Const SW_SHOWNORMAL = 1

Private Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, lpSecurityAttributes As SECURITY_ATTRIBUTES, phkResult As Long, lpdwDisposition As Long) As Long
Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Private Declare Function RegSetStringValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long
Private Declare Function RegSetLongValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Long, ByVal cbData As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As Long, lpcbData As Long) As Long
Private Declare Function RegQueryStringValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long
Private Declare Function RegQueryLongValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Long, lpcbData As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Public Declare Function GetTempFileName Lib "kernel32" Alias "GetTempFileNameA" (ByVal lpszPath As String, ByVal lpPrefixString As String, ByVal wUnique As Long, ByVal lpTempFileName As String) As Long
Public Declare Sub GetSystemTime Lib "kernel32" (lpSystemTime As SYSTEMTIME)
Public Declare Function SystemTimeToFileTime Lib "kernel32" (lpSystemTime As SYSTEMTIME, lpFileTime As FILETIME) As Long
Public Declare Function GetTickCount Lib "kernel32" () As Long
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

Public Sub SaveRegKeys()
   Dim lRetVal As Long, hKey As Long
   
   lRetVal = RegOpenKeyEx(HKEY_CURRENT_USER, REGISTRY_LOCATION, 0, KEY_SET_VALUE, hKey)
   If lRetVal <> ERROR_SUCCESS Then
      Dim SecAttrbs As SECURITY_ATTRIBUTES
      With SecAttrbs
         .nLength = 12
         .lpSecurityDescriptor = 0
         .bInheritHandle = 0
      End With
      
      lRetVal = RegCreateKeyEx(HKEY_CURRENT_USER, _
                               REGISTRY_LOCATION, _
                               0, _
                               vbNullString, _
                               REG_OPTION_NON_VOLATILE, _
                               KEY_ALL_ACCESS, _
                               SecAttrbs, _
                               hKey, _
                               0)
   End If
   
   If lRetVal = ERROR_SUCCESS Then
      ' Step 1 Page
      SetLngValue hKey, "nTimeout", CLng(frmStep1.txtTimeout)
      
      ' Step 2 Page
      SetStrValue hKey, "sMWLServerAE", frmStep2.txtServerAETitle
      SetStrValue hKey, "sMWLServerIP", frmStep2.txtServerIPAddress
      SetLngValue hKey, "nMWLServerPort", CLng(frmStep2.txtServerPortNumber)
      SetStrValue hKey, "sMWLClientAE", frmStep2.txtClientAETitle
      If frmStep2.gbServerVerified Then
         SetLngValue hKey, "bMWLServerVerified", 1
      Else
         SetLngValue hKey, "bMWLServerVerified", 0
      End If
      
      ' Step 3 Page
      If frmStep3.optBroadModalityWLQuery Then
         SetLngValue hKey, "nQueryType", 0
      Else
         SetLngValue hKey, "nQueryType", 1
      End If
      If frmStep3.chkSPSStartDate Then
         SetLngValue hKey, "bCheckDate", 1
      Else
         SetLngValue hKey, "bCheckDate", 0
      End If
      SetStrValue hKey, "sStartDate", frmStep3.dtpSPSStartDate
      If frmStep3.chkModality Then
         SetLngValue hKey, "bCheckModality", 1
      Else
         SetLngValue hKey, "bCheckModality", 0
      End If
      On Error Resume Next
      SetStrValue hKey, "sModality", ModalityArray(frmStep3.cboModality.ListIndex, 0)
      On Error GoTo 0
      SetStrValue hKey, "sPatientName", frmStep3.txtPatientName
      SetStrValue hKey, "sPatientID", frmStep3.txtPatientID
      SetStrValue hKey, "sAccessionNumber", frmStep3.txtAccessionNumber
      SetStrValue hKey, "sRequestedProcedureID", frmStep3.txtRequestedProcedureID
      
      ' Step 7 Page
      If frmStep7.optSendToServer Then
         SetLngValue hKey, "bUseStorageServer", 1
      Else
         SetLngValue hKey, "bUseStorageServer", 0
      End If
      SetStrValue hKey, "sStorageServerAE", frmStep7.txtServerAETitle
      SetStrValue hKey, "sStorageServerIP", frmStep7.txtServerIPAddress
      SetLngValue hKey, "nStorageServerPort", CLng(frmStep7.txtServerPortNumber)
      SetStrValue hKey, "sStorageClientAE", frmStep7.txtClientAETitle
      If frmStep7.gbServerVerified Then
         SetLngValue hKey, "bStorageServerVerified", 1
      Else
         SetLngValue hKey, "bStorageServerVerified", 0
      End If
      
      RegCloseKey hKey
   End If
End Sub

Public Sub LoadRegKeys()
   Dim lRetVal As Long, hKey As Long
   lRetVal = RegOpenKeyEx(HKEY_CURRENT_USER, REGISTRY_LOCATION, 0, KEY_QUERY_VALUE, hKey)
   If lRetVal = ERROR_SUCCESS Then
      Dim sValue As String, lValue As Long
      
      ' Step 1 Page
      If QueryLngValue(hKey, "nTimeout", lValue) Then
         frmStep1.txtTimeout = CStr(lValue)
      End If
      
      ' Step 2 Page
      If QueryStrValue(hKey, "sMWLServerAE", sValue) Then
         frmStep2.txtServerAETitle = sValue
      End If
      If QueryStrValue(hKey, "sMWLServerIP", sValue) Then
         frmStep2.txtServerIPAddress = sValue
      End If
      If QueryLngValue(hKey, "nMWLServerPort", lValue) Then
         frmStep2.txtServerPortNumber = CStr(lValue)
      End If
      If QueryStrValue(hKey, "sMWLClientAE", sValue) Then
         frmStep2.txtClientAETitle = sValue
      End If
      If QueryLngValue(hKey, "bMWLServerVerified", lValue) Then
         frmStep2.gbServerVerified = (lValue = 1)
         frmStep2.cmdNext.Enabled = frmStep2.gbServerVerified
      End If
            
      ' Step 3 Page
      If QueryLngValue(hKey, "nQueryType", lValue) Then
         frmStep3.optBroadModalityWLQuery = (lValue = 0)
         frmStep3.optPatientBasedQuery = Not frmStep3.optBroadModalityWLQuery
      End If
      If QueryLngValue(hKey, "bCheckDate", lValue) Then
         frmStep3.chkSPSStartDate = lValue
      End If
      If QueryStrValue(hKey, "sStartDate", sValue) Then
         frmStep3.dtpSPSStartDate = sValue
      End If
      If QueryLngValue(hKey, "bCheckModality", lValue) Then
         frmStep3.chkModality = lValue
      End If
      If QueryStrValue(hKey, "sModality", sValue) Then
         Dim I As Integer
         For I = 0 To UBound(ModalityArray)
            If ModalityArray(I, 0) = sValue Then
               On Error Resume Next
               frmStep3.cboModality.ListIndex = I
               On Error GoTo 0
               Exit For
            End If
         Next
      End If
      If QueryStrValue(hKey, "sPatientName", sValue) Then
         frmStep3.txtPatientName = sValue
      End If
      If QueryStrValue(hKey, "sPatientID", sValue) Then
         frmStep3.txtPatientID = sValue
      End If
      If QueryStrValue(hKey, "sAccessionNumber", sValue) Then
         frmStep3.txtAccessionNumber = sValue
      End If
      If QueryStrValue(hKey, "sRequestedProcedureID", sValue) Then
         frmStep3.txtRequestedProcedureID = sValue
      End If
      
      ' Step 7 Page
      If QueryLngValue(hKey, "bUseStorageServer", lValue) Then
         frmStep7.optSendToServer = (lValue = 1)
         frmStep7.optStoreLocally = Not frmStep7.optSendToServer
      End If
      If QueryStrValue(hKey, "sStorageServerAE", sValue) Then
         frmStep7.txtServerAETitle = sValue
      End If
      If QueryStrValue(hKey, "sStorageServerIP", sValue) Then
         frmStep7.txtServerIPAddress = sValue
      End If
      If QueryLngValue(hKey, "nStorageServerPort", lValue) Then
         frmStep7.txtServerPortNumber = CStr(lValue)
      End If
      If QueryStrValue(hKey, "sStorageClientAE", sValue) Then
         frmStep7.txtClientAETitle = sValue
      End If
      If QueryLngValue(hKey, "bStorageServerVerified", lValue) Then
         frmStep7.gbServerVerified = (lValue = 1)
         frmStep7.cmdNext.Enabled = frmStep7.optStoreLocally Or frmStep7.gbServerVerified
      End If
   
      RegCloseKey hKey
   End If
End Sub

Private Function SetStrValue(hKey As Long, sValueName As String, sValue As String) As Boolean
   Dim lRetVal As Long
   lRetVal = RegSetStringValueEx(hKey, sValueName, 0, REG_SZ, sValue, Len(sValue))
   SetStrValue = (lRetVal = ERROR_SUCCESS)
End Function

Private Function SetLngValue(hKey As Long, sValueName As String, lValue As Long) As Boolean
   Dim lRetVal As Long
   lRetVal = RegSetLongValueEx(hKey, sValueName, 0, REG_DWORD, lValue, 4)
   SetLngValue = (lRetVal = ERROR_SUCCESS)
End Function

Private Function QueryStrValue(hKey As Long, sValueName As String, sValue As String) As Boolean
   QueryStrValue = False
   
   Dim lRetVal As Long
   Dim lSize As Long
   
   lRetVal = RegQueryValueEx(hKey, sValueName, 0, 0, 0, lSize)
   If lRetVal <> ERROR_SUCCESS Then Exit Function
   
   sValue = Space(lSize)
   lRetVal = RegQueryStringValueEx(hKey, sValueName, 0, 0, sValue, lSize)
   If lRetVal = ERROR_SUCCESS Then
      If lSize Then sValue = Left(sValue, lSize - 1)
      QueryStrValue = True
      Exit Function
   End If
End Function

Private Function QueryLngValue(hKey As Long, sValueName As String, lValue As Long) As Boolean
   QueryLngValue = False
   
   Dim lRetVal As Long
   Dim lSize As Long
   
   lRetVal = RegQueryValueEx(hKey, sValueName, 0, 0, 0, lSize)
   If lRetVal <> ERROR_SUCCESS Then Exit Function
   
   lRetVal = RegQueryLongValueEx(hKey, sValueName, 0, 0, lValue, lSize)
   If lRetVal = ERROR_SUCCESS Then
      QueryLngValue = True
      Exit Function
   End If
End Function

Public Sub Cancel()
   Unload frmStep1
   Unload frmStep2
   Unload frmStep3
   Unload frmStep4
   Unload frmStep5
   Unload frmStep6
   Unload frmStep7
   Unload frmThankYou
   End
End Sub

Public Function GetStatusString(lStatus As Long) As String
   GetStatusString = "Unknown"
   
   Select Case lStatus
   Case COMMAND_STATUS_SUCCESS
      GetStatusString = "Success"
      
   Case COMMAND_STATUS_CANCEL
      GetStatusString = "Cancel"
      
   Case COMMAND_STATUS_ATTRIBUTE_LIST_ERROR
      GetStatusString = "Attribute List Error"
   
   Case COMMAND_STATUS_ATTRIBUTE_OUT_OF_RANGE
      GetStatusString = "Attribute Value Out of Range"
   
   Case COMMAND_STATUS_CLASS_NOT_SUPPORTED
      GetStatusString = "Class Not Supported"
   
   Case COMMAND_STATUS_CLASE_INSTANCE_CONFLICT
      GetStatusString = "Class Instance conflict"
   
   Case COMMAND_STATUS_DUPLICATE_INSTANCE
      GetStatusString = "Duplicate Instance"
   
   Case COMMAND_STATUS_DUPLICATE_INVOCATION
      GetStatusString = "Duplicate invocation"
   
   Case COMMAND_STATUS_INVALID_ARGUMENT_VALUE
      GetStatusString = "Invalid Argument Value"
   
   Case COMMAND_STATUS_INVALID_ATTRIBUTE_VALUE
      GetStatusString = "Invalid Attribute Value"
   
   Case COMMAND_STATUS_INVALID_OBJECT_INSTANCE
      GetStatusString = "Ivalid Object Instance"
   
   Case COMMAND_STATUS_MISSING_ATTRIBUTE
      GetStatusString = "Missing Attribute"
   
   Case COMMAND_STATUS_MISSING_ATTRIBUTE_VALUE
      GetStatusString = "Missing Attribute value"
   
   Case COMMAND_STATUS_MISTYPED_ARGUMENT
      GetStatusString = "Mistyped Argument"
   
   Case COMMAND_STATUS_NO_SUCH_ARGUMENT
      GetStatusString = "No Such Argument"
   
   Case COMMAND_STATUS_NO_SUCH_ATTRIBUTE
      GetStatusString = "No Such Attribute"
   
   Case COMMAND_STATUS_NO_SUCH_EVENT_TYPE
      GetStatusString = "No Such Event Type"
   
   Case COMMAND_STATUS_NO_SUCH_OBJECT_INSTANCE
      GetStatusString = "No Such Object Instance"
   
   Case COMMAND_STATUS_NO_SUCH_CLASS
      GetStatusString = "No Such Class"
   
   Case COMMAND_STATUS_PROCESSING_FAILURE
      GetStatusString = "Proccesing Failure"
   
   Case COMMAND_STATUS_RESOURCE_LIMITATION
      GetStatusString = "Resource Limitation"
   
   Case COMMAND_STATUS_UNRECOGNIZED_OPERATION
      GetStatusString = "Unrecognized Operation"
   
   Case COMMAND_STATUS_PENDING
      GetStatusString = "Pending"
   
   Case COMMAND_STATUS_PENDING_WARNING
      GetStatusString = "Pending Warning"
   End Select
End Function

Public Sub InitializeModalityArray()
   ModalityArray(0, 0) = "SC"
   ModalityArray(0, 1) = "Secondary Capture Image"
   ModalityArray(0, 2) = CStr(DICOM_CLASS_SC_IMAGE_STORAGE)
   
   ModalityArray(1, 0) = "CR"
   ModalityArray(1, 1) = "Computed Radiography"
   ModalityArray(1, 2) = CStr(DICOM_CLASS_CR_IMAGE_STORAGE)
   
   ModalityArray(2, 0) = "CT"
   ModalityArray(2, 1) = "Computed Tomography"
   ModalityArray(2, 2) = CStr(DICOM_CLASS_CT_IMAGE_STORAGE)
   
   ModalityArray(3, 0) = "MR"
   ModalityArray(3, 1) = "Magnetic Resonance"
   ModalityArray(3, 2) = CStr(DICOM_CLASS_MR_IMAGE_STORAGE)
   
   ModalityArray(4, 0) = "NM"
   ModalityArray(4, 1) = "Nuclear Medicine"
   ModalityArray(4, 2) = CStr(DICOM_CLASS_NM_IMAGE_STORAGE)
   
   ModalityArray(5, 0) = "US"
   ModalityArray(5, 1) = "Ultrasound"
   ModalityArray(5, 2) = CStr(DICOM_CLASS_US_IMAGE_STORAGE)
   
   ModalityArray(6, 0) = "ES"
   ModalityArray(6, 1) = "Endoscopy"
   ModalityArray(6, 2) = CStr(DICOM_CLASS_VL_ENDOSCOPIC_IMAGE_STORAGE)
   
   ModalityArray(7, 0) = "XA"
   ModalityArray(7, 1) = "X-Ray Angiography"
   ModalityArray(7, 2) = CStr(DICOM_CLASS_XA_IMAGE_STORAGE)
   
   ModalityArray(8, 0) = "RF"
   ModalityArray(8, 1) = "Radio Fluoroscopy"
   ModalityArray(8, 2) = CStr(DICOM_CLASS_XRF_IMAGE_STORAGE)
   
   ModalityArray(9, 0) = "RTIMAGE"
   ModalityArray(9, 1) = "Radiotherapy Image"
   ModalityArray(9, 2) = CStr(DICOM_CLASS_RT_IMAGE_STORAGE)
   
   ModalityArray(10, 0) = "RTDOSE"
   ModalityArray(10, 1) = "Radiotherapy Dose"
   ModalityArray(10, 2) = CStr(DICOM_CLASS_RT_DOSE_STORAGE)
   
   ModalityArray(11, 0) = "RTSTRUCT"
   ModalityArray(11, 1) = "Radiotherapy Structure Set"
   ModalityArray(11, 2) = CStr(DICOM_CLASS_RT_STRUCTURE_SET_STORAGE)
   
   ModalityArray(12, 0) = "RTPLAN"
   ModalityArray(12, 1) = "Radiotherapy Plan"
   ModalityArray(12, 2) = CStr(DICOM_CLASS_RT_PLAN_STORAGE)
   
   ModalityArray(13, 0) = "DX"
   ModalityArray(13, 1) = "Digital Radiography"
   ModalityArray(13, 2) = CStr(DICOM_CLASS_DX_IMAGE_STORAGE_PRESENTATION)
   
   ModalityArray(14, 0) = "MG"
   ModalityArray(14, 1) = "Mammography"
   ModalityArray(14, 2) = CStr(DICOM_CLASS_DX_MAMMOGRAPHY_IMAGE_STORAGE_PRESENTATION)
   
   ModalityArray(15, 0) = "IO"
   ModalityArray(15, 1) = "Intra-oral Radiography"
   ModalityArray(15, 2) = CStr(DICOM_CLASS_DX_INTRAORAL_IMAGE_STORAGE_PRESENTATION)
   
   ModalityArray(16, 0) = "PX"
   ModalityArray(16, 1) = "Panoramic X-Ray"
   ModalityArray(16, 2) = CStr(DICOM_CLASS_DX_IMAGE_STORAGE_PRESENTATION)
   
   ModalityArray(17, 0) = "GM"
   ModalityArray(17, 1) = "General Microscopy"
   ModalityArray(17, 2) = CStr(DICOM_CLASS_VL_MICROSCOPIC_IMAGE_STORAGE)
   
   ModalityArray(18, 0) = "SM"
   ModalityArray(18, 1) = "Slide Microscopy"
   ModalityArray(18, 2) = CStr(DICOM_CLASS_VL_SLIDE_COORDINATES_MICROSCOPIC_IMAGE_STORAGE)
   
   ModalityArray(19, 0) = "XC"
   ModalityArray(19, 1) = "External-camera Photography"
   ModalityArray(19, 2) = CStr(DICOM_CLASS_VL_PHOTOGRAPHIC_IMAGE_STORAGE)
End Sub