1 | unit fVisit;
|
---|
2 |
|
---|
3 | interface
|
---|
4 |
|
---|
5 | uses
|
---|
6 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
|
---|
7 | ExtCtrls, ORCtrls, ORDtTm, ORFn, StdCtrls, rCore, uCore, fBase508Form,
|
---|
8 | VA508AccessibilityManager;
|
---|
9 |
|
---|
10 | type
|
---|
11 | TfrmVisit = class(TfrmBase508Form)
|
---|
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 | (*
|
---|
46 | procedure SelectVisit(FontSize: Integer; var VisitUpdate: TVisitUpdate);
|
---|
47 | procedure UpdateVisit(FontSize: Integer);
|
---|
48 | *)
|
---|
49 |
|
---|
50 | implementation
|
---|
51 |
|
---|
52 | {$R *.DFM}
|
---|
53 |
|
---|
54 | uses
|
---|
55 | rOptions;
|
---|
56 |
|
---|
57 | const
|
---|
58 | TAG_SEL_CLINIC = 1;
|
---|
59 | TAG_SEL_ADMIT = 2;
|
---|
60 | TAG_SEL_NEW = 3;
|
---|
61 |
|
---|
62 | type
|
---|
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 | (*
|
---|
73 | procedure UpdateVisit(FontSize: Integer);
|
---|
74 | { displays visit selection form and directly updates the visit in Encounter }
|
---|
75 | var
|
---|
76 | VisitUpdate: TVisitUpdate;
|
---|
77 | begin
|
---|
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;
|
---|
86 | end;
|
---|
87 |
|
---|
88 | procedure SelectVisit(FontSize: Integer; var VisitUpdate: TVisitUpdate);
|
---|
89 | { displays visit selection form and returns a record of the updated information }
|
---|
90 | var
|
---|
91 | frmVisit: TfrmVisit;
|
---|
92 | W, H: Integer;
|
---|
93 | begin
|
---|
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;
|
---|
119 | end;
|
---|
120 | *)
|
---|
121 |
|
---|
122 | procedure TfrmVisit.FormCreate(Sender: TObject);
|
---|
123 | { initialize private fields and display appropriate visit selection controls }
|
---|
124 | begin
|
---|
125 | FChanged := False;
|
---|
126 | radSelectorClick(radAppt);
|
---|
127 | if lstVisit.Items.Count = 0 then
|
---|
128 | begin
|
---|
129 | radNewVisit.Checked := True;
|
---|
130 | radSelectorClick(radNewVisit);
|
---|
131 | end;
|
---|
132 | end;
|
---|
133 |
|
---|
134 | procedure TfrmVisit.radSelectorClick(Sender: TObject);
|
---|
135 | { change visit data entry according to the radiobutton selected (appts, admissions, new visit }
|
---|
136 | var
|
---|
137 | i: Integer;
|
---|
138 | ADateFrom, ADateThru: TDateTime;
|
---|
139 | BDateFrom, BDateThru: Integer;
|
---|
140 | begin
|
---|
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;
|
---|
180 | end;
|
---|
181 |
|
---|
182 | procedure TfrmVisit.cboLocationNeedData(Sender: TObject; const StartFrom: string;
|
---|
183 | Direction, InsertAt: Integer);
|
---|
184 | { callback for location combobox to list active locations }
|
---|
185 | begin
|
---|
186 | //cboLocation.ForDataUse(SubSetOfLocations(StartFrom, Direction));
|
---|
187 | cboLocation.ForDataUse(SubSetOfClinics(StartFrom, Direction));
|
---|
188 | end;
|
---|
189 |
|
---|
190 | procedure TfrmVisit.cmdOKClick(Sender: TObject);
|
---|
191 | { gather and validate visit information }
|
---|
192 | const
|
---|
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';
|
---|
198 | begin
|
---|
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;
|
---|
253 | end;
|
---|
254 |
|
---|
255 | procedure TfrmVisit.cmdCancelClick(Sender: TObject);
|
---|
256 | { cancel form - no change to visit information }
|
---|
257 | begin
|
---|
258 | FChanged := False;
|
---|
259 | Close;
|
---|
260 | end;
|
---|
261 |
|
---|
262 | end.
|
---|