[459] | 1 | unit fODRad;
|
---|
| 2 |
|
---|
| 3 | interface
|
---|
| 4 |
|
---|
| 5 | uses
|
---|
| 6 | SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
|
---|
| 7 | Forms, Dialogs, StdCtrls, ORCtrls, fODBase, ORFn, ExtCtrls,
|
---|
| 8 | ComCtrls, uConst, ORDtTm;
|
---|
| 9 |
|
---|
| 10 | type
|
---|
| 11 | TfrmODRad = class(TfrmODBase)
|
---|
| 12 | lblDrug: TLabel;
|
---|
| 13 | cboProcedure: TORComboBox;
|
---|
| 14 | cboAvailMod: TORComboBox;
|
---|
| 15 | lblAvailMod: TLabel;
|
---|
| 16 | cmdRemove: TButton;
|
---|
| 17 | calRequestDate: TORDateBox;
|
---|
| 18 | cboUrgency: TORComboBox;
|
---|
| 19 | cboTransport: TORComboBox;
|
---|
| 20 | cboCategory: TORComboBox;
|
---|
| 21 | chkPreOp: TCheckBox;
|
---|
| 22 | cboSubmit: TORComboBox;
|
---|
| 23 | lstLastExam: TORListBox;
|
---|
| 24 | lblReason: TLabel;
|
---|
| 25 | memReason: TCaptionMemo;
|
---|
| 26 | lstSelectMod: TORListBox;
|
---|
| 27 | lblSelectMod: TLabel;
|
---|
| 28 | lblRequestDate: TLabel;
|
---|
| 29 | lblUrgency: TLabel;
|
---|
| 30 | lblTransport: TLabel;
|
---|
| 31 | lblCategory: TLabel;
|
---|
| 32 | lblSubmit: TLabel;
|
---|
| 33 | lblLastExam: TLabel;
|
---|
| 34 | lblAskSubmit: TLabel;
|
---|
| 35 | chkIsolation: TCheckBox;
|
---|
| 36 | FRadCommonCombo: TORListBox;
|
---|
| 37 | lblImType: TLabel;
|
---|
| 38 | cboImType: TORComboBox;
|
---|
| 39 | calPreOp: TORDateBox;
|
---|
| 40 | lblPreOp: TLabel;
|
---|
| 41 | pnlLeft: TORAutoPanel;
|
---|
| 42 | pnlRight: TORAutoPanel;
|
---|
| 43 | pnlHandR: TPanel;
|
---|
| 44 | grpPregnant: TGroupBox;
|
---|
| 45 | radPregnant: TRadioButton;
|
---|
| 46 | radPregnantNo: TRadioButton;
|
---|
| 47 | radPregnantUnknown: TRadioButton;
|
---|
| 48 | procedure cboProcedureNeedData(Sender: TObject;
|
---|
| 49 | const StartFrom: string; Direction, InsertAt: Integer);
|
---|
| 50 | procedure cboAvailModMouseClick(Sender: TObject);
|
---|
| 51 | procedure cmdRemoveClick(Sender: TObject);
|
---|
| 52 | procedure ControlChange(Sender: TObject);
|
---|
| 53 | procedure cboProcedureSelect(Sender: TObject);
|
---|
| 54 | procedure SetModifierList;
|
---|
| 55 | procedure cboCategoryChange(Sender: TObject);
|
---|
| 56 | procedure FormCreate(Sender: TObject);
|
---|
| 57 | procedure cboImTypeChange(Sender: TObject);
|
---|
| 58 | procedure FormPaint(Sender: TObject);
|
---|
| 59 | procedure memReasonExit(Sender: TObject);
|
---|
| 60 | procedure FormResize(Sender: TObject);
|
---|
| 61 | procedure cboAvailModKeyDown(Sender: TObject; var Key: Word;
|
---|
| 62 | Shift: TShiftState);
|
---|
| 63 | procedure calPreOpChange(Sender: TObject);
|
---|
| 64 | procedure cmdAcceptClick(Sender: TObject);
|
---|
| 65 | procedure cboProcedureExit(Sender: TObject);
|
---|
| 66 | procedure cboImTypeExit(Sender: TObject);
|
---|
| 67 | private
|
---|
| 68 | FLastRadID: string;
|
---|
| 69 | FEditCopy: boolean;
|
---|
| 70 | FPreOpDate: string;
|
---|
| 71 | FEvtDelayDiv: string;
|
---|
| 72 | FPredefineOrder: boolean;
|
---|
| 73 | protected
|
---|
| 74 | procedure InitDialog; override;
|
---|
| 75 | procedure Validate(var AnErrMsg: string); override;
|
---|
| 76 | procedure SetDefaultPregant;
|
---|
| 77 | public
|
---|
| 78 | procedure SetupDialog(OrderAction: Integer; const ID: string); override;
|
---|
| 79 | end;
|
---|
| 80 |
|
---|
| 81 | implementation
|
---|
| 82 |
|
---|
| 83 | {$R *.DFM}
|
---|
| 84 |
|
---|
| 85 | uses rODBase, rODRad, rOrders, uCore, rCore, fODRadApproval, fODRadConShRes, fLkUpLocation;
|
---|
| 86 |
|
---|
| 87 | const
|
---|
| 88 | TX_NO_PROC = 'An Imaging Procedure must be specified.' ;
|
---|
| 89 | TX_NO_MODE = 'A mode of transport must be selected.';
|
---|
| 90 | TX_NO_REASON = 'A History & Reason for Exam must be entered.' ;
|
---|
| 91 | TX_NO_DATE = 'Unable to evaluate request date.' ;
|
---|
| 92 | TX_APPROVAL_REQUIRED= 'This procedure requires Radiologist approval.' ;
|
---|
| 93 | TX_NO_SOURCE = 'A source must be specified for Contract/Sharing/Research patients.';
|
---|
| 94 | TX_NO_AGREE = 'There are no active agreements of the type specified.';
|
---|
| 95 | TX_NO_AGREE_CAP = 'No Agreements on file';
|
---|
| 96 | TX_ORD_LOC = 'Ordering location must be specified if patient type and order category do not match.';
|
---|
| 97 | TC_REQ_LOC = 'Location Required';
|
---|
| 98 | TX_LOC_ORDER = 'The selected location will be used to determine the ordering location ' +
|
---|
| 99 | 'when the patient location does not match the specified category.';
|
---|
| 100 | TX_NO_CATEGORY = 'A category of examination must be specified.';
|
---|
| 101 | TX_NO_IMAGING_LOCATION = 'A "Submit To" location must be specified.';
|
---|
| 102 |
|
---|
| 103 | var
|
---|
| 104 | Radiologist, Contract, Research: string ;
|
---|
| 105 | AName: string;
|
---|
| 106 | ALocation, AType: integer;
|
---|
| 107 |
|
---|
| 108 | { TfrmODBase common methods }
|
---|
| 109 |
|
---|
| 110 | procedure TfrmODRad.SetupDialog(OrderAction: Integer; const ID: string);
|
---|
| 111 | var
|
---|
| 112 | tmpResp: TResponse;
|
---|
| 113 | i: integer;
|
---|
| 114 | begin
|
---|
| 115 | inherited;
|
---|
| 116 | if OrderAction in [ORDER_COPY, ORDER_EDIT, ORDER_QUICK] then with Responses do
|
---|
| 117 | begin
|
---|
| 118 | if (OrderAction = ORDER_QUICK) or (OrderAction = ORDER_COPY) then
|
---|
| 119 | FPredefineOrder := True;
|
---|
| 120 | FEditCopy := True;
|
---|
| 121 | Changing := True;
|
---|
| 122 | with cboImType do
|
---|
| 123 | begin
|
---|
| 124 | Items.Assign(SubsetOfImagingTypes);
|
---|
| 125 | for i := 0 to Items.Count-1 do
|
---|
| 126 | if StrToIntDef(Piece(Items[i],U,4), 0) = DisplayGroup then ItemIndex := i;
|
---|
| 127 | end;
|
---|
| 128 | if Self.EvtID>0 then
|
---|
| 129 | FEvtDelayDiv := GetEventDiv1(IntToStr(Self.EvtID));
|
---|
| 130 | CtrlInits.LoadDefaults(ODForRad(Patient.DFN, FEvtDelayDiv, DisplayGroup)); // ODForRad returns TStrings with defaults
|
---|
| 131 | InitDialog;
|
---|
| 132 | SetControl(cboProcedure, 'ORDERABLE', 1);
|
---|
| 133 | Changing := True;
|
---|
| 134 | SetModifierList;
|
---|
| 135 | SetControl(cboUrgency, 'URGENCY', 1);
|
---|
| 136 | SetControl(cboTransport, 'MODE', 1);
|
---|
| 137 | SetControl(cboSubmit, 'IMLOC', 1);
|
---|
| 138 | SetControl(cboCategory, 'CLASS', 1);
|
---|
| 139 | SetControl(memReason, 'COMMENT', 1);
|
---|
| 140 | SetControl(chkIsolation, 'YN', 1);
|
---|
| 141 | SetControl(radPregnant, 'PREGNANT', 1);
|
---|
| 142 | SetControl(calPreOp, 'PREOP', 1);
|
---|
| 143 | tmpResp := FindResponseByName('START',1);
|
---|
| 144 | if tmpResp <> nil then
|
---|
| 145 | begin
|
---|
| 146 | if ContainsAlpha(tmpResp.IValue) then
|
---|
| 147 | calRequestDate.Text := tmpResp.IValue
|
---|
| 148 | else
|
---|
| 149 | calRequestDate.FMDateTime := StrToFMDateTime(tmpResp.IValue);
|
---|
| 150 | end;
|
---|
| 151 | tmpResp := FindResponseByName('PROVIDER',1);
|
---|
| 152 | if tmpResp <> nil then with tmpResp do if Length(EValue)>0 then Radiologist := IValue + '^' + EValue;
|
---|
| 153 | if (cboCategory.ItemID = 'C') or (cboCategory.ItemID = 'S') then
|
---|
| 154 | begin
|
---|
| 155 | tmpResp := FindResponseByName('CONTRACT',1);
|
---|
| 156 | if tmpResp <> nil then with tmpResp do
|
---|
| 157 | if Length(EValue)>0 then
|
---|
| 158 | begin
|
---|
| 159 | Contract := IValue + '^' + EValue;
|
---|
| 160 | Research := '';
|
---|
| 161 | end;
|
---|
| 162 | end;
|
---|
| 163 | if cboCategory.ItemID = 'R' then
|
---|
| 164 | begin
|
---|
| 165 | tmpResp := FindResponseByName('RESEARCH',1);
|
---|
| 166 | if tmpResp <> nil then with tmpResp do
|
---|
| 167 | if Length(EValue)>0 then
|
---|
| 168 | begin
|
---|
| 169 | Research := EValue;
|
---|
| 170 | Contract := '';
|
---|
| 171 | end;
|
---|
| 172 | end;
|
---|
| 173 | Changing := False;
|
---|
| 174 | FEditCopy := False;
|
---|
| 175 | OrderMessage(ImagingMessage(cboProcedure.ItemIEN)) ;
|
---|
| 176 | ControlChange(Self);
|
---|
| 177 | end;
|
---|
| 178 | end;
|
---|
| 179 |
|
---|
| 180 | procedure TfrmODRad.InitDialog;
|
---|
| 181 | var
|
---|
| 182 | i: integer;
|
---|
| 183 | tmplst: TStringList;
|
---|
| 184 | begin
|
---|
| 185 | if not FEditCopy then inherited;
|
---|
| 186 | FPreOpDate := '';
|
---|
| 187 | FLastRadID := '';
|
---|
| 188 | Radiologist := '';
|
---|
| 189 | Contract := '';
|
---|
| 190 | Research := '';
|
---|
| 191 | ALocation := 0;
|
---|
| 192 | AName := '';
|
---|
| 193 | AType := 0;
|
---|
| 194 | FEvtDelayDiv := '';
|
---|
| 195 | if (Self.EvtID > 0 ) and (FEvtDelayDiv = '') then
|
---|
| 196 | FEvtDelayDiv := GetEventDiv1(IntToStr(Self.EvtID));
|
---|
| 197 | with CtrlInits do
|
---|
| 198 | begin
|
---|
| 199 | SetControl(cboProcedure, 'ShortList');
|
---|
| 200 | if cboProcedure.Items.Count > 0 then cboProcedure.InsertSeparator;
|
---|
| 201 | SetControl(FRadCommonCombo, 'Common Procedures');
|
---|
| 202 | for i := 0 to FRadCommonCombo.Items.Count-1 do
|
---|
| 203 | cboProcedure.Items.Add(FRadCommonCombo.Items[i]);
|
---|
| 204 | if FRadCommonCombo.Items.Count>0 then cboProcedure.InsertSeparator;
|
---|
| 205 | calRequestDate.Text := 'TODAY';
|
---|
| 206 | SetControl(cboAvailMod, 'Modifiers');
|
---|
| 207 | SetControl(cboUrgency, 'Urgencies');
|
---|
| 208 | SetControl(cboTransport, 'Transport');
|
---|
| 209 | with cboTransport do if OrderForInpatient
|
---|
| 210 | then SelectByID('W')
|
---|
| 211 | else SelectByID('A');
|
---|
| 212 | SetControl(cboCategory, 'Category');
|
---|
| 213 | with cboCategory do if OrderForInpatient
|
---|
| 214 | then SelectByID('I')
|
---|
| 215 | else SelectByID('O');
|
---|
| 216 | SetControl(cboSubmit, 'Submit to');
|
---|
| 217 | SetControl(lblAskSubmit,'Ask Submit') ;
|
---|
| 218 | if (cboSubmit.Items.Count = 0) then
|
---|
| 219 | begin
|
---|
| 220 | cboSubmit.ItemIndex := -1;
|
---|
| 221 | lblSubmit.Enabled := False;
|
---|
| 222 | cboSubmit.Enabled := False;
|
---|
| 223 | cboSubmit.Font.Color := clGrayText;
|
---|
| 224 | end
|
---|
| 225 | else if (lblAskSubmit.Caption = 'YES') then
|
---|
| 226 | begin
|
---|
| 227 | if (cboSubmit.Items.Count > 1) then
|
---|
| 228 | begin
|
---|
| 229 | tmplst := TStringList.Create;
|
---|
| 230 | try
|
---|
| 231 | tmplst.Assign(cboSubmit.Items);
|
---|
| 232 | SortByPiece(tmplst, U, 2);
|
---|
| 233 | cboSubmit.Items.Assign(tmplst);
|
---|
| 234 | finally
|
---|
| 235 | tmplst.Free;
|
---|
| 236 | end;
|
---|
| 237 | cboSubmit.ItemIndex := -1 ;
|
---|
| 238 | lblSubmit.Enabled := True;
|
---|
| 239 | cboSubmit.Enabled := True;
|
---|
| 240 | cboSubmit.Font.Color := clWindowText;
|
---|
| 241 | end
|
---|
| 242 | else
|
---|
| 243 | begin
|
---|
| 244 | cboSubmit.ItemIndex := 0;
|
---|
| 245 | lblSubmit.Enabled := False;
|
---|
| 246 | cboSubmit.Enabled := False;
|
---|
| 247 | cboSubmit.Font.Color := clGrayText;
|
---|
| 248 | end;
|
---|
| 249 | end
|
---|
| 250 | else if lblAskSubmit.Caption = 'NO' then
|
---|
| 251 | begin
|
---|
| 252 | if (cboSubmit.Items.Count = 1) then
|
---|
| 253 | cboSubmit.ItemIndex := 0
|
---|
| 254 | else
|
---|
| 255 | cboSubmit.ItemIndex := -1 ;
|
---|
| 256 | lblSubmit.Enabled := False;
|
---|
| 257 | cboSubmit.Enabled := False;
|
---|
| 258 | cboSubmit.Font.Color := clGrayText;
|
---|
| 259 | end;
|
---|
| 260 | chkIsolation.Checked := PatientOnIsolationProcedures(Patient.DFN) ;
|
---|
| 261 | SetControl(lstLastExam, 'Last 7 Days');
|
---|
| 262 | end;
|
---|
| 263 | lstSelectMod.Clear;
|
---|
| 264 | ControlChange(Self);
|
---|
| 265 | StatusText('Initializing Long List');
|
---|
| 266 | cboProcedure.InitLongList('') ;
|
---|
| 267 | StatusText('');
|
---|
| 268 | end;
|
---|
| 269 |
|
---|
| 270 | procedure TfrmODRad.ControlChange(Sender: TObject);
|
---|
| 271 | var
|
---|
| 272 | i: integer ;
|
---|
| 273 | begin
|
---|
| 274 | inherited;
|
---|
| 275 | if Changing then Exit;
|
---|
| 276 | Responses.Clear;
|
---|
| 277 | with cboProcedure do
|
---|
| 278 | if ItemIEN > 0 then Responses.Update('ORDERABLE', 1, ItemID, Text)
|
---|
| 279 | else Responses.Update('ORDERABLE', 1, '' , '');
|
---|
| 280 | //with calRequestDate do if FMDateTime > 0 then RPC call on EVERY character typed in REASON box!!!! (v15)
|
---|
| 281 | with calRequestDate do if Length(Text) > 0 then
|
---|
| 282 | Responses.Update('START', 1, Text, Text)
|
---|
| 283 | else Responses.Update('START', 1, '', '') ;
|
---|
| 284 | with cboUrgency do if Length(ItemID) > 0 then Responses.Update('URGENCY', 1, ItemID, Text);
|
---|
| 285 | with cboTransport do if Length(ItemID) > 0 then Responses.Update('MODE', 1, ItemID, Text);
|
---|
| 286 | with cboCategory do if Length(ItemID) > 0 then Responses.Update('CLASS', 1, ItemID, Text);
|
---|
| 287 | with cboSubmit do if Length(ItemID) > 0 then Responses.Update('IMLOC', 1, ItemID, Text);
|
---|
| 288 | with radPregnant do if Checked then Responses.Update('PREGNANT', 1, 'Y' , 'Yes')
|
---|
| 289 | else if not Enabled then Responses.Update('PREGNANT', 1, '' , '');
|
---|
| 290 | with radPregnantNo do if Checked then Responses.Update('PREGNANT', 1, 'N' , 'No');
|
---|
| 291 | with radPregnantUnknown do if Checked then Responses.Update('PREGNANT', 1, 'U' , 'Unknown');
|
---|
| 292 | with chkIsolation do if Checked then Responses.Update('YN', 1, '1' , 'Yes')
|
---|
| 293 | else Responses.Update('YN', 1, '0' , 'No');
|
---|
| 294 | with calPreOp do if Length(Text) > 0 then Responses.Update('PREOP', 1, FPreOpDate, Text);
|
---|
| 295 | with memReason do if GetTextLen > 0 then Responses.Update('COMMENT', 1, TX_WPTYPE, Text);
|
---|
| 296 | with lstSelectMod do for i := 0 to Items.Count - 1 do
|
---|
| 297 | Responses.Update('MODIFIER',i+1, Piece(Items[i],U,1), Piece(Items[i],U,2));
|
---|
| 298 | Responses.Update('PROVIDER',1, Piece(Radiologist,U,1),Piece(Radiologist,U,2)) ;
|
---|
| 299 | Responses.Update('CONTRACT',1, Piece(Contract,U,1),Piece(Contract,U,2)) ;
|
---|
| 300 | Responses.Update('RESEARCH',1, Research, Research) ;
|
---|
| 301 | if ALocation > 0 then Responses.Update('LOCATION', 1, IntToStr(ALocation), AName)
|
---|
| 302 | else with Encounter do Responses.Update('LOCATION', 1, IntToStr(Location) , LocationName);
|
---|
| 303 | memOrder.Text := Responses.OrderText;
|
---|
| 304 | end;
|
---|
| 305 |
|
---|
| 306 | procedure TfrmODRad.Validate(var AnErrMsg: string);
|
---|
| 307 | var
|
---|
| 308 | i, j: integer;
|
---|
| 309 | AskLoc: boolean;
|
---|
| 310 |
|
---|
| 311 | procedure SetError(const x: string);
|
---|
| 312 | begin
|
---|
| 313 | if Length(AnErrMsg) > 0 then AnErrMsg := AnErrMsg + CRLF;
|
---|
| 314 | AnErrMsg := AnErrMsg + x;
|
---|
| 315 | end;
|
---|
| 316 |
|
---|
| 317 | procedure GetOrderingLocation(AType: integer);
|
---|
| 318 | begin
|
---|
| 319 | ALocation := 0;
|
---|
| 320 | AName := '';
|
---|
| 321 | LookupLocation(ALocation, AName, AType, TX_LOC_ORDER);
|
---|
| 322 | if ALocation = 0 then
|
---|
| 323 | begin
|
---|
| 324 | SetError(TX_ORD_LOC);
|
---|
| 325 | if OrderForInpatient then cboCategory.SelectByID('I') else cboCategory.SelectByID('O');
|
---|
| 326 | with Encounter do Responses.Update('LOCATION', 1, IntToStr(Location) , LocationName);
|
---|
| 327 | end
|
---|
| 328 | else
|
---|
| 329 | Responses.Update('LOCATION', 1, IntToStr(ALocation), AName);
|
---|
| 330 | end;
|
---|
| 331 |
|
---|
| 332 | begin
|
---|
| 333 | inherited ;
|
---|
| 334 | with cboProcedure do
|
---|
| 335 | begin
|
---|
| 336 | if ((Length(Text) = 0) or (ItemIEN <= 0)) then SetError(TX_NO_PROC)
|
---|
| 337 | else
|
---|
| 338 | begin
|
---|
| 339 | if ItemID <> FLastRadID then Responses.Update('PROVIDER',1, '','');
|
---|
| 340 | if (UpperCase(Piece(Items[ItemIndex],U,4))='Y') and (Radiologist='') then
|
---|
| 341 | begin
|
---|
| 342 | SelectApprovingRadiologist(Font.Size, Radiologist);
|
---|
| 343 | if Radiologist='' then SetError(TX_APPROVAL_REQUIRED)
|
---|
| 344 | else
|
---|
| 345 | Responses.Update('PROVIDER',1, Piece(Radiologist,U,1),Piece(Radiologist,U,2)) ;
|
---|
| 346 | end ;
|
---|
| 347 | end ;
|
---|
| 348 | end;
|
---|
| 349 | with cboCategory do
|
---|
| 350 | begin
|
---|
| 351 | AskLoc := True;
|
---|
| 352 | if ((not Patient.Inpatient) and (Self.EvtType = 'A')) then
|
---|
| 353 | AskLoc := False;
|
---|
| 354 | if ItemID = '' then SetError(TX_NO_CATEGORY);
|
---|
| 355 | if (CharAt(ItemID,1) in ['C','S']) and (Contract = '') then SetError(TX_NO_SOURCE);
|
---|
| 356 | if (CharAt(ItemID, 1) = 'R') and (Research = '') then SetError(TX_NO_SOURCE);
|
---|
| 357 | if ((CharAt(ItemID, 1) = 'O') and (LocationType(Encounter.Location) = 'W')) then
|
---|
| 358 | begin
|
---|
| 359 | if AskLoc then
|
---|
| 360 | GetOrderingLocation(LOC_OUTP);
|
---|
| 361 | end
|
---|
| 362 | else if ((CharAt(ItemID, 1) = 'I') and (not (LocationType(Encounter.Location) = 'W'))) then
|
---|
| 363 | begin
|
---|
| 364 | if AskLoc then
|
---|
| 365 | GetOrderingLocation(LOC_INP);
|
---|
| 366 | end;
|
---|
| 367 | end;
|
---|
| 368 | if Length(cboTransport.Text) = 0 then SetError(TX_NO_MODE);
|
---|
| 369 |
|
---|
| 370 | if Length(memReason.Text) < 2 then
|
---|
| 371 | SetError(TX_NO_REASON)
|
---|
| 372 | else
|
---|
| 373 | begin
|
---|
| 374 | j := 0;
|
---|
| 375 | for i := 1 to Length(memReason.Text) do
|
---|
| 376 | begin
|
---|
| 377 | if memReason.Text[i] in ['A'..'Z','a'..'z','0'..'9'] then j := j + 1;
|
---|
| 378 | if not (memReason.Text[i] in ['A'..'Z','a'..'z','0'..'9']) and (j > 0) then j := 0;
|
---|
| 379 | if j = 2 then break;
|
---|
| 380 | end;
|
---|
| 381 | if j < 2 then SetError(TX_NO_REASON);
|
---|
| 382 | end;
|
---|
| 383 |
|
---|
| 384 | with cboSubmit do
|
---|
| 385 | if Enabled and (ItemIEN = 0)then SetError(TX_NO_IMAGING_LOCATION);
|
---|
| 386 |
|
---|
| 387 | with calRequestDate do
|
---|
| 388 | if FMDateTime = 0 then SetError(TX_NO_DATE);
|
---|
| 389 | end;
|
---|
| 390 |
|
---|
| 391 | procedure TfrmODRad.cboProcedureNeedData(Sender: TObject;
|
---|
| 392 | const StartFrom: string; Direction, InsertAt: Integer);
|
---|
| 393 | begin
|
---|
| 394 | inherited ;
|
---|
| 395 | cboProcedure.ForDataUse(SubSetOfRadProcs(DisplayGroup, StartFrom, Direction));
|
---|
| 396 | end;
|
---|
| 397 |
|
---|
| 398 | procedure TfrmODRad.cboAvailModMouseClick(Sender: TObject);
|
---|
| 399 | var
|
---|
| 400 | x: string;
|
---|
| 401 | i: integer;
|
---|
| 402 | Found: boolean;
|
---|
| 403 | begin
|
---|
| 404 | Found := False;
|
---|
| 405 | with cboAvailMod do x := Items[ItemIndex];
|
---|
| 406 | with lstSelectMod do
|
---|
| 407 | begin
|
---|
| 408 | if Items.Count > 0 then
|
---|
| 409 | for i := 0 to Items.Count - 1 do
|
---|
| 410 | if Items[i] = x then Found := True;
|
---|
| 411 | if not Found then
|
---|
| 412 | begin
|
---|
| 413 | Items.Add(x);
|
---|
| 414 | SelectByID(Piece(x, U, 1));
|
---|
| 415 | end;
|
---|
| 416 | end;
|
---|
| 417 | if Piece(x, '^', 2) = 'PORTABLE EXAM' then
|
---|
| 418 | cboTransport.SelectByID('P');
|
---|
| 419 | ControlChange(Sender);
|
---|
| 420 | end;
|
---|
| 421 |
|
---|
| 422 | procedure TfrmODRad.cmdRemoveClick(Sender: TObject);
|
---|
| 423 | begin
|
---|
| 424 | with lstSelectMod do
|
---|
| 425 | if (SelCount = 0) or (ItemIndex < 0) then exit
|
---|
| 426 | else
|
---|
| 427 | begin
|
---|
| 428 | if Piece(Items[ItemIndex], U, 2) = 'PORTABLE EXAM' then
|
---|
| 429 | with cboTransport do if OrderForInpatient
|
---|
| 430 | then SelectByID('W')
|
---|
| 431 | else SelectByID('A');
|
---|
| 432 | Items.Delete(ItemIndex);
|
---|
| 433 | ItemIndex := Items.Count - 1;
|
---|
| 434 | if ItemIndex > -1 then SelectByID(Piece(Items[ItemIndex], U, 1));
|
---|
| 435 | end ;
|
---|
| 436 | ControlChange(Sender);
|
---|
| 437 | end;
|
---|
| 438 |
|
---|
| 439 | procedure TfrmODRad.cboProcedureSelect(Sender: TObject);
|
---|
| 440 | var
|
---|
| 441 | tmpResp: TResponse;
|
---|
| 442 | begin
|
---|
| 443 | inherited;
|
---|
| 444 | with cboProcedure do
|
---|
| 445 | begin
|
---|
| 446 | if ItemID <> FLastRadID then
|
---|
| 447 | begin
|
---|
| 448 | FLastRadID := ItemID;
|
---|
| 449 | if FPredefineOrder then
|
---|
| 450 | FPredefineOrder := False;
|
---|
| 451 | end else Exit;
|
---|
| 452 | Changing := True;
|
---|
| 453 | if Sender <> Self then
|
---|
| 454 | Responses.Clear; // Sender=Self when called from SetupDialog
|
---|
| 455 | ClearControl(lstSelectMod);
|
---|
| 456 | ClearControl(lstLastExam);
|
---|
| 457 | //ClearControl(memReason); {WPB-1298-30758}
|
---|
| 458 | Changing := False;
|
---|
| 459 | if CharAt(ItemID, 1) = 'Q' then
|
---|
| 460 | with Responses do
|
---|
| 461 | begin
|
---|
| 462 | QuickOrder := ExtractInteger(ItemID);
|
---|
| 463 | //SetControl(cboProcedure, 'ORDERABLE', 1); //v22.9 - RV
|
---|
| 464 | //SetModifierList; //v22.9 - RV
|
---|
| 465 | FLastRadID := ItemID;
|
---|
| 466 | end;
|
---|
| 467 | end;
|
---|
| 468 | with Responses do if QuickOrder > 0 then
|
---|
| 469 | begin
|
---|
| 470 | Changing := True;
|
---|
| 471 | SetControl(cboProcedure, 'ORDERABLE', 1);
|
---|
| 472 | SetModifierList; //v22.9 - RV
|
---|
| 473 | SetControl(lstSelectMod, 'MODIFIER', 1);
|
---|
| 474 | SetControl(cboUrgency, 'URGENCY', 1);
|
---|
| 475 | SetControl(cboSubmit, 'IMLOC', 1);
|
---|
| 476 | SetControl(cboTransport, 'MODE', 1);
|
---|
| 477 | SetControl(cboCategory, 'CLASS', 1);
|
---|
| 478 | SetControl(memReason, 'COMMENT', 1);
|
---|
| 479 | SetControl(chkIsolation, 'YN', 1);
|
---|
| 480 | SetControl(radPregnant, 'PREGNANT', 1);
|
---|
| 481 | SetControl(calPreOp , 'PREOP', 1);
|
---|
| 482 | tmpResp := FindResponseByName('START',1);
|
---|
| 483 | if tmpResp <> nil then
|
---|
| 484 | begin
|
---|
| 485 | if ContainsAlpha(tmpResp.IValue) then
|
---|
| 486 | calRequestDate.Text := tmpResp.IValue
|
---|
| 487 | else
|
---|
| 488 | calRequestDate.FMDateTime := StrToFMDateTime(tmpResp.IValue);
|
---|
| 489 | end;
|
---|
| 490 | Changing := False;
|
---|
| 491 | end;
|
---|
| 492 | OrderMessage(ImagingMessage(cboProcedure.ItemIEN)) ;
|
---|
| 493 | ControlChange(Self);
|
---|
| 494 | end;
|
---|
| 495 |
|
---|
| 496 | procedure TfrmODRad.SetModifierList;
|
---|
| 497 | var
|
---|
| 498 | i: integer;
|
---|
| 499 | tmpResp: TResponse;
|
---|
| 500 | begin
|
---|
| 501 | i := 1;
|
---|
| 502 | tmpResp := Responses.FindResponseByName('MODIFIER',i);
|
---|
| 503 | while tmpResp <> nil do
|
---|
| 504 | begin
|
---|
| 505 | lstSelectMod.Items.Add(tmpResp.IValue + '^' + tmpResp.EValue);
|
---|
| 506 | if tmpResp.EValue = 'PORTABLE EXAM' then
|
---|
| 507 | with cboTransport do SelectByID('P');
|
---|
| 508 | Inc(i);
|
---|
| 509 | tmpResp := Responses.FindResponseByName('MODIFIER',i);
|
---|
| 510 | end ;
|
---|
| 511 | end;
|
---|
| 512 |
|
---|
| 513 | procedure TfrmODRad.cboCategoryChange(Sender: TObject);
|
---|
| 514 | var
|
---|
| 515 | Source: string;
|
---|
| 516 | begin
|
---|
| 517 | inherited;
|
---|
| 518 | if Contract <> '' then Source := Contract
|
---|
| 519 | else if Research <> '' then Source := Research
|
---|
| 520 | else Source := '';
|
---|
| 521 | Contract := '';
|
---|
| 522 | Research := '';
|
---|
| 523 | with cboCategory do
|
---|
| 524 | begin
|
---|
| 525 | if CharAt(ItemID,1) in ['C','S','R'] then
|
---|
| 526 | begin
|
---|
| 527 | SelectSource(Font.Size, CharAt(ItemID,1), Source);
|
---|
| 528 | if Source = '-1' then
|
---|
| 529 | InfoBox(TX_NO_AGREE, TX_NO_AGREE_CAP, MB_OK or MB_ICONWARNING)
|
---|
| 530 | else if CharAt(ItemID,1) in ['C','S'] then
|
---|
| 531 | Contract := Source
|
---|
| 532 | else if ItemID='R' then
|
---|
| 533 | Research := Source;
|
---|
| 534 | end;
|
---|
| 535 | end;
|
---|
| 536 | ControlChange(Self);
|
---|
| 537 | end;
|
---|
| 538 |
|
---|
| 539 | procedure TfrmODRad.FormCreate(Sender: TObject);
|
---|
| 540 | begin
|
---|
| 541 | AutoSizeDisabled := True;
|
---|
| 542 | inherited;
|
---|
| 543 | memReason.Width := pnlHandR.ClientWidth;
|
---|
| 544 | memReason.Height := pnlHandR.ClientHeight - memReason.Top;
|
---|
| 545 | FillerID := 'RA'; // does 'on Display' order check **KCM**
|
---|
| 546 | StatusText('Loading Dialog Definition');
|
---|
| 547 | Responses.Clear;
|
---|
| 548 | DisplayGroup := 0;
|
---|
| 549 | AllowQuickOrder := True;
|
---|
| 550 | Responses.Dialog := 'RA OERR EXAM'; // loads formatting info
|
---|
| 551 | StatusText('Loading Default Values');
|
---|
| 552 | cboImType.Items.Assign(SubsetOfImagingTypes);
|
---|
| 553 | if Self.EvtID>0 then
|
---|
| 554 | FEvtDelayDiv := GetEventDiv1(IntToStr(Self.EvtID));
|
---|
| 555 | PreserveControl(cboImType);
|
---|
| 556 | PreserveControl(calRequestDate);
|
---|
| 557 | PreserveControl(cboUrgency);
|
---|
| 558 | PreserveControl(cboTransport);
|
---|
| 559 | PreserveControl(cboSubmit);
|
---|
| 560 | PreserveControl(cboCategory);
|
---|
| 561 | PreserveControl(calPreOp);
|
---|
| 562 | PreserveControl(memReason); {WPB-1298-30758}
|
---|
| 563 | if (Patient.Sex <> 'F') then
|
---|
| 564 | begin
|
---|
| 565 | radPregnant.Enabled := False;
|
---|
| 566 | radPregnantNo.Enabled := False;
|
---|
| 567 | radPregnantUnknown.Enabled := False;
|
---|
| 568 | end else SetDefaultPregant;
|
---|
| 569 | end;
|
---|
| 570 |
|
---|
| 571 | {Assigned to cbolmType.OnDropDownClose and cbolmType.OnExit, instead of
|
---|
| 572 | cbolmType.OnChange, becuase when it is OnChange the delay interfers with
|
---|
| 573 | Window-Eyes ability to read the drop-down Items.}
|
---|
| 574 | procedure TfrmODRad.cboImTypeChange(Sender: TObject);
|
---|
| 575 | begin
|
---|
| 576 | inherited;
|
---|
| 577 | if FPredefineOrder then
|
---|
| 578 | FPredefineOrder := False;
|
---|
| 579 | if Changing or (cboImtype.ItemIndex = -1) then exit;
|
---|
| 580 | with cboImType do DisplayGroup := StrToIntDef(Piece(Items[ItemIndex], U, 4), 0) ;
|
---|
| 581 | if DisplayGroup = 0 then exit;
|
---|
| 582 | CtrlInits.LoadDefaults(ODForRad(Patient.DFN, FEvtDelayDiv, DisplayGroup)); // ODForRad returns TStrings with defaults
|
---|
| 583 | FPredefineOrder := False;
|
---|
| 584 | InitDialog;
|
---|
| 585 | end;
|
---|
| 586 |
|
---|
| 587 | procedure TfrmODRad.FormPaint(Sender: TObject);
|
---|
| 588 | begin
|
---|
| 589 | inherited;
|
---|
| 590 | with cboImType do
|
---|
| 591 | if not FEditCopy and (ItemIEN = 0) and (DroppedDown = False) and (Application.Active)
|
---|
| 592 | then DroppedDown := True;
|
---|
| 593 | end;
|
---|
| 594 |
|
---|
| 595 | procedure TfrmODRad.memReasonExit(Sender: TObject);
|
---|
| 596 | var
|
---|
| 597 | AStringList: TStringList;
|
---|
| 598 | begin
|
---|
| 599 | inherited;
|
---|
| 600 | AStringList := TStringList.Create;
|
---|
| 601 | try
|
---|
| 602 | AStringList.Assign(memReason.Lines);
|
---|
| 603 | LimitStringLength(AStringList, 74);
|
---|
| 604 | memReason.Lines.Assign(AstringList);
|
---|
| 605 | ControlChange(Self);
|
---|
| 606 | finally
|
---|
| 607 | AStringList.Free;
|
---|
| 608 | end;
|
---|
| 609 | end;
|
---|
| 610 |
|
---|
| 611 | procedure TfrmODRad.FormResize(Sender: TObject);
|
---|
| 612 | begin
|
---|
| 613 | inherited;
|
---|
| 614 | memReason.Width := pnlHandR.ClientWidth;
|
---|
| 615 | memReason.Height := pnlHandR.ClientHeight - memReason.Top;
|
---|
| 616 | end;
|
---|
| 617 |
|
---|
| 618 | procedure TfrmODRad.cboAvailModKeyDown(Sender: TObject; var Key: Word;
|
---|
| 619 | Shift: TShiftState);
|
---|
| 620 | begin
|
---|
| 621 | inherited;
|
---|
| 622 | if Key = VK_RETURN then cboAvailModMouseClick(Self);
|
---|
| 623 | end;
|
---|
| 624 |
|
---|
| 625 | procedure TfrmODRad.calPreOpChange(Sender: TObject);
|
---|
| 626 | begin
|
---|
| 627 | inherited;
|
---|
| 628 | FPreOpDate := FloatToStr(calPreOp.FMDateTime);
|
---|
| 629 | ControlChange(Self);
|
---|
| 630 | end;
|
---|
| 631 |
|
---|
| 632 | procedure TfrmODRad.SetDefaultPregant;
|
---|
| 633 | begin
|
---|
| 634 | if (Patient.Sex = 'F') and ((Patient.Age > 55) or (Patient.Age < 12)) then
|
---|
| 635 | radPregnantNo.Checked := True;
|
---|
| 636 | end;
|
---|
| 637 |
|
---|
| 638 | procedure TfrmODRad.cmdAcceptClick(Sender: TObject);
|
---|
| 639 | const
|
---|
| 640 | Txt1 = 'This order can not be saved for the following reason(s):';
|
---|
| 641 | Txt2 = #13+#13+'A response for the pregnant field must be selected.';
|
---|
| 642 | var
|
---|
| 643 | NeedCheckPregnant: boolean;
|
---|
| 644 | begin
|
---|
| 645 | if Patient.Sex = 'F' then
|
---|
| 646 | begin
|
---|
| 647 | NeedCheckPregnant := True;
|
---|
| 648 | if radPregnant.Checked then NeedCheckPregnant := False
|
---|
| 649 | else if radPregnantNo.Checked then NeedCheckPregnant := False
|
---|
| 650 | else if radPregnantUnknown.Checked then NeedCheckPregnant := False;
|
---|
| 651 | if NeedCheckPregnant then
|
---|
| 652 | begin
|
---|
| 653 | MessageDlg(Txt1+Txt2, mtWarning,[mbOK],0);
|
---|
| 654 | Exit;
|
---|
| 655 | end;
|
---|
| 656 | end;
|
---|
| 657 | inherited;
|
---|
| 658 | end;
|
---|
| 659 |
|
---|
| 660 | procedure TfrmODRad.cboProcedureExit(Sender: TObject);
|
---|
| 661 | var
|
---|
| 662 | i: integer;
|
---|
| 663 | ModList: TStringList;
|
---|
| 664 | begin
|
---|
| 665 | inherited;
|
---|
| 666 | ModList := TStringList.Create;
|
---|
| 667 | if lstSelectMod.Items.Count > 0 then
|
---|
| 668 | for i := 0 to lstSelectMod.Count - 1 do
|
---|
| 669 | ModList.Add(lstSelectMod.Items[i]);
|
---|
| 670 | cboProcedureSelect(Self);
|
---|
| 671 | for i := 0 to ModList.Count - 1 do
|
---|
| 672 | begin
|
---|
| 673 | lstSelectMod.Items.Add(ModList[i]);
|
---|
| 674 | lstSelectMod.SelectByID(Piece(ModList[i],U,1));
|
---|
| 675 | end;
|
---|
| 676 | with lstSelectMod do
|
---|
| 677 | for i := 0 to Items.Count - 1 do
|
---|
| 678 | Responses.Update('MODIFIER',i+1, Piece(Items[i],U,1), Piece(Items[i],U,2));
|
---|
| 679 | end;
|
---|
| 680 |
|
---|
| 681 | procedure TfrmODRad.cboImTypeExit(Sender: TObject);
|
---|
| 682 | begin
|
---|
| 683 | inherited;
|
---|
| 684 | if FPredefineOrder then Exit
|
---|
| 685 | else cboImTypeChange(Self);
|
---|
| 686 | end;
|
---|
| 687 |
|
---|
| 688 | end.
|
---|
| 689 |
|
---|