source: cprs/branches/tmg-cprs/CPRS-Chart/fVisit.pas@ 1328

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

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