source: cprs/branches/tmg-cprs/CPRS-Chart/fPtSelDemog.pas@ 1742

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

Initial upload of TMG-CPRS 1.0.26.69

File size: 4.8 KB
RevLine 
[453]1unit fPtSelDemog;
2
3interface
4
5//kt changed orapnlMain.Anchors.akBottom to false
6//kt ... it didn't do what I wanted. Consider changing back later.
7
8uses
9 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
10 StdCtrls, ExtCtrls, ORCtrls, DKLang;
11
12type
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
42var
43 frmPtSelDemog: TfrmPtSelDemog;
44
45implementation
46
47uses rCore;
48
49{$R *.DFM}
50
51const
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
56procedure TfrmPtSelDemog.ClearIDInfo;
57{ clears controls with patient ID info (controls have '2' in their Tag property }
58var
59 i: Integer;
60begin
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;
69end;
70
71procedure TfrmPtSelDemog.ShowDemog(ItemID: string);
72{ gets a record of patient indentifying information from the server and displays it }
73var
74 PtRec: TPtIDInfo;
75 i: Integer;
76
77begin
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;
121end;
122
123procedure TfrmPtSelDemog.ToggleMemo;
124begin
125 if Memo.Visible then
126 begin
127 Memo.Hide;
128 end
129 else
130 begin
131 Memo.Show;
132 Memo.BringToFront;
133 end;
134end;
135
136procedure TfrmPtSelDemog.FormCreate(Sender: TObject);
137begin
138 FOldWinProc := orapnlMain.WindowProc;
139 orapnlMain.WindowProc := NewWinProc;
140end;
141
142procedure TfrmPtSelDemog.NewWinProc(var Message: TMessage);
143const
144 Gap = 4;
145
146begin
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;
168end;
169
170procedure TfrmPtSelDemog.FormDestroy(Sender: TObject);
171begin
172 orapnlMain.WindowProc := FOldWinProc;
173end;
174
175end.
Note: See TracBrowser for help on using the repository browser.