| 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.
 | 
|---|