| [456] | 1 | unit fVisit; | 
|---|
|  | 2 |  | 
|---|
|  | 3 | interface | 
|---|
|  | 4 |  | 
|---|
|  | 5 | uses | 
|---|
|  | 6 | Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, | 
|---|
| [830] | 7 | ExtCtrls, ORCtrls, ORDtTm, ORFn, StdCtrls, rCore, uCore, fBase508Form, | 
|---|
|  | 8 | VA508AccessibilityManager; | 
|---|
| [456] | 9 |  | 
|---|
|  | 10 | type | 
|---|
| [830] | 11 | TfrmVisit = class(TfrmBase508Form) | 
|---|
| [456] | 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. | 
|---|