Content Supported by Sourcelens Consulting

VERSION 5.00
Begin VB.Form frmClaimProcessing 
   Caption         =   "Claim Processing"
   ClientHeight    =   3585
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   2520
   LinkTopic       =   "Form1"
   ScaleHeight     =   3585
   ScaleWidth      =   2520
   StartUpPosition =   3  'Windows Default
   Begin VB.ListBox lstPendingMessages 
      Height          =   3375
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   2295
   End
End
Attribute VB_Name = "frmClaimProcessing"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

'--------------------------------------------------------------
'This form is acutally used in 2 different programs,
'the 'claim processor' & the 'accounting dept' processor.
'The logic in both cases is identical, only the queue names change
'--------------------------------------------------------------
#If CLAIM_PROCESSING Then
    'QUEUE NAMES
    Const RECIEVE_QUEUE = INSURANCE_CLAIMS_QUEUE_NAME
    Const SEND_QUEUE = INSURANCE_ACCOUNTING_QUEUE_NAME

    'UI STUFF
    Const FORM_CAPTION = "Claim Processing Department"

#ElseIf ACCOUNTING_PROCESSING Then
    'QUEUE NAMES
    Const RECIEVE_QUEUE = INSURANCE_ACCOUNTING_QUEUE_NAME
    Const SEND_QUEUE = "" 'No queue to send to, this is the last stage in the workflow

    'UI STUFF
    Const FORM_CAPTION = "Accounting Department"
#End If

Private m_mqRecieveQueue As MSMQQueue 'Queue for claims coming in
Private m_mqSendQueue As MSMQQueue 'Queue for claims going out
Private WithEvents MessageQueueEvents_RecieveQueue As MSMQEvent
Attribute MessageQueueEvents_RecieveQueue.VB_VarHelpID = -1


Private Sub Form_Load()
    Me.Caption = FORM_CAPTION
    InitializeQueueAccess
    DoEvents 'Allow the mesage arrival events to fire before we bring up the UI
End Sub

'---------------------------------------------
'Sets our access up to messages queues that recieve/send messages & hooks up the event handling for the recieve queue
'
' [11/13/97, IvoSa] Created
'---------------------------------------------
Sub InitializeQueueAccess()
    'Open the queue
    OpenMessageQueueForRecieve
    OpenMessageQueueForSend

'    'Fill list with message headers
'    FillPendingMessagesList
    
    '-----------------------------------------
    'Set up the event to get notification when messages arrive (this will fire immediately if there are messages in the queue)
    '-----------------------------------------
    Set MessageQueueEvents_RecieveQueue = New MSMQEvent
    m_mqRecieveQueue.EnableNotification MessageQueueEvents_RecieveQueue
End Sub

'---------------------------------------------
'Fill our entire list with the labels of pending messages
' [in] colLabels : Collection of labels
'---------------------------------------------
Sub resyncPendingMessageList(ByVal colLabels As Collection)
Dim vntLabel As Variant
    lstPendingMessages.Clear
    
    For Each vntLabel In colLabels
        lstPendingMessages.AddItem CStr(vntLabel)
    Next
End Sub

Private Sub lstPendingMessages_DblClick()
    ShowIndividualClaim lstPendingMessages.List(lstPendingMessages.ListIndex)
End Sub

'---------------------------------------------
'Shows the claim for an individual person
'---------------------------------------------
Sub ShowIndividualClaim(strLabel As String)
Dim objMsg As MSMQMessage
    Set objMsg = getMessageGivenLabelAndQueue(m_mqRecieveQueue, strLabel)
    
    If (objMsg Is Nothing) Then
        MsgBox "The messge " & strLabel & "no longer exists"
        Exit Sub
    End If
    
    'Depersist the message
    Dim objStrBag As StringBag
    Set objStrBag = New StringBag
    objStrBag.DeSerialize objMsg.Body
    
    'Show a form with this data
    Dim frm As frmProcessClaim
    Set frm = New frmProcessClaim
    frm.Initailzie objStrBag, m_mqSendQueue
    frm.Show
    DoEvents 'Make it paint
    
    'Fill list with message headers again...
    resyncPendingMessageList getLabelsOfMessagesInQueue(m_mqRecieveQueue)
End Sub


'---------------------------------------------------------
'Opens a the 'Claims' message queue for us to submit messages to
' [11/13/97, IvoSa] Created
' [12/6/97, IvoSa] Added error checking
'---------------------------------------------------------
Sub OpenMessageQueueForRecieve()
Dim lngError As Long
Dim strError As String
    
    If RECIEVE_QUEUE <> "" Then
        On Error Resume Next
            Set m_mqRecieveQueue = openMessageQueue(RECIEVE_QUEUE, MQ_RECEIVE_ACCESS, True)
            lngError = Err
            strError = Err.Description
        On Error GoTo 0
    
        If lngError Then
            MsgBox ERROR_TEXT_RUNADMINTOOL & "(specific error text reads: " & strError & ")"
            
            Stop 'Allow the app to be debugged here...
            End 'We should not continue running at this point
        End If
    
    End If
End Sub

'---------------------------------------------------------
'Opens a the 'Claims' message queue for us to submit messages to
' [11/13/97, IvoSa] Created
' [12/6/97, IvoSa] Added error checking
'---------------------------------------------------------
Sub OpenMessageQueueForSend()
Dim lngError As Long
Dim strError As String
    
    If SEND_QUEUE <> "" Then
        On Error Resume Next
            Set m_mqSendQueue = openMessageQueue(SEND_QUEUE, MQ_SEND_ACCESS, True)
            lngError = Err
            strError = Err.Description
        On Error GoTo 0
        
        If lngError Then
            MsgBox ERROR_TEXT_RUNADMINTOOL & "(specific error text reads: " & strError & ")"
            
            Stop 'Allow the app to be debugged here...
            End 'We should not continue running at this point
        End If
    End If
End Sub


'---------------------------------------------------------
'Called when new messages arrive
'---------------------------------------------------------
Private Sub MessageQueueEvents_RecieveQueue_Arrived(ByVal Queue As Object, ByVal Cursor As Long)
Dim colLabels As Collection
    'Get list of message lablels & set the event to fire when the next claim arrives
    Set MessageQueueEvents_RecieveQueue = getEventFireOnNextMessageArrival(m_mqRecieveQueue, colLabels)
    
    resyncPendingMessageList colLabels
End Sub