patientexplorer.pas

PatientRunner 20 Source

  end;
end;

procedure TPatientExplorerForm.EditMedicationClick(Sender: TObject);
begin
  if MedicationsListView.Items.Count<=0 then Exit;
  if MedicationsListView.ItemFocused=nil then Exit;
  if not Assigned(MedicationsListView.ItemFocused.Data) then Exit;

  with PMedicationRecord(MedicationsListView.ItemFocused.Data)^ do
  begin
    with MedicationEditorForm do
    begin
      NewRecord:=False;
      PrescriptionEdit.Text:=Prescription;
      StartDatePicker.Date:=StartDate;
      EndDatePicker.Date:=EndDate;
      DiscontinuedCheckBox.Checked:=Discontinued;
      ShowModal;
    end;
  end;
end;

procedure TPatientExplorerForm.DeleteMedicationClick(Sender: TObject);
begin
  if MedicationsListView.Items.Count<=0 then Exit;
  if MedicationsListView.ItemFocused=nil then Exit;
  if not Assigned(MedicationsListView.ItemFocused.Data) then Exit;

  if PMedicationRecord(MedicationsListView.ItemFocused.Data)^.Author<>
    MainForm.SQLConnection.Params.Values['User_Name'] then
  begin
    MessageDlg('Unable to delete - You are not the author of this medication', mtError, [mbOk], 0);
    Exit;
  end;

  if MessageDlg('Are you sure you want to delete the selected medication?',
                mtConfirmation, [mbYes, mbNo], 0) <> mrYes then Exit;

  with SQLQuery do
  begin
    SQL.Clear;
    SQL.Add('delete from medications where medicationid='+
            inttostr(PMedicationRecord(MedicationsListView.ItemFocused.Data)^.MedicationID) );
    ExecSQL;
  end;

  Dispose(PMedicationRecord(MedicationsListView.ItemFocused.Data));
  MedicationsListView.ItemFocused.Delete;

  MedicationsListViewClick(Sender);
end;

procedure TPatientExplorerForm.RefreshMedsDBClick(Sender: TObject);
var MedicationRecordPtr: PMedicationRecord;
    SelectedMedicationIDHolder, i: integer;
    Save_Cursor: TCursor;
begin
  Save_Cursor:=Screen.Cursor;
  Screen.Cursor:=crSQLWait;

  SelectedMedicationIDHolder:=-1;
  if MedicationsListView.ItemFocused<>nil then
  begin
    if Assigned(MedicationsListView.ItemFocused.Data) then
      SelectedMedicationIDHolder:=PMedicationRecord(MedicationsListView.ItemFocused.Data)^.MedicationID;
  end;

  MedicationsListView.Items.BeginUpdate;

  CleanUpMedicationsListView;

  with SQLQuery do
  begin
    SQL.Clear;

    SQL.Add('select * from medications where patientid='+IntToStr(PPatientRecord(MainForm.PatientListView.ItemFocused.Data)^.PatientID)+' order by discontinued, startdate');

    Open;
    First;
    while (not EOF) do
    begin
      new(MedicationRecordPtr);
      with MedicationRecordPtr^ do
      begin
        MedicationID:=FieldByName('medicationid').AsInteger;
        PatientID:=FieldByName('patientid').AsInteger;
        Prescription:=FieldByName('prescription').AsString;
        StartDate:=StrtoDateTime(FieldByName('startdate').AsString);
        EndDate:=StrtoDateTime(FieldByName('enddate').AsString);
        Discontinued:=Boolean(FieldByName('discontinued').AsInteger);
        Author:=FieldByName('author').AsString;
        with MedicationsListView.Items.Add do
        begin
          if Discontinued then
            Caption:=Prescription+' '+AgetoStr(StartDate, EndDate)
          else
            Caption:=Prescription+' '+AgetoStr(StartDate, Now() );
          Data:=TObject(MedicationRecordPtr);
        end;
      end;
      Next;
    end;
    Close;
  end;
  MedicationsListView.Items.EndUpdate;
  Screen.Cursor := Save_Cursor;

  if (SelectedMedicationIDHolder=-1) or (MedicationsListView.Items.Count<=0) then
  begin
    MedicationsListViewClick(Sender);
    Exit;
  end;

  for i:=0 to MedicationsListView.Items.Count-1 do
  begin
    if PMedicationRecord(MedicationsListView.Items[i].Data)^.MedicationID = SelectedMedicationIDHolder then
    begin
      MedicationsListView.Selected := MedicationsListView.Items[i];
      MedicationsListView.ItemFocused := MedicationsListView.Items[i];
      Break;
    end;
  end;

  MedicationsListViewClick(Sender);
end;

{-----------------------------------------------------
Form stuff
------------------------------------------------------}

procedure TPatientExplorerForm.FormShow(Sender: TObject);
begin
  //When the form is shown for the first time, it will be unpopulated
  //All the editing controls such as the rich edit, note description and
  //dictation pending checkbox should be read only or disabled by default
  //The disabling should have been done at design time

  //Make sure that the NotesListVie has focus
  ActiveControl:=NotesListView;

  //Initialize all four databases!
  RefreshNotesDBClick(Sender);
  RefreshScalesDBClick(Sender);
  RefreshDiagnosesDBClick(Sender);
  RefreshMedsDBClick(Sender);
end;

procedure TPatientExplorerForm.PrintSetupClick(Sender: TObject);
begin
  PrinterSetupDialog.Execute;
end;

procedure TPatientExplorerForm.PrintPreviewClick(Sender: TObject);
var ColorHolder: TColor;
begin
  ColorHolder:=NoteRichEdit.Color;
  NoteRichEdit.Color:=clWindow;
  with QuickReportModule do
  begin
    PageHeaderBand.Enabled:=not DisableHeaderandFooter.Checked;
    PageFooterBand.Enabled:=not DisableHeaderandFooter.Checked;
    PatientQRLabel.Caption:=Label1.Caption;
    Preview;
  end;
  NoteRichEdit.Color:=ColorHolder;
end;

procedure TPatientExplorerForm.PrintClick(Sender: TObject);
var ColorHolder: TColor;
begin
  ColorHolder:=NoteRichEdit.Color;
  NoteRichEdit.Color:=clWindow;
  with QuickReportModule do
  begin
    PageHeaderBand.Enabled:=not DisableHeaderandFooter.Checked;
    PageFooterBand.Enabled:=not DisableHeaderandFooter.Checked;
    PatientQRLabel.Caption:=Label1.Caption;
    Print;
  end;
  NoteRichEdit.Color:=ColorHolder;
end;

procedure TPatientExplorerForm.DisableHeaderandFooterClick(
  Sender: TObject);
begin
  //Checkboxes are linked
  DisableHeaderandFooter2.Checked:=TMenuItem(Sender).Checked;
end;

procedure TPatientExplorerForm.DisableHeaderandFooter2Click(
  Sender: TObject);
begin
  //Checkboxes are linked
  DisableHeaderandFooter.Checked:=TMenuItem(Sender).Checked;
end;

procedure TPatientExplorerForm.FormClose(Sender: TObject;
  var Action: TCloseAction);
var i: integer;
begin
  for i:=0 to NotesListView.Items.Count-1 do
  begin
    if PNoteRecord(NotesListView.Items[i].Data)^.Modded or DescriptionEdit.Modified or NoteRichEdit.Modified then
    begin
      if MessageDlg('At least one note has been modified.  Exit without saving changes?', mtConfirmation, [mbYes, mbNo], 0) <> mrYes then
      begin
        Action:=caNone;
        Exit;
      end;
      Break;
    end;
  end;

  //important to destroy lists on close
  //if list exists when form shown again, IDHolder routines will be messed up in Refresh procs

  NotesListView.Items.BeginUpdate;
  CleanUpNotesListView;
  NotesListView.Items.EndUpdate;

  ScalesListView.Items.BeginUpdate;
  CleanUpScalesListView;
  ScalesListView.Items.EndUpdate;

  DiagnosesListView.Items.BeginUpdate;
  CleanUpDiagnosesListView;
  DiagnosesListView.Items.EndUpdate;

  MedicationsListView.Items.BeginUpdate;
  CleanupMedicationsListView;
  MedicationsListView.Items.EndUpdate;
end;

{----------------------------------------------
rich edit stuff
-----------------------------------------------}

function EnumFontsProc(var LogFont: TLogFont; var TextMetric: TTextMetric;
  FontType: Integer; Data: Pointer): Integer; stdcall;
begin
  TStrings(Data).Add(LogFont.lfFaceName);
  Result := 1;
end;

procedure TPatientExplorerForm.GetFontNames;
var
  DC: HDC;
begin
  DC := GetDC(0);
  EnumFonts(DC, nil, @EnumFontsProc, Pointer(FontName.Items));
  ReleaseDC(0, DC);
  FontName.Sorted := True;
end;

function TPatientExplorerForm.CurrText: TTextAttributes;
begin
  if NoteRichEdit.SelLength > 0 then
    Result := NoteRichEdit.SelAttributes
  else
    Result := NoteRichEdit.DefAttributes;
end;

procedure TPatientExplorerForm.SelectionChange(Sender: TObject);
begin
with NoteRichEdit.Paragraph do
  try
    FUpdating := True;
    //FirstInd.Left := Trunc(FirstIndent*RulerAdj)-4+GutterWid;
    //LeftInd.Left := Trunc((LeftIndent+FirstIndent)*RulerAdj)-4+GutterWid;
    //RightInd.Left := Ruler.ClientWidth-6-Trunc((RightIndent+GutterWid)*RulerAdj);
    BoldButton.Down := fsBold in NoteRichEdit.SelAttributes.Style;
    ItalicButton.Down := fsItalic in NoteRichEdit.SelAttributes.Style;
    UnderlineButton.Down := fsUnderline in NoteRichEdit.SelAttributes.Style;
    BulletsButton.Down := Boolean(Numbering);
    FontSize.Text := IntToStr(NoteRichEdit.SelAttributes.Size);
    FontName.Text := NoteRichEdit.SelAttributes.Name;
    case Ord(Alignment) of
      0: LeftAlign.Down := True;
      1: RightAlign.Down := True;
      2: CenterAlign.Down := True;
    end;
    //UpdateCursorPos; for status bar
  finally
    FUpdating := False;
  end;
end;

procedure TPatientExplorerForm.FontClick(Sender: TObject);
begin
  FontDialog.Font.Assign(NoteRichEdit.SelAttributes);
  if FontDialog.Execute then
    CurrText.Assign(FontDialog.Font);
  SelectionChange(Self);
  NoteRichEdit.SetFocus;
end;

procedure TPatientExplorerForm.UndoClick(Sender: TObject);
begin
  with NoteRichEdit do
    if HandleAllocated then SendMessage(Handle, EM_UNDO, 0, 0);
end;

procedure TPatientExplorerForm.CutClick(Sender: TObject);
begin
  NoteRichEdit.CutToClipboard;
end;

procedure TPatientExplorerForm.CopyClick(Sender: TObject);
begin
  NoteRichEdit.CopyToClipboard;
end;

procedure TPatientExplorerForm.PasteClick(Sender: TObject);
begin
  NoteRichEdit.PasteFromClipboard;
end;

procedure TPatientExplorerForm.FontNameChange(Sender: TObject);
begin
  if FUpdating then Exit;
  CurrText.Name := FontName.Items[FontName.ItemIndex];
end;

procedure TPatientExplorerForm.FontSizeChange(Sender: TObject);
begin
  if FUpdating then Exit;
  CurrText.Size := StrToInt(FontSize.Text);
end;

procedure TPatientExplorerForm.BoldButtonClick(Sender: TObject);
begin
  if FUpdating then Exit;
  if BoldButton.Down then
    CurrText.Style := CurrText.Style + [fsBold]
  else
    CurrText.Style := CurrText.Style - [fsBold];
end;

procedure TPatientExplorerForm.ItalicButtonClick(Sender: TObject);
begin
  if FUpdating then Exit;
  if ItalicButton.Down then
    CurrText.Style := CurrText.Style + [fsItalic]
  else
    CurrText.Style := CurrText.Style - [fsItalic];
end;

procedure TPatientExplorerForm.UnderlineButtonClick(Sender: TObject);
begin
  if FUpdating then Exit;
  if UnderlineButton.Down then
    CurrText.Style := CurrText.Style + [fsUnderline]
  else
    CurrText.Style := CurrText.Style - [fsUnderline];
end;

procedure TPatientExplorerForm.AlignButtonClick(Sender: TObject);
begin
  if FUpdating then Exit;
  NoteRichEdit.Paragraph.Alignment := TAlignment(TControl(Sender).Tag);
end;

procedure TPatientExplorerForm.BulletsButtonClick(Sender: TObject);
begin
  if FUpdating then Exit;
  NoteRichEdit.Paragraph.Numbering := TNumberingStyle(BulletsButton.Down);
end;

procedure TPatientExplorerForm.FormCreate(Sender: TObject);
begin
  NoteRichEdit.OnDblClick := EditNoteClick;

  GetFontNames;
  SelectionChange(Self);

  CurrText.Name := DefFontData.Name;
  CurrText.Size := -MulDiv(DefFontData.Height, 72, Screen.PixelsPerInch);

  PreviousItem:=nil;
end;

procedure TPatientExplorerForm.PasteDiagnosesListClick(Sender: TObject);
begin
  if NoteRichEdit.ReadOnly then Exit;

  with SQLQuery do
  begin
    SQL.Clear;
    SQL.Add('select * from diagnoses where patientid='+InttoStr(PPatientRecord(MainForm.PatientListView.ItemFocused.Data)^.PatientID)+' order by startdate');
    Open;
    First;
    while (not EOF) do
    begin
      if not Boolean(FieldByName('resolved').AsInteger) then
      begin
        NoteRichEdit.SelText:=FieldByName('diagnosis').AsString+#13#10;
      end;
      Next;
    end;
    Close;
  end;
end;

procedure TPatientExplorerForm.PasteMedicationsListClick(Sender: TObject);
begin
  if NoteRichEdit.ReadOnly then Exit;
  
  with SQLQuery do
  begin
    SQL.Clear;
    SQL.Add('select * from medications where patientid='+InttoStr(PPatientRecord(MainForm.PatientListView.ItemFocused.Data)^.PatientID)+' order by startdate');
    Open;
    First;
    while (not EOF) do
    begin
      if not Boolean(FieldByName('discontinued').AsInteger) then
      begin
        NoteRichEdit.SelText:=FieldByName('prescription').AsString+' '
                             +AgetoStr(StrtoDateTime(FieldByName('startdate').AsString), Now() )
                             +#13#10;
      end;
      Next;
    end;
    Close;
  end;
end;

procedure TPatientExplorerForm.Spelling1Click(Sender: TObject);
begin
  AddictSpell31.CheckWinControl( NoteRichEdit, ctAll );
end;

procedure TPatientExplorerForm.Spellcheckoptions1Click(Sender: TObject);
begin
  AddictSpell31.Setup;
end;

end.