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

Last change on this file since 1731 was 1679, checked in by healthsevak, 10 years ago

Updating the working copy to CPRS version 28

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