ISPatient.CreateMovement

Example

Add a new movement for the selected patient and display the movements of this patient before and after adding a new one.

sub main
  Dim aPatient 
  Dim aMovementType
  Dim aDate
  Dim aCases
  Dim aCase
  Dim aPOS
  Dim aResultCode
  Dim aCreatedMovement

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

  Set aCase = Profile.OpenCase(aCaseID)
  set aPatient = Profile.LoadPatient(aPatientID)

  set aMovements = aPatient.Movements  
  if aMovements.Count > 0 then
    aMessage = aMessage & vbNewLine &_ 
      "    Movements Count before adding a new one = " & aMovements.Count & ":" 
    for each aMovement in aMovements
      aMessage = aMessage & vbNewLine & "       -Type: " &_ 
        GetMovType(aMovement.MovType) & " (" & aMovement.Date & ")" 
    next
  end if      

  aMovementType = 3 'tsmsMove
  aDate = #12/27/2019#
  aPOSId = Profile.CurrentPOSId
  set aPOS = Profile.LoadProviderById(aPOSId)

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

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

  set aMovements = aPatient.Movements  
  if aMovements.Count > 0 then
    aMessage = aMessage & 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
  end if      

  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