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