| 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. | 
|---|