| 1 | //kt -- Modified with SourceScanner on 8/7/2007
|
---|
| 2 | unit fVisit;
|
---|
| 3 |
|
---|
| 4 | interface
|
---|
| 5 |
|
---|
| 6 | uses
|
---|
| 7 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
|
---|
| 8 | ExtCtrls, ORCtrls, ORDtTm, ORFn, StdCtrls, rCore, uCore, DKLang;
|
---|
| 9 |
|
---|
| 10 | type
|
---|
| 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 | (*
|
---|
| 47 | procedure SelectVisit(FontSize: Integer; var VisitUpdate: TVisitUpdate);
|
---|
| 48 | procedure UpdateVisit(FontSize: Integer);
|
---|
| 49 | *)
|
---|
| 50 |
|
---|
| 51 | implementation
|
---|
| 52 |
|
---|
| 53 | {$R *.DFM}
|
---|
| 54 |
|
---|
| 55 | uses
|
---|
| 56 | rOptions;
|
---|
| 57 |
|
---|
| 58 | const
|
---|
| 59 | TAG_SEL_CLINIC = 1;
|
---|
| 60 | TAG_SEL_ADMIT = 2;
|
---|
| 61 | TAG_SEL_NEW = 3;
|
---|
| 62 |
|
---|
| 63 | type
|
---|
| 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 |
|
---|
| 76 | procedure TfrmVisit.SetupVars;
|
---|
| 77 | //kt Added entire function to replace constant declarations 8/7/2007
|
---|
| 78 | begin
|
---|
| 79 | end;
|
---|
| 80 |
|
---|
| 81 | procedure UpdateVisit(FontSize: Integer);
|
---|
| 82 | { displays visit selection form and directly updates the visit in Encounter }
|
---|
| 83 | var
|
---|
| 84 | VisitUpdate: TVisitUpdate;
|
---|
| 85 | begin
|
---|
| 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;
|
---|
| 94 | end;
|
---|
| 95 |
|
---|
| 96 | procedure SelectVisit(FontSize: Integer; var VisitUpdate: TVisitUpdate);
|
---|
| 97 | { displays visit selection form and returns a record of the updated information }
|
---|
| 98 | var
|
---|
| 99 | frmVisit: TfrmVisit;
|
---|
| 100 | W, H: Integer;
|
---|
| 101 | begin
|
---|
| 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;
|
---|
| 127 | end;
|
---|
| 128 | *)
|
---|
| 129 |
|
---|
| 130 | procedure TfrmVisit.FormCreate(Sender: TObject);
|
---|
| 131 | { initialize private fields and display appropriate visit selection controls }
|
---|
| 132 | begin
|
---|
| 133 | FChanged := False;
|
---|
| 134 | radSelectorClick(radAppt);
|
---|
| 135 | if lstVisit.Items.Count = 0 then
|
---|
| 136 | begin
|
---|
| 137 | radNewVisit.Checked := True;
|
---|
| 138 | radSelectorClick(radNewVisit);
|
---|
| 139 | end;
|
---|
| 140 | end;
|
---|
| 141 |
|
---|
| 142 | procedure TfrmVisit.radSelectorClick(Sender: TObject);
|
---|
| 143 | { change visit data entry according to the radiobutton selected (appts, admissions, new visit }
|
---|
| 144 | var
|
---|
| 145 | i: Integer;
|
---|
| 146 | ADateFrom, ADateThru: TDateTime;
|
---|
| 147 | BDateFrom, BDateThru: Integer;
|
---|
| 148 | begin
|
---|
| 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;
|
---|
| 191 | end;
|
---|
| 192 |
|
---|
| 193 | procedure TfrmVisit.cboLocationNeedData(Sender: TObject; const StartFrom: string;
|
---|
| 194 | Direction, InsertAt: Integer);
|
---|
| 195 | { callback for location combobox to list active locations }
|
---|
| 196 | begin
|
---|
| 197 | //cboLocation.ForDataUse(SubSetOfLocations(StartFrom, Direction));
|
---|
| 198 | cboLocation.ForDataUse(SubSetOfClinics(StartFrom, Direction));
|
---|
| 199 | end;
|
---|
| 200 |
|
---|
| 201 | procedure 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
|
---|
| 209 | var
|
---|
| 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
|
---|
| 215 | begin
|
---|
| 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;
|
---|
| 275 | end;
|
---|
| 276 |
|
---|
| 277 | procedure TfrmVisit.cmdCancelClick(Sender: TObject);
|
---|
| 278 | { cancel form - no change to visit information }
|
---|
| 279 | begin
|
---|
| 280 | FChanged := False;
|
---|
| 281 | Close;
|
---|
| 282 | end;
|
---|
| 283 |
|
---|
| 284 | end.
|
---|