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

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

Initial Upload of Official WV CPRS 1.0.26.76

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