ISPatient.CreateDischarge

Example

Add two new movements of types 'Admit' and 'Discharge' for the selected patient and display the movements of this patient before and after adding new ones.

sub main
  Dim aResult
  Dim aPatientID
  Dim aCaseID
  Dim aCase
  Dim aPatient
  Dim aMovements, aMovement
  Dim aTrans
  Dim aMovementType
  Dim aDate
  Dim aPOSId
  Dim aPOS
  Dim aNewMov
  Dim aResultCode, aResultCode2 
  Dim aMessage

'*******************************************************************************
  set aTrans = Profile.StartMapTransaction
'*******************************************************************************

  aResult = Profile.Lookup_PatientCaseSearch(aPatientID, aCaseID, "Case Search", True)

  Set aCase = Profile.OpenCase(aCaseID)
  set aPatient = Profile.LoadPatient(aPatientID)
    
  set aMovements = aPatient.Movements  
  
  aMessage = "    Movements Count before adding a new one = " & aMovements.Count
  
  for each aMovement in aMovements
    aMessage = aMessage & vbNewLine & "       -Type: " &_ 
      GetMovType(aMovement.MovType) & " (" & aMovement.Date & ")" 
  next
        
  aMovementType = 0 'tsmsAdmit
  aDate = #09/29/2019#
  aPOSId = Profile.CurrentPOSId
  set aPOS = Profile.LoadProviderById(aPOSId)

  set aNewMov = aPatient.CreateMovement(aMovementType, aDate, aCase, aPOS, aResultCode)

  if aResultCode <> 0 then  
    Profile.MsgBox(GetResultCode(aResultCode))
    exit sub
  end if

'*******************************************************************************
  aTrans.snapshot
'*******************************************************************************
  
  set aMovements = aPatient.Movements  
  aMessage = aMessage & vbNewLine & vbNewLine &_
    "    Movements Count after adding a new one = " & aMovements.Count 
  for each aMovement in aMovements
    aMessage = aMessage & vbNewLine & "       -Type: " &_ 
      GetMovType(aMovement.MovType) & " (" & aMovement.Date & ")" 
  next
       
  aPatient.CreateDischarge now, aNewMov, aResultCode2

  if aResultCode2 <> 0 then  
    Profile.MsgBox(GetResultCode2(aResultCode2))
    exit sub
  end if 

'*******************************************************************************
  aTrans.snapshot
'*******************************************************************************
  
  set aMovements = aPatient.Movements  
  
  aMessage = aMessage & vbNewLine & vbNewLine &_ 
    "    Movements Count after adding a new discharge = " & aMovements.Count
  
  for each aMovement in aMovements
    aMessage = aMessage & vbNewLine & "       -Type: " &_ 
      GetMovType(aMovement.MovType) & " (" & aMovement.Date & ")" 
  next
  
  Profile.MsgBox(aMessage)
end sub

function GetMovType(aMovType)
  Dim aResult

  Select Case aMovType
    Case 0
      aResult = "Admit"
    Case 1
      aResult = "Discharge"
    Case 2
      aResult = "Transfer"
    Case 3
      aResult = "Move"
    Case Default
      aResult = "Unknown"                 
  End Select
    
  GetMovType = aResult
end function

function GetResultCode(aResultCode)
  Dim aResult

  Select Case aResultCode
    Case 1
      aResult = "The date is earlier than previous or is equal to it"
    Case 2
      aResult = "Need confirm multiple admit"
    Case 3
      aResult = "Multiple admit is not allowed"
    Case 4
      aResult = "Patient is not admitted"                 
  End Select
    
  GetResultCode = aResult
end function

function GetResultCode2(aResultCode2)
  Dim aResult

  Select Case aResultCode2
    Case 1
      aResult = "The date is earlier than previous or is equal to it"
    Case 2
      aResult = "Admission Type is invalid"
    Case 3
      aResult = "The Admission is already discharged" 
    Case 4
      aResult = "The Admission is not assigned"              
  End Select
    
  GetResultCode2 = aResult
end function