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