ISCase.CreateMovement

Example

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

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

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

  Set aCase = Profile.OpenCase(aCaseID)
  set aMovements = aCase.Movements  
  
  aMessage = aCase.CaseTitle & " was opened on " & aCase.OpenedOn & 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    

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

  aCase.CreateMovement aMovementType, aDate, aPOS, aResultCode

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

  set aMovements = aCase.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