| [459] | 1 | unit fPtSelDemog;
 | 
|---|
 | 2 | 
 | 
|---|
 | 3 | interface
 | 
|---|
 | 4 | 
 | 
|---|
 | 5 | uses
 | 
|---|
 | 6 |   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
 | 
|---|
 | 7 |   StdCtrls, ExtCtrls, ORCtrls;
 | 
|---|
 | 8 | 
 | 
|---|
 | 9 | type
 | 
|---|
 | 10 |   TfrmPtSelDemog = class(TForm)
 | 
|---|
 | 11 |     orapnlMain: TORAutoPanel;
 | 
|---|
 | 12 |     lblSSN: TStaticText;
 | 
|---|
 | 13 |     lblPtSSN: TStaticText;
 | 
|---|
 | 14 |     lblDOB: TStaticText;
 | 
|---|
 | 15 |     lblPtDOB: TStaticText;
 | 
|---|
 | 16 |     lblPtSex: TStaticText;
 | 
|---|
 | 17 |     lblPtVet: TStaticText;
 | 
|---|
 | 18 |     lblPtSC: TStaticText;
 | 
|---|
 | 19 |     lblLocation: TStaticText;
 | 
|---|
 | 20 |     lblPtRoomBed: TStaticText;
 | 
|---|
 | 21 |     lblPtLocation: TStaticText;
 | 
|---|
 | 22 |     lblRoomBed: TStaticText;
 | 
|---|
 | 23 |     lblPtName: TStaticText;
 | 
|---|
 | 24 |     Memo: TCaptionMemo;
 | 
|---|
 | 25 |     procedure FormCreate(Sender: TObject);
 | 
|---|
 | 26 |     procedure FormDestroy(Sender: TObject);
 | 
|---|
 | 27 |   private
 | 
|---|
 | 28 |     FLastDFN: string;
 | 
|---|
 | 29 |     FOldWinProc :TWndMethod;
 | 
|---|
 | 30 |     procedure NewWinProc(var Message: TMessage);
 | 
|---|
 | 31 |   public
 | 
|---|
 | 32 |     procedure ClearIDInfo;
 | 
|---|
 | 33 |     procedure ShowDemog(ItemID: string);
 | 
|---|
 | 34 |     procedure ToggleMemo;
 | 
|---|
 | 35 |   end;
 | 
|---|
 | 36 | 
 | 
|---|
 | 37 | var
 | 
|---|
 | 38 |   frmPtSelDemog: TfrmPtSelDemog;
 | 
|---|
 | 39 | 
 | 
|---|
 | 40 | implementation
 | 
|---|
 | 41 | 
 | 
|---|
 | 42 | uses rCore;
 | 
|---|
 | 43 | 
 | 
|---|
 | 44 | {$R *.DFM}
 | 
|---|
 | 45 | 
 | 
|---|
 | 46 | const
 | 
|---|
 | 47 | { constants referencing the value of the tag property in components }
 | 
|---|
 | 48 |   TAG_HIDE     =  1;                             // labels to be hidden
 | 
|---|
 | 49 |   TAG_CLEAR    =  2;                             // labels to be cleared
 | 
|---|
 | 50 | 
 | 
|---|
 | 51 | procedure TfrmPtSelDemog.ClearIDInfo;
 | 
|---|
 | 52 | { clears controls with patient ID info (controls have '2' in their Tag property }
 | 
|---|
 | 53 | var
 | 
|---|
 | 54 |   i: Integer;
 | 
|---|
 | 55 | begin
 | 
|---|
 | 56 |   FLastDFN := '';
 | 
|---|
 | 57 |   with orapnlMain do
 | 
|---|
 | 58 |   for i := 0 to ControlCount - 1 do
 | 
|---|
 | 59 |   begin
 | 
|---|
 | 60 |     if Controls[i].Tag = TAG_HIDE then Controls[i].Visible := False;
 | 
|---|
 | 61 |     if Controls[i].Tag = TAG_CLEAR then with Controls[i] as TStaticText do Caption := '';
 | 
|---|
 | 62 |   end;
 | 
|---|
 | 63 |   Memo.Clear;
 | 
|---|
 | 64 | end;
 | 
|---|
 | 65 | 
 | 
|---|
 | 66 | procedure TfrmPtSelDemog.ShowDemog(ItemID: string);
 | 
|---|
 | 67 | { gets a record of patient indentifying information from the server and displays it }
 | 
|---|
 | 68 | var
 | 
|---|
 | 69 |   PtRec: TPtIDInfo;
 | 
|---|
 | 70 |   i: Integer;
 | 
|---|
 | 71 | 
 | 
|---|
 | 72 | begin
 | 
|---|
 | 73 |   if ItemID = FLastDFN then Exit;
 | 
|---|
 | 74 |   Memo.Clear;
 | 
|---|
 | 75 |   FLastDFN := ItemID;
 | 
|---|
 | 76 |   PtRec := GetPtIDInfo(ItemID);
 | 
|---|
 | 77 |   with PtRec do
 | 
|---|
 | 78 |   begin
 | 
|---|
 | 79 |     Memo.Lines.Add(Name);
 | 
|---|
 | 80 |     Memo.Lines.Add(lblSSN.Caption + ' ' + SSN + '.');
 | 
|---|
 | 81 |     Memo.Lines.Add(lblDOB.Caption + ' ' + DOB + '.');
 | 
|---|
 | 82 |     if Sex <> '' then
 | 
|---|
 | 83 |       Memo.Lines.Add(Sex + '.');
 | 
|---|
 | 84 |     if Vet <> '' then
 | 
|---|
 | 85 |       Memo.Lines.Add(Vet + '.');
 | 
|---|
 | 86 |     if SCsts <> '' then
 | 
|---|
 | 87 |       Memo.Lines.Add(SCsts + '.');
 | 
|---|
 | 88 |     if Location <> '' then
 | 
|---|
 | 89 |       Memo.Lines.Add(lblLocation.Caption + ' ' + Location + '.');
 | 
|---|
 | 90 |     if RoomBed <> '' then
 | 
|---|
 | 91 |       Memo.Lines.Add(lblRoomBed.Caption + ' ' + RoomBed + '.');
 | 
|---|
 | 92 | 
 | 
|---|
 | 93 |     lblPtName.Caption     := Name;
 | 
|---|
 | 94 |     lblPtSSN.Caption      := SSN;
 | 
|---|
 | 95 |     lblPtDOB.Caption      := DOB;
 | 
|---|
 | 96 |     lblPtSex.Caption      := Sex {+ ', age ' + Age};
 | 
|---|
 | 97 |     lblPtSC.Caption       := SCSts;
 | 
|---|
 | 98 |     lblPtVet.Caption      := Vet;
 | 
|---|
 | 99 |     lblPtLocation.Caption := Location;
 | 
|---|
 | 100 |     lblPtRoomBed.Caption  := RoomBed;
 | 
|---|
 | 101 |   end;
 | 
|---|
 | 102 |   with orapnlMain do for i := 0 to ControlCount - 1 do
 | 
|---|
 | 103 |     if Controls[i].Tag = TAG_HIDE then Controls[i].Visible := True;
 | 
|---|
 | 104 |   if lblPtLocation.Caption = '' then
 | 
|---|
 | 105 |     lblLocation.Hide
 | 
|---|
 | 106 |   else
 | 
|---|
 | 107 |     lblLocation.Show;
 | 
|---|
 | 108 |   if lblPtRoomBed.Caption = ''  then
 | 
|---|
 | 109 |     lblRoomBed.Hide
 | 
|---|
 | 110 |   else
 | 
|---|
 | 111 |     lblRoomBed.Show;
 | 
|---|
 | 112 |   Memo.SelectAll;
 | 
|---|
 | 113 | end;
 | 
|---|
 | 114 | 
 | 
|---|
 | 115 | procedure TfrmPtSelDemog.ToggleMemo;
 | 
|---|
 | 116 | begin
 | 
|---|
 | 117 |   if Memo.Visible then
 | 
|---|
 | 118 |   begin
 | 
|---|
 | 119 |     Memo.Hide;
 | 
|---|
 | 120 |   end
 | 
|---|
 | 121 |   else
 | 
|---|
 | 122 |   begin
 | 
|---|
 | 123 |     Memo.Show;
 | 
|---|
 | 124 |     Memo.BringToFront;
 | 
|---|
 | 125 |   end;
 | 
|---|
 | 126 | end;
 | 
|---|
 | 127 | 
 | 
|---|
 | 128 | procedure TfrmPtSelDemog.FormCreate(Sender: TObject);
 | 
|---|
 | 129 | begin
 | 
|---|
 | 130 |   FOldWinProc := orapnlMain.WindowProc;
 | 
|---|
 | 131 |   orapnlMain.WindowProc := NewWinProc;
 | 
|---|
 | 132 | end;
 | 
|---|
 | 133 | 
 | 
|---|
 | 134 | procedure TfrmPtSelDemog.NewWinProc(var Message: TMessage);
 | 
|---|
 | 135 | const
 | 
|---|
 | 136 |   Gap = 4;
 | 
|---|
 | 137 | 
 | 
|---|
 | 138 | begin
 | 
|---|
 | 139 |   if(assigned(FOldWinProc)) then FOldWinProc(Message);
 | 
|---|
 | 140 |   if(Message.Msg = WM_Size) then
 | 
|---|
 | 141 |   begin
 | 
|---|
 | 142 |     if(lblPtSSN.Left < (lblSSN.Left+lblSSN.Width+Gap)) then
 | 
|---|
 | 143 |       lblPtSSN.Left := (lblSSN.Left+lblSSN.Width+Gap);
 | 
|---|
 | 144 |     if(lblPtDOB.Left < (lblDOB.Left+lblDOB.Width+Gap)) then
 | 
|---|
 | 145 |       lblPtDOB.Left := (lblDOB.Left+lblDOB.Width+Gap);
 | 
|---|
 | 146 |     if(lblPtSSN.Left < lblPtDOB.Left) then
 | 
|---|
 | 147 |       lblPtSSN.Left := lblPtDOB.Left
 | 
|---|
 | 148 |     else
 | 
|---|
 | 149 |       lblPtDOB.Left := lblPtSSN.Left;
 | 
|---|
 | 150 | 
 | 
|---|
 | 151 |     if(lblPtLocation.Left < (lblLocation.Left+lblLocation.Width+Gap)) then
 | 
|---|
 | 152 |       lblPtLocation.Left := (lblLocation.Left+lblLocation.Width+Gap);
 | 
|---|
 | 153 |     if(lblPtRoomBed.Left < (lblRoomBed.Left+lblRoomBed.Width+Gap)) then
 | 
|---|
 | 154 |       lblPtRoomBed.Left := (lblRoomBed.Left+lblRoomBed.Width+Gap);
 | 
|---|
 | 155 |     if(lblPtLocation.Left < lblPtRoomBed.Left) then
 | 
|---|
 | 156 |       lblPtLocation.Left := lblPtRoomBed.Left
 | 
|---|
 | 157 |     else
 | 
|---|
 | 158 |       lblPtRoomBed.Left := lblPtLocation.Left;
 | 
|---|
 | 159 |   end;
 | 
|---|
 | 160 | end;
 | 
|---|
 | 161 | 
 | 
|---|
 | 162 | procedure TfrmPtSelDemog.FormDestroy(Sender: TObject);
 | 
|---|
 | 163 | begin
 | 
|---|
 | 164 |   orapnlMain.WindowProc := FOldWinProc;
 | 
|---|
 | 165 | end;
 | 
|---|
 | 166 | 
 | 
|---|
 | 167 | end.
 | 
|---|