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

Last change on this file since 790 was 456, checked in by Kevin Toppenberg, 16 years ago

Initial Upload of Official WV CPRS 1.0.26.76

File size: 4.6 KB
Line 
1unit fPtSelDemog;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 StdCtrls, ExtCtrls, ORCtrls;
8
9type
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 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;
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
142begin
143 if(assigned(FOldWinProc)) then FOldWinProc(Message);
144 if(Message.Msg = WM_Size) then
145 begin
146 if(lblPtSSN.Left < (lblSSN.Left+lblSSN.Width+Gap)) then
147 lblPtSSN.Left := (lblSSN.Left+lblSSN.Width+Gap);
148 if(lblPtDOB.Left < (lblDOB.Left+lblDOB.Width+Gap)) then
149 lblPtDOB.Left := (lblDOB.Left+lblDOB.Width+Gap);
150 if(lblPtSSN.Left < lblPtDOB.Left) then
151 lblPtSSN.Left := lblPtDOB.Left
152 else
153 lblPtDOB.Left := lblPtSSN.Left;
154
155 if(lblPtLocation.Left < (lblLocation.Left+lblLocation.Width+Gap)) then
156 lblPtLocation.Left := (lblLocation.Left+lblLocation.Width+Gap);
157 if(lblPtRoomBed.Left < (lblRoomBed.Left+lblRoomBed.Width+Gap)) then
158 lblPtRoomBed.Left := (lblRoomBed.Left+lblRoomBed.Width+Gap);
159 if(lblPtLocation.Left < lblPtRoomBed.Left) then
160 lblPtLocation.Left := lblPtRoomBed.Left
161 else
162 lblPtRoomBed.Left := lblPtLocation.Left;
163 end;
164end;
165
166procedure TfrmPtSelDemog.FormDestroy(Sender: TObject);
167begin
168 orapnlMain.WindowProc := FOldWinProc;
169end;
170
171end.
Note: See TracBrowser for help on using the repository browser.