source: cprs/trunk/CPRS-Chart/fVisit.pas@ 1714

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

Upgrading to version 27

File size: 7.7 KB
RevLine 
[456]1unit fVisit;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
[830]7 ExtCtrls, ORCtrls, ORDtTm, ORFn, StdCtrls, rCore, uCore, fBase508Form,
8 VA508AccessibilityManager;
[456]9
10type
[830]11 TfrmVisit = class(TfrmBase508Form)
[456]12 pnlBase: TORAutoPanel;
13 lblInstruct: TStaticText;
14 radAppt: TRadioButton;
15 radAdmit: TRadioButton;
16 radNewVisit: TRadioButton;
17 lstVisit: TORListBox;
18 lblSelect: TLabel;
19 pnlVisit: TORAutoPanel;
20 cboLocation: TORComboBox;
21 timVisitDate: TORDateBox;
22 lblVisitDate: TLabel;
23 cmdOK: TButton;
24 cmdCancel: TButton;
25 grpCategory: TGroupBox;
26 ckbHistorical: TCheckBox;
27 procedure radSelectorClick(Sender: TObject);
28 procedure cboLocationNeedData(Sender: TObject; const StartFrom: string;
29 Direction, InsertAt: Integer);
30 procedure cmdCancelClick(Sender: TObject);
31 procedure cmdOKClick(Sender: TObject);
32 procedure FormCreate(Sender: TObject);
33 private
34 { Private declarations }
35 FChanged: Boolean;
36 FDateTime: TFMDateTime;
37 FLocation: Integer;
38 FLocationName: string;
39 FVisitCategory: Char;
40 FStandAlone: Boolean;
41 public
42 { Public declarations }
43 end;
44
45(*
46procedure SelectVisit(FontSize: Integer; var VisitUpdate: TVisitUpdate);
47procedure UpdateVisit(FontSize: Integer);
48*)
49
50implementation
51
52{$R *.DFM}
53
54uses
55 rOptions;
56
57const
58 TAG_SEL_CLINIC = 1;
59 TAG_SEL_ADMIT = 2;
60 TAG_SEL_NEW = 3;
61
62type
63 TVisitUpdate = record
64 Changed: Boolean;
65 DateTime: TFMDateTime;
66 Location: Integer;
67 LocationName: string;
68 VisitCategory: Char;
69 StandAlone: Boolean;
70 end;
71
72(*
73procedure UpdateVisit(FontSize: Integer);
74{ displays visit selection form and directly updates the visit in Encounter }
75var
76 VisitUpdate: TVisitUpdate;
77begin
78 SelectVisit(FontSize, VisitUpdate);
79 if VisitUpdate.Changed then
80 begin
81 Encounter.Location := VisitUpdate.Location;
82 Encounter.DateTime := VisitUpdate.DateTime;
83 Encounter.VisitCategory := VisitUpdate.VisitCategory;
84 Encounter.StandAlone := VisitUpdate.StandAlone;
85 end;
86end;
87
88procedure SelectVisit(FontSize: Integer; var VisitUpdate: TVisitUpdate);
89{ displays visit selection form and returns a record of the updated information }
90var
91 frmVisit: TfrmVisit;
92 W, H: Integer;
93begin
94 frmVisit := TfrmVisit.Create(Application);
95 try
96 with frmVisit do
97 begin
98 Font.Size := FontSize;
99 lblInstruct.Font.Size := FontSize;
100 W := ClientWidth;
101 H := ClientHeight;
102 ResizeToFont(FontSize, W, H);
103 ClientWidth := W; pnlBase.Width := W;
104 ClientHeight := H; pnlBase.Height := W;
105 frmVisit.ShowModal;
106 with VisitUpdate do
107 begin
108 Changed := FChanged;
109 DateTime := FDateTime;
110 Location := FLocation;
111 LocationName := FLocationName;
112 VisitCategory := FVisitCategory;
113 StandAlone := FStandAlone;
114 end; {with VisitRec}
115 end; {with frmVisit}
116 finally
117 frmVisit.Release;
118 end;
119end;
120*)
121
122procedure TfrmVisit.FormCreate(Sender: TObject);
123{ initialize private fields and display appropriate visit selection controls }
124begin
125 FChanged := False;
126 radSelectorClick(radAppt);
127 if lstVisit.Items.Count = 0 then
128 begin
129 radNewVisit.Checked := True;
130 radSelectorClick(radNewVisit);
131 end;
132end;
133
134procedure TfrmVisit.radSelectorClick(Sender: TObject);
135{ change visit data entry according to the radiobutton selected (appts, admissions, new visit }
136var
137 i: Integer;
138 ADateFrom, ADateThru: TDateTime;
139 BDateFrom, BDateThru: Integer;
140begin
141 if not TRadioButton(Sender).Checked then Exit;
142 lstVisit.Clear;
143 lblVisitDate.Hide;
144 case TRadioButton(Sender).Tag of
145 TAG_SEL_CLINIC: begin
146 lblSelect.Caption := 'Clinic Appointments';
147 rpcGetRangeForEncs(BDateFrom, BDateThru, False); // Get user's current date range settings.
148 ADateFrom := (FMDateTimeToDateTime(FMToday) - BDateFrom);
149 ADateThru := (FMDateTimeToDateTime(FMToday) + BDateThru);
150 ADateFrom := DateTimeToFMDateTime(ADateFrom);
151 ADateThru:= DateTimeToFMDateTime(ADateThru) + 0.2359;
152 ListApptAll(lstVisit.Items, Patient.DFN, ADateFrom, ADateThru);
153 pnlVisit.Hide;
154 lstVisit.Show;
155 end;
156 TAG_SEL_ADMIT: begin
157 lblSelect.Caption := 'Hospital Admissions';
158 ListAdmitAll(lstVisit.Items, Patient.DFN);
159 pnlVisit.Hide;
160 lstVisit.Show;
161 end;
162 TAG_SEL_NEW: begin
163 lblSelect.Caption := 'Visit Location';
164 with cboLocation do
165 begin
166 InitLongList(Encounter.LocationName);
167 for i := 0 to Items.Count - 1 do
168 if StrToIntDef(Piece(Items[i], U, 1),0) = Encounter.Location then
169 begin
170 ItemIndex := i;
171 break;
172 end;
173 end;
174 lstVisit.Hide;
175 lblVisitDate.Show;
176 pnlVisit.Show;
177 end;
178 end;
179 lstVisit.Caption := lblSelect.Caption;
180end;
181
182procedure TfrmVisit.cboLocationNeedData(Sender: TObject; const StartFrom: string;
183 Direction, InsertAt: Integer);
184{ callback for location combobox to list active locations }
185begin
186 //cboLocation.ForDataUse(SubSetOfLocations(StartFrom, Direction));
187 cboLocation.ForDataUse(SubSetOfClinics(StartFrom, Direction));
188end;
189
190procedure TfrmVisit.cmdOKClick(Sender: TObject);
191{ gather and validate visit information }
192const
193 VST_CAPTION = 'Unable to Select Visit';
194 VST_LOCATION = 'A visit LOCATION has not been selected.';
195 VST_DATETIME = 'A valid date/time has not been entered.';
196 VST_NOTIME = 'A valid time has not been entered.';
197 VST_SELECT = 'An appointment/hospitalization has not been entered';
198begin
199 FStandAlone := False;
200 if radNewVisit.Checked then
201 begin
202 if cboLocation.ItemIndex < 0 then
203 begin
204 InfoBox(VST_LOCATION, VST_CAPTION, MB_OK);
205 Exit;
206 end;
207 FDateTime := StrToFMDateTime(timVisitDate.Text);
208 if not (FDateTime > 0) then
209 begin
210 InfoBox(VST_DATETIME, VST_CAPTION, MB_OK);
211 Exit;
212 end;
213 if(pos('.',FloatToStr(FDateTime))=0) then
214 begin
215 InfoBox(VST_NOTIME, VST_CAPTION, MB_OK);
216 Exit;
217 end;
218 with cboLocation do
219 begin
220 FLocation := ItemIEN;
221 FLocationName := DisplayText[ItemIndex];
222 end;
223
224 //Changed 12/30/97 ISL/RAB
225 if ckbHistorical.state = cbchecked then FVisitCategory := 'E'
226 else FVisitCategory := 'A';
227
228 FChanged := True;
229
230 //ISL/RAB 1/15/98 The following line has been changed so procedures will
231 // not be required for historical visits.
232 if (FVisitCategory = 'A') then FStandAlone := True;
233 end else
234 begin
235 if lstVisit.ItemIndex < 0 then
236 begin
237 InfoBox(VST_SELECT, VST_CAPTION, MB_OK);
238 Exit;
239 end;
240 with lstVisit do
241 begin
242 FDateTime := MakeFMDateTime(ItemID);
243 FLocation := StrToIntDef(Piece(Items[ItemIndex], U, 2), 0);
244 FLocationName := Piece(Items[ItemIndex], U, 3);
245 if(radAdmit.Checked) then
246 FVisitCategory := 'H'
247 else
248 FVisitCategory := 'A';
249 FChanged := True;
250 end;
251 end;
252 Close;
253end;
254
255procedure TfrmVisit.cmdCancelClick(Sender: TObject);
256{ cancel form - no change to visit information }
257begin
258 FChanged := False;
259 Close;
260end;
261
262end.
Note: See TracBrowser for help on using the repository browser.