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