source: cprs/trunk/CPRS-Chart/fPtSelDemog.pas@ 893

Last change on this file since 893 was 830, checked in by Kevin Toppenberg, 14 years ago

Upgrading to version 27

File size: 5.7 KB
Line 
1unit fPtSelDemog;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 StdCtrls, ExtCtrls, ORCtrls, fBase508Form, VA508AccessibilityManager;
8
9type
10 TfrmPtSelDemog = class(TfrmBase508Form)
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 lblPtHRN: TStaticText;
26 procedure FormCreate(Sender: TObject);
27 procedure FormDestroy(Sender: TObject);
28 private
29 FLastDFN: string;
30 FOldWinProc :TWndMethod;
31 procedure NewWinProc(var Message: TMessage);
32 public
33 procedure ClearIDInfo;
34 procedure ShowDemog(ItemID: string);
35 procedure ToggleMemo;
36 end;
37
38var
39 frmPtSelDemog: TfrmPtSelDemog;
40
41implementation
42
43uses rCore, VA508AccessibilityRouter;
44
45{$R *.DFM}
46
47const
48{ constants referencing the value of the tag property in components }
49 TAG_HIDE = 1; // labels to be hidden
50 TAG_CLEAR = 2; // labels to be cleared
51
52procedure TfrmPtSelDemog.ClearIDInfo;
53{ clears controls with patient ID info (controls have '2' in their Tag property }
54var
55 i: Integer;
56begin
57 FLastDFN := '';
58 with orapnlMain do
59 for i := 0 to ControlCount - 1 do
60 begin
61 if Controls[i].Tag = TAG_HIDE then Controls[i].Visible := False;
62 if Controls[i].Tag = TAG_CLEAR then with Controls[i] as TStaticText do Caption := '';
63 end;
64 Memo.Clear;
65end;
66
67procedure TfrmPtSelDemog.ShowDemog(ItemID: string);
68{ gets a record of patient indentifying information from the server and displays it }
69var
70 PtRec: TPtIDInfo;
71 i: Integer;
72
73begin
74 if ItemID = FLastDFN then Exit;
75 Memo.Clear;
76 FLastDFN := ItemID;
77 PtRec := GetPtIDInfo(ItemID);
78 with PtRec do
79 begin
80 Memo.Lines.Add(Name);
81 Memo.Lines.Add(lblSSN.Caption + ' ' + SSN + '.');
82 Memo.Lines.Add(lblDOB.Caption + ' ' + DOB + '.');
83 if Sex <> '' then
84 Memo.Lines.Add(Sex + '.');
85 if Vet <> '' then
86 Memo.Lines.Add(Vet + '.');
87 if SCsts <> '' then
88 Memo.Lines.Add(SCsts + '.');
89 if Location <> '' then
90 Memo.Lines.Add(lblLocation.Caption + ' ' + Location + '.');
91 if RoomBed <> '' then
92 Memo.Lines.Add(lblRoomBed.Caption + ' ' + RoomBed + '.');
93
94 lblPtName.Caption := Name;
95 lblPtSSN.Caption := SSN;
96 lblPtDOB.Caption := DOB;
97 lblPtSex.Caption := Sex {+ ', age ' + Age};
98 lblPtSC.Caption := SCSts;
99 lblPtVet.Caption := Vet;
100 lblPtLocation.Caption := Location;
101 lblPtRoomBed.Caption := RoomBed;
102 //VWPT
103 if HRN <> '' then lblPtHRN.Caption := 'HRN: '+HRN
104 else lblPtHRN.Caption :='' ;
105 end;
106 with orapnlMain do for i := 0 to ControlCount - 1 do
107 if Controls[i].Tag = TAG_HIDE then Controls[i].Visible := True;
108 if lblPtLocation.Caption = '' then
109 lblLocation.Hide
110 else
111 lblLocation.Show;
112 if lblPtRoomBed.Caption = '' then
113 lblRoomBed.Hide
114 else
115 lblRoomBed.Show;
116 Memo.SelectAll;
117end;
118
119procedure TfrmPtSelDemog.ToggleMemo;
120begin
121 if Memo.Visible then
122 begin
123 Memo.Hide;
124 end
125 else
126 begin
127 Memo.Show;
128 Memo.BringToFront;
129 end;
130end;
131
132procedure TfrmPtSelDemog.FormCreate(Sender: TObject);
133begin
134 FOldWinProc := orapnlMain.WindowProc;
135 orapnlMain.WindowProc := NewWinProc;
136end;
137
138procedure TfrmPtSelDemog.NewWinProc(var Message: TMessage);
139const
140 Gap = 4;
141 MaxFont = 10;
142 var uHeight:integer;
143
144
145begin
146 if(assigned(FOldWinProc)) then FOldWinProc(Message);
147 if(Message.Msg = WM_Size) then
148 begin
149 if(lblPtSSN.Left < (lblSSN.Left+lblSSN.Width+Gap)) then
150 lblPtSSN.Left := (lblSSN.Left+lblSSN.Width+Gap);
151 if(lblPtDOB.Left < (lblDOB.Left+lblDOB.Width+Gap)) then
152 lblPtDOB.Left := (lblDOB.Left+lblDOB.Width+Gap);
153 if(lblPtSSN.Left < lblPtDOB.Left) then
154 lblPtSSN.Left := lblPtDOB.Left
155 else
156 lblPtDOB.Left := lblPtSSN.Left;
157
158 if(lblPtLocation.Left < (lblLocation.Left+lblLocation.Width+Gap)) then
159 lblPtLocation.Left := (lblLocation.Left+lblLocation.Width+Gap);
160 if(lblPtRoomBed.Left < (lblRoomBed.Left+lblRoomBed.Width+Gap)) then
161 lblPtRoomBed.Left := (lblRoomBed.Left+lblRoomBed.Width+Gap);
162 if(lblPtLocation.Left < lblPtRoomBed.Left) then
163 lblPtLocation.Left := lblPtRoomBed.Left
164 else
165 lblPtRoomBed.Left := lblPtLocation.Left;
166 end;
167 if frmPtSelDemog.Canvas.Font.Size > MaxFont then
168 begin
169 uHeight := frmPtSelDemog.Canvas.TextHeight(lblPtSSN.Caption)-2;
170 lblPtSSN.Top := (lblPtName.Top + uHeight);
171 lblSSN.Top := lblPtSSN.Top;
172 lblPtDOB.Height := uHeight;
173 lblPtDOB.Top := (lblPtSSn.Top + uHeight);
174 lblDOB.Top := lblPtDOB.Top;
175 lblPtSex.Height := uHeight;
176 lblPtSex.Top := (lblPtDOB.Top + uHeight);
177 lblPtVet.Height := uHeight;
178 lblPtVet.Top := (lblPtSex.Top + uHeight);
179 lblPtSC.Height := uHeight;
180 lblPtSC.Top := lblPtVet.Top;
181 lblLocation.Height := uHeight;
182 lblLocation.Top := ( lblPtVet.Top + uHeight);
183 lblPtLocation.Top := lblLocation.Top;
184 lblRoomBed.Height := uHeight;
185 lblRoomBed.Top :=(lblLocation.Top + uHeight)+ 2;
186 lblPtRoomBed.Height := uHeight;
187 lblPtRoomBed.Top := lblRoomBed.Top ;
188 end;
189end;
190
191procedure TfrmPtSelDemog.FormDestroy(Sender: TObject);
192begin
193 orapnlMain.WindowProc := FOldWinProc;
194end;
195
196initialization
197 SpecifyFormIsNotADialog(TfrmPtSelDemog);
198
199end.
Note: See TracBrowser for help on using the repository browser.