Module

fODRad

Path

C:\CPRS\CPRS30\Orders\fODRad.pas

Last Modified

7/15/2014 3:26:42 PM

Units Used in Interface

Name Comments
fODBase -
uConst -

Units Used in Implementation

Name Comments
fFrame -
fLkUpLocation -
fODRadApproval -
fODRadConShRes -
rCore -
rODBase -
rODRad -
rOrders -
uCore -
uFormMonitor -

Classes

Name Comments
TfrmODRad -

Procedures

Name Owner Declaration Scope Comments
calPreOpChange TfrmODRad procedure calPreOpChange(Sender: TObject); Public/Published -
calPreOpExit TfrmODRad procedure calPreOpExit(Sender: TObject); Public/Published -
cboAvailModKeyDown TfrmODRad procedure cboAvailModKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); Public/Published -
cboAvailModMouseClick TfrmODRad procedure cboAvailModMouseClick(Sender: TObject); Public/Published -
cboCategoryChange TfrmODRad procedure cboCategoryChange(Sender: TObject); Public/Published -
cboImTypeChange TfrmODRad procedure cboImTypeChange(Sender: TObject); Public/Published
Assigned to cbolmType.OnDropDownClose and cbolmType.OnExit, instead of
 cbolmType.OnChange, becuase when it is OnChange the delay interfers with
 Window-Eyes ability to read the drop-down Items.
cboImTypeDropDownClose TfrmODRad procedure cboImTypeDropDownClose(Sender: TObject); Public/Published -
cboImTypeExit TfrmODRad procedure cboImTypeExit(Sender: TObject); Public/Published -
cboProcedureExit TfrmODRad procedure cboProcedureExit(Sender: TObject); Public/Published -
cboProcedureNeedData TfrmODRad procedure cboProcedureNeedData(Sender: TObject; const StartFrom: string; Direction, InsertAt: Integer); Public/Published -
cboProcedureSelect TfrmODRad procedure cboProcedureSelect(Sender: TObject); Public/Published -
chkIsolationExit TfrmODRad procedure chkIsolationExit(Sender: TObject); Public/Published -
cmdAcceptClick TfrmODRad procedure cmdAcceptClick(Sender: TObject); Public/Published -
cmdRemoveClick TfrmODRad procedure cmdRemoveClick(Sender: TObject); Public/Published -
ControlChange TfrmODRad procedure ControlChange(Sender: TObject); Public/Published -
FormClose TfrmODRad procedure FormClose(Sender: TObject; var Action: TCloseAction); Public/Published -
FormCreate TfrmODRad procedure FormCreate(Sender: TObject); Public/Published -
FormFirstOpened TfrmODRad procedure FormFirstOpened(Sender: TObject); Private -
FormResize TfrmODRad procedure FormResize(Sender: TObject); Public/Published -
GetOrderingLocation - procedure GetOrderingLocation(AType: integer); Local -
ImageTypeChange TfrmODRad procedure ImageTypeChange; Private -
InitDialog TfrmODRad procedure InitDialog; override; Protected -
memHistoryExit TfrmODRad procedure memHistoryExit(Sender: TObject); Public/Published -
pnlMessageExit TfrmODRad procedure pnlMessageExit(Sender: TObject); Public/Published
TDP - Added to control where focus went now that pnlMessage was being focused
       out of turn after cboProcedure.
pnlMessageMouseUp TfrmODRad procedure pnlMessageMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); Public/Published
TDP - Added to control where focus went now that pnlMessage was being focused
       out of turn after cboProcedure.
SetDefaultPregant TfrmODRad procedure SetDefaultPregant; Protected -
SetError - procedure SetError(const x: string); Local -
SetModifierList TfrmODRad procedure SetModifierList; Public/Published -
setup508Label TfrmODRad procedure setup508Label(text: string; lbl: TVA508StaticText; ctrl: TControl); Private TDP - CQ#19393 cboSubmit 508 changes. Can change in future to be generic if needed. (See fODLab.pas)
SetupDialog TfrmODRad procedure SetupDialog(OrderAction: Integer; const ID: string); override; Public TfrmODBase common methods
VA508ComponentAccessibility1StateQuery TfrmODRad procedure VA508ComponentAccessibility1StateQuery(Sender: TObject; var Text: string); Public/Published TDP - CQ#19393 Made history memobox read text
Validate TfrmODRad procedure Validate(var AnErrMsg: string); override; Protected -

Functions

Name Owner Declaration Scope Comments
NoPregnantSelection TfrmODRad function NoPregnantSelection : Boolean; Private -

Global Variables

Name Type Declaration Comments
ALocation Integer ALocation, AType: integer; -
AName UnicodeString AName, IsPregnant: string; -
AType Integer ALocation, AType: integer; -
Contract UnicodeString Radiologist, Contract, Research: string ; -
IsPregnant UnicodeString AName, IsPregnant: string; -
Radiologist UnicodeString Radiologist, Contract, Research: string ; -
Research UnicodeString Radiologist, Contract, Research: string ; -

Constants

Name Declaration Scope Comments
TC_REQ_LOC 'Location Required' Global -
TX_APPROVAL_REQUIRED 'This procedure requires Radiologist approval.' Global -
TX_BAD_DATE 'The "Date Desired" you have entered is invalid.' Global -
TX_BAD_HISTORY 'An incomplete or invalid Clinical History has been entered.' + CRLF + Global -
TX_LOC_ORDER 'The selected location will be used to determine the ordering location ' + Global -
TX_NO_AGREE 'There are no active agreements of the type specified.' Global -
TX_NO_AGREE_CAP 'No Agreements on file' Global -
TX_NO_CATEGORY 'A category of examination must be specified.' Global -
TX_NO_DATE 'A "Date Desired" must be specified.' Global -
TX_NO_IMAGING_LOCATION 'A "Submit To" location must be specified.' Global -
TX_NO_MODE 'A mode of transport must be selected.' Global -
TX_NO_PROC 'An Imaging Procedure must be specified.' Global -
TX_NO_REASON 'A Reason for Study must be entered.' Global -
TX_NO_SOURCE 'A source must be specified for Contract/Sharing/Research patients.' Global -
TX_ORD_LOC 'Ordering location must be specified if patient type and order category do not match.' Global -
TX_PAST_DATE '"Date Desired" must not be in the past.' Global -


Module Source

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, VA508AccessibilityManager, VA508AccessibilityRouter;
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        lblHistory: TLabel;
25        memHistory: 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        lblReason: TLabel;
49        txtReason: TCaptionEdit;
50        pnlRightBase: TORAutoPanel;
51        Submitlbl508: TVA508StaticText;
52        VA508ComponentAccessibility1: TVA508ComponentAccessibility;
53        VA508ComponentAccessibility2: TVA508ComponentAccessibility;
54        procedure cboProcedureNeedData(Sender: TObject;
55                  const StartFrom: string; Direction, InsertAt: Integer);
56        procedure cboAvailModMouseClick(Sender: TObject);
57        procedure cmdRemoveClick(Sender: TObject);
58        procedure ControlChange(Sender: TObject);
59        procedure cboProcedureSelect(Sender: TObject);
60        procedure SetModifierList;
61        procedure cboCategoryChange(Sender: TObject);
62        procedure FormCreate(Sender: TObject);
63        procedure cboImTypeChange(Sender: TObject);
64        procedure memHistoryExit(Sender: TObject);
65        procedure FormResize(Sender: TObject);
66        procedure cboAvailModKeyDown(Sender: TObject; var Key: Word;
67          Shift: TShiftState);
68        procedure calPreOpChange(Sender: TObject);
69        procedure cmdAcceptClick(Sender: TObject);
70        procedure cboProcedureExit(Sender: TObject);
71        procedure cboImTypeExit(Sender: TObject);
72        procedure FormClose(Sender: TObject; var Action: TCloseAction);
73        procedure chkIsolationExit(Sender: TObject);
74        procedure calPreOpExit(Sender: TObject);
75        procedure cboImTypeDropDownClose(Sender: TObject);
76        procedure pnlMessageExit(Sender: TObject);
77        procedure VA508ComponentAccessibility1StateQuery(Sender: TObject;
78          var Text: string);
79        procedure pnlMessageMouseUp(Sender: TObject; Button: TMouseButton;
80          Shift: TShiftState; X, Y: Integer);
81      private
82        FLastRadID: string;
83        FEditCopy: boolean;
84        FPreOpDate: string;
85        FEvtDelayDiv: string;
86        FPredefineOrder: boolean;
87        ImageTypeChanged : boolean;
88        FFormFirstOpened: boolean;
89        function NoPregnantSelection : Boolean;
90        procedure ImageTypeChange;
91        procedure FormFirstOpened(Sender: TObject);
92        procedure setup508Label(text: string; lbl: TVA508StaticText; ctrl: TControl);
93      protected
94        procedure InitDialog; override;
95        procedure Validate(var AnErrMsg: string); override;
96        procedure SetDefaultPregant;
97      public
98        procedure SetupDialog(OrderAction: Integer; const ID: string); override;
99      end;
100   
101   implementation
102   
103   {$R *.DFM}
104   
105   uses rODBase, rODRad, rOrders, uCore, rCore, fODRadApproval, fODRadConShRes, fLkUpLocation, fFrame,
106     uFormMonitor;
107   
108   const
109     TX_NO_PROC          = 'An Imaging Procedure must be specified.'    ;
110     TX_NO_MODE          = 'A mode of transport must be selected.';
111     TX_NO_REASON        = 'A Reason for Study must be entered.'  ;
112     TX_BAD_HISTORY      = 'An incomplete or invalid Clinical History has been entered.' + CRLF +
113                           'Please correct or clear.';
114     TX_NO_DATE          = 'A "Date Desired" must be specified.' ;
115     TX_BAD_DATE         = 'The "Date Desired" you have entered is invalid.';
116     TX_PAST_DATE        = '"Date Desired" must not be in the past.';
117     TX_APPROVAL_REQUIRED= 'This procedure requires Radiologist approval.' ;
118     TX_NO_SOURCE        = 'A source must be specified for Contract/Sharing/Research patients.';
119     TX_NO_AGREE         = 'There are no active agreements of the type specified.';
120     TX_NO_AGREE_CAP     = 'No Agreements on file';
121     TX_ORD_LOC          = 'Ordering location must be specified if patient type and order category do not match.';
122     TC_REQ_LOC          = 'Location Required';
123     TX_LOC_ORDER        = 'The selected location will be used to determine the ordering location ' +
124                           'when the patient location does not match the specified category.';
125     TX_NO_CATEGORY      = 'A category of examination must be specified.';
126     TX_NO_IMAGING_LOCATION = 'A  "Submit To"  location must be specified.';
127   
128   var
129     Radiologist, Contract, Research: string ;
130     AName, IsPregnant: string;
131     ALocation, AType: integer;
132     
133   { TfrmODBase common methods }
134   
135   procedure TfrmODRad.SetupDialog(OrderAction: Integer; const ID: string);
136   var
137     tmpResp: TResponse;
138     i: integer;
139   begin
140     inherited;
141     if OrderAction in [ORDER_COPY, ORDER_EDIT, ORDER_QUICK] then with Responses do
142     begin
143       if (OrderAction = ORDER_QUICK) or (OrderAction = ORDER_EDIT) or (OrderAction = ORDER_COPY) then
144         FPredefineOrder := True;
145       FEditCopy := True;
146       Changing := True;
147       with cboImType do
148         begin
149           FastAssign(SubsetOfImagingTypes, cboImType.Items);
150           for i := 0 to Items.Count-1 do
151             if StrToIntDef(Piece(Items[i],U,4), 0) = DisplayGroup then ItemIndex := i;
152           if OrderAction = ORDER_EDIT then
153           begin
154             Enabled := False;
155             Color := clBtnFace;
156           end;
157        end;
158       if Self.EvtID>0 then
159         FEvtDelayDiv := GetEventDiv1(IntToStr(Self.EvtID));
160       CtrlInits.LoadDefaults(ODForRad(Patient.DFN, FEvtDelayDiv, DisplayGroup));   // ODForRad returns TStrings with defaults
161       InitDialog;
162       SetControl(cboProcedure,       'ORDERABLE', 1);
163       Changing := True;
164       SetModifierList;
165       SetControl(cboUrgency,         'URGENCY', 1);
166       SetControl(cboTransport,       'MODE', 1);
167       SetControl(cboSubmit,          'IMLOC', 1);
168       SetControl(cboCategory,        'CLASS', 1);
169       SetControl(txtReason,           'REASON', 1);
170       SetControl(memHistory,         'COMMENT', 1);
171       SetControl(chkIsolation,       'YN', 1);
172       SetControl(radPregnant,        'PREGNANT', 1);
173       SetControl(calPreOp,           'PREOP', 1);
174       tmpResp := FindResponseByName('START',1);
175       if tmpResp <> nil then
176         begin
177           if ContainsAlpha(tmpResp.IValue) then
178             calRequestDate.Text := tmpResp.IValue
179           else
180             calRequestDate.FMDateTime := StrToFMDateTime(tmpResp.IValue);
181         end;
182       tmpResp := FindResponseByName('PROVIDER',1);
183       if tmpResp <> nil then with tmpResp do if Length(EValue)>0 then Radiologist := IValue + '^' + EValue;
184       if (cboCategory.ItemID = 'C') or (cboCategory.ItemID = 'S') then
185         begin
186           tmpResp := FindResponseByName('CONTRACT',1);
187           if tmpResp <> nil then with tmpResp do
188            if Length(EValue)>0 then
189             begin
190               Contract := IValue + '^' + EValue;
191               Research := '';
192             end;
193         end;
194       if cboCategory.ItemID = 'R' then
195         begin
196           tmpResp := FindResponseByName('RESEARCH',1);
197           if tmpResp <> nil then with tmpResp do
198            if Length(EValue)>0 then
199             begin
200               Research := EValue;
201               Contract := '';
202             end;
203         end;
204       //hds00007460
205       tmpResp := FindResponseByName('PREGNANT',1);
206       if tmpResp <> nil then
207          if Length(tmpResp.EValue)>0 then
208          begin
209             IsPregnant := tmpResp.EValue;
210             if IsPregnant = 'YES' then
211                radPregnant.Checked := True
212             else
213             if IsPregnant = 'NO' then
214                radPregnantNo.Checked := True
215             else
216             if IsPregnant = 'UNKNOWN' then
217                radPregnantUnknown.Checked := True;
218          end;
219       //hds00007460
220       Changing := False;
221       FEditCopy := False;
222       OrderMessage(ImagingMessage(cboProcedure.ItemIEN)) ;
223       ControlChange(Self);
224       FPredefineOrder := False;
225     end;
226   end;
227   
228   procedure TfrmODRad.InitDialog;
229   var
230      i: integer;
231      tmplst: TStringList;
232      cboSubmitText: String;
233   begin
234     if not FEditCopy then
235     begin
236       inherited;
237       if not ReasonForStudyCarryOn then txtReason.text := '';
238     end;
239   
240     FPreOpDate := '';
241     FLastRadID := '';
242     Radiologist := '';
243     Contract := '';
244     Research := '';
245     ALocation := 0;
246     AName := '';
247     AType := 0;
248     FEvtDelayDiv := '';
249     if (Self.EvtID > 0 ) and (FEvtDelayDiv = '') then
250       FEvtDelayDiv := GetEventDiv1(IntToStr(Self.EvtID));
251     with CtrlInits do
252      begin
253       SetControl(cboProcedure, 'ShortList');
254       if cboProcedure.Items.Count > 0 then cboProcedure.InsertSeparator;
255       SetControl(FRadCommonCombo, 'Common Procedures');
256       for i := 0 to FRadCommonCombo.Items.Count-1 do
257         cboProcedure.Items.Add(FRadCommonCombo.Items[i]);
258       if FRadCommonCombo.Items.Count>0 then cboProcedure.InsertSeparator;
259   
260       //calRequestDate.Text := 'TODAY';     default removed per E3R #19834 - v27.10 - RV
261       SetControl(cboAvailMod, 'Modifiers');
262       SetControl(cboUrgency, 'Urgencies');
263       SetControl(cboTransport, 'Transport');
264       with cboTransport do if OrderForInpatient
265         then SelectByID('W')
266         else SelectByID('A');
267       SetControl(cboCategory, 'Category');
268       with cboCategory do if OrderForInpatient
269         then SelectByID('I')
270         else SelectByID('O');
271       SetControl(cboSubmit, 'Submit to');
272       SetControl(lblAskSubmit,'Ask Submit') ;
273       if (cboSubmit.Items.Count = 0) then
274         begin
275           cboSubmit.ItemIndex := -1;
276           lblSubmit.Enabled := False;
277           cboSubmit.Enabled := False;
278           //TDP - CQ#19393 cboSubmit 508 changes
279           cboSubmitText := cboSubmit.Text;
280           if cboSubmitText = '' then cboSubmitText := 'No Value';
281           setup508Label(cboSubmitText, Submitlbl508, cboSubmit);
282           cboSubmit.Font.Color := clGrayText;
283         end
284       else if (lblAskSubmit.Caption = 'YES') then
285         begin
286           if (cboSubmit.Items.Count > 1) then
287             begin
288               tmplst := TStringList.Create;
289               try
290                 FastAssign(cboSubmit.Items, tmplst);
291                 SortByPiece(tmplst, U, 2);
292                 FastAssign(tmplst, cboSubmit.Items);
293               finally
294                 tmplst.Free;
295               end;
296               cboSubmit.ItemIndex := -1 ;
297               lblSubmit.Enabled := True;
298               cboSubmit.Enabled := True;
299               //TDP - CQ#19393 cboSubmit 508 changes
300               cboSubmitText := cboSubmit.Text;
301               if cboSubmitText = '' then cboSubmitText := 'No Value';
302               setup508Label(cboSubmitText, Submitlbl508, cboSubmit);
303               cboSubmit.Font.Color := clWindowText;
304             end
305           else
306             begin
307               cboSubmit.ItemIndex := 0;
308               lblSubmit.Enabled := False;
309               cboSubmit.Enabled := False;
310               //TDP - CQ#19393 cboSubmit 508 changes
311               cboSubmitText := cboSubmit.Text;
312               if cboSubmitText = '' then cboSubmitText := 'No Value';
313               setup508Label(cboSubmitText, Submitlbl508, cboSubmit);
314               cboSubmit.Font.Color := clGrayText;
315             end;
316         end
317       else if lblAskSubmit.Caption = 'NO' then
318         begin
319           if (cboSubmit.Items.Count = 1) then
320             cboSubmit.ItemIndex := 0
321           else
322             cboSubmit.ItemIndex := -1 ;
323           lblSubmit.Enabled := False;
324           cboSubmit.Enabled := False;
325           //TDP - CQ#19393 cboSubmit 508 changes
326           cboSubmitText := cboSubmit.Text;
327           if cboSubmitText = '' then cboSubmitText := 'No Value';
328           setup508Label(cboSubmitText, Submitlbl508, cboSubmit);
329           cboSubmit.Font.Color := clGrayText;
330         end;
331       chkIsolation.Checked := PatientOnIsolationProcedures(Patient.DFN) ;
332       SetControl(lstLastExam, 'Last 7 Days');
333      end;
334     lstSelectMod.Clear;
335     ControlChange(Self);
336     StatusText('Initializing Long List');
337     cboProcedure.InitLongList('') ;
338     StatusText('');
339   end;
340   
341   procedure TfrmODRad.ControlChange(Sender: TObject);
342   var
343     i: integer ;
344   begin
345     inherited;
346     if Changing then Exit;
347     Responses.Clear;
348     with cboProcedure do
349       if ItemIEN > 0 then Responses.Update('ORDERABLE', 1, ItemID, Text)
350       else Responses.Update('ORDERABLE', 1, ''    , '');
351     //with calRequestDate do if FMDateTime > 0 then     RPC call on EVERY character typed in REASON box!!!!  (v15)
352     with calRequestDate do if Length(Text) > 0 then
353       Responses.Update('START', 1, Text, Text)
354       else Responses.Update('START', 1, '', '') ;
355     with cboUrgency do if Length(ItemID)   > 0 then Responses.Update('URGENCY',   1, ItemID, Text);
356     with cboTransport do if Length(ItemID) > 0 then Responses.Update('MODE',      1, ItemID, Text);
357     with cboCategory do if Length(ItemID)  > 0 then Responses.Update('CLASS',     1, ItemID, Text);
358     with cboSubmit do if Length(ItemID)    > 0 then Responses.Update('IMLOC',     1, ItemID, Text);
359     with radPregnant do if Checked                then Responses.Update('PREGNANT',  1, 'Y'   , 'Yes')
360                    else if not Enabled         then Responses.Update('PREGNANT',  1, ''    , '');
361     with radPregnantNo do if Checked           then Responses.Update('PREGNANT',  1, 'N'   , 'No');
362     with radPregnantUnknown do if Checked      then Responses.Update('PREGNANT',  1, 'U'   , 'Unknown');
363     with chkIsolation do if Checked            then Responses.Update('YN',        1, '1'   , 'Yes')
364                                                else Responses.Update('YN',        1, '0'   , 'No');
365     with calPreOp do if Length(Text) > 0       then Responses.Update('PREOP',     1, FPreOpDate, Text);
366     with txtReason  do if GetTextLen        > 0 then Responses.Update('REASON',    1, Text, Text);
367     with memHistory do if GetTextLen       > 0 then Responses.Update('COMMENT',   1, TX_WPTYPE, Text);
368     with lstSelectMod do for i := 0 to Items.Count - 1 do
369                                                     Responses.Update('MODIFIER',i+1, Piece(Items[i],U,1), Piece(Items[i],U,2));
370     Responses.Update('PROVIDER',1, Piece(Radiologist,U,1),Piece(Radiologist,U,2)) ;
371     Responses.Update('CONTRACT',1, Piece(Contract,U,1),Piece(Contract,U,2)) ;
372     Responses.Update('RESEARCH',1, Research, Research) ;
373     if ALocation > 0 then  Responses.Update('LOCATION', 1, IntToStr(ALocation), AName)
374     else with Encounter do Responses.Update('LOCATION', 1, IntToStr(Location) , LocationName);
375     memOrder.Text := Responses.OrderText;
376   end;
377   
378   //TDP - CQ#19393 Made history memobox read text
379   procedure TfrmODRad.VA508ComponentAccessibility1StateQuery(Sender: TObject;
380     var Text: string);
381   begin
382     inherited;
383     Text := memHistory.Text;
384   end;
385   
386   procedure TfrmODRad.Validate(var AnErrMsg: string);
387   var
388     i, j: integer;
389     AskLoc: boolean;
390   
391     procedure SetError(const x: string);
392     begin
393       if Length(AnErrMsg) > 0 then AnErrMsg := AnErrMsg + CRLF;
394       AnErrMsg := AnErrMsg + x;
395     end;
396   
397     procedure GetOrderingLocation(AType: integer);
398     begin
399       ALocation := 0;
400       AName := '';
401       LookupLocation(ALocation, AName, AType, TX_LOC_ORDER);
402       if ALocation = 0 then
403         begin
404           SetError(TX_ORD_LOC);
405           if OrderForInpatient then cboCategory.SelectByID('I') else cboCategory.SelectByID('O');
406           with Encounter do Responses.Update('LOCATION', 1, IntToStr(Location) , LocationName);
407         end
408       else
409         Responses.Update('LOCATION', 1, IntToStr(ALocation), AName);
410     end;
411   
412   begin
413     inherited ;
414     with cboProcedure do
415       begin
416         if ((Length(Text) = 0) or (ItemIEN <= 0)) then SetError(TX_NO_PROC)
417         else
418           begin
419             if ItemID <> FLastRadID then Responses.Update('PROVIDER',1, '','');
420             if (UpperCase(Piece(Items[ItemIndex],U,4))='Y') and (Radiologist='') then
421              begin
422                SelectApprovingRadiologist(Font.Size, Radiologist);
423                if Radiologist='' then  SetError(TX_APPROVAL_REQUIRED)
424                else
425                  Responses.Update('PROVIDER',1, Piece(Radiologist,U,1),Piece(Radiologist,U,2)) ;
426              end ;
427           end ;
428       end;
429   
430     if Length(txtReason.Text) < 3 then
431       SetError(TX_NO_REASON)
432     else
433       begin
434         j := 0;
435         for i := 1 to Length(txtReason.Text) do
436           begin
437             if txtReason.Text[i] in ['A'..'Z','a'..'z','0'..'9'] then j := j + 1;
438             if not (txtReason.Text[i] in ['A'..'Z','a'..'z','0'..'9']) and (j > 0) then j := 0;
439             if j = 2 then break;
440           end;
441         if j < 2 then SetError(TX_NO_REASON);
442       end;
443   
444     if Length(memHistory.Text) > 0 then
445     begin
446       j := 0;
447       for i := 1 to Length(memHistory.Text) do
448         begin
449           if memHistory.Text[i] in ['A'..'Z','a'..'z','0'..'9'] then j := j + 1;
450           if not (memHistory.Text[i] in ['A'..'Z','a'..'z','0'..'9']) and (j > 0) then j := 0;
451           if j = 2 then break;
452         end;
453       if j < 2 then SetError(TX_BAD_HISTORY);
454     end;
455   
456     with cboCategory do
457       begin
458         AskLoc := (ALocation = 0);
459         if ((not Patient.Inpatient) and (Self.EvtType = 'A')) then
460           AskLoc := False;
461         if ItemID = '' then SetError(TX_NO_CATEGORY);
462         if (CharAt(ItemID,1) in ['C','S']) and (Contract = '') then SetError(TX_NO_SOURCE);
463         if (CharAt(ItemID, 1) = 'R')       and (Research = '') then SetError(TX_NO_SOURCE);
464         if ((CharAt(ItemID, 1) = 'O') and (LocationType(Encounter.Location) = 'W')) then
465         begin
466           if AskLoc then
467             GetOrderingLocation(LOC_OUTP);
468         end
469         else if ((CharAt(ItemID, 1) = 'I') and (not (LocationType(Encounter.Location) = 'W'))) then
470         begin
471           if AskLoc then
472             GetOrderingLocation(LOC_INP);
473         end;
474       end;
475     if Length(cboTransport.Text) = 0 then SetError(TX_NO_MODE);
476   
477     with cboSubmit do
478       if Enabled and (ItemIEN = 0)then SetError(TX_NO_IMAGING_LOCATION);
479   
480     with calRequestDate do
481     begin
482       if FMDateTime = 0 then
483         SetError(TX_NO_DATE)
484       else if FMDateTime < 0 then
485         SetError(TX_BAD_DATE)
486       else if FMDateTime < FMToday then
487         SetError(TX_PAST_DATE);
488     end;
489   
490   end;
491   
492   procedure TfrmODRad.cboProcedureNeedData(Sender: TObject;
493     const StartFrom: string; Direction, InsertAt: Integer);
494   
495   begin
496     inherited ;
497     cboProcedure.ForDataUse(SubsetOfRadProcs(DisplayGroup, StartFrom, Direction));
498    end;
499   
500   procedure TfrmODRad.cboAvailModMouseClick(Sender: TObject);
501   var
502     x: string;
503     i: integer;
504     Found: boolean;
505   begin
506     if (cboAvailMod.Items.Count < 1) or  //GE 04-30-05 prevent list index out of bounds when empty
507        (cboAvailMod.ItemIndex < 0) then Exit;
508     Found := False;
509     with cboAvailMod do x := Items[ItemIndex];
510     with lstSelectMod do
511       begin
512         if Items.Count > 0 then
513           for i := 0 to Items.Count - 1 do
514             if Items[i] = x then Found := True;
515         if not Found then
516           begin
517             Items.Add(x);
518             SelectByID(Piece(x, U, 1));
519           end;
520       end;
521     if Piece(x, '^', 2) = 'PORTABLE EXAM' then
522       cboTransport.SelectByID('P');
523     ControlChange(Sender);
524   end;
525   
526   procedure TfrmODRad.cmdRemoveClick(Sender: TObject);
527   begin
528     with lstSelectMod do
529        if (SelCount = 0) or (ItemIndex < 0) then exit
530        else
531         begin
532          if Piece(Items[ItemIndex], U, 2) = 'PORTABLE EXAM' then
533            with cboTransport do if OrderForInpatient
534              then SelectByID('W')
535              else SelectByID('A');
536          Items.Delete(ItemIndex);
537          ItemIndex := Items.Count - 1;
538          if ItemIndex > -1 then SelectByID(Piece(Items[ItemIndex], U, 1));
539         end ;
540     ControlChange(Sender);
541   end;
542   
543   procedure TfrmODRad.cboProcedureSelect(Sender: TObject);
544   var
545     tmpResp: TResponse;
546   begin
547     inherited;
548     with cboProcedure do
549      begin
550       if ItemID <> FLastRadID then
551        begin
552          FLastRadID := ItemID;
553          if FPredefineOrder then
554            FPredefineOrder := False;
555        end else Exit;
556       Changing := True;
557       if Sender <> Self then
558         Responses.Clear;       // Sender=Self when called from SetupDialog
559       ClearControl(lstSelectMod);
560       ClearControl(lstLastExam);
561       //ClearControl(memHistory);    {WPB-1298-30758}
562       Changing := False;
563       if CharAt(ItemID, 1) = 'Q' then
564        with Responses do
565          begin
566            QuickOrder := ExtractInteger(ItemID);
567            //SetControl(cboProcedure, 'ORDERABLE', 1);   //v22.9 - RV
568            //SetModifierList;                            //v22.9 - RV
569            FLastRadID := ItemID;
570          end;
571      end;
572      with Responses do if QuickOrder > 0 then
573      begin
574       Changing := True;
575       SetControl(cboProcedure,       'ORDERABLE', 1);
576       SetModifierList;                                   //v22.9 - RV
577       SetControl(lstSelectMod,       'MODIFIER', 1);
578       SetControl(cboUrgency,         'URGENCY', 1);
579       SetControl(cboSubmit,          'IMLOC', 1);
580       SetControl(cboTransport,       'MODE', 1);
581       SetControl(cboCategory,        'CLASS', 1);
582       SetControl(txtReason,           'REASON', 1);
583       SetControl(memHistory,         'COMMENT', 1);
584       SetControl(chkIsolation,       'YN', 1);
585       SetControl(radPregnant,        'PREGNANT', 1);
586       SetControl(calPreOp   ,        'PREOP', 1);
587       tmpResp := FindResponseByName('START',1);
588       if tmpResp <> nil then
589         begin
590           if ContainsAlpha(tmpResp.IValue) then
591             calRequestDate.Text := tmpResp.IValue
592           else
593             calRequestDate.FMDateTime := StrToFMDateTime(tmpResp.IValue);
594         end;
595       Changing := False;
596      end;
597     OrderMessage(ImagingMessage(cboProcedure.ItemIEN)) ;
598     ControlChange(Self);
599   end;
600   
601   procedure TfrmODRad.SetModifierList;
602   var
603     i: integer;
604     tmpResp: TResponse;
605   begin
606     i := 1;
607     tmpResp := Responses.FindResponseByName('MODIFIER',i);
608     while tmpResp <> nil do
609       begin
610         lstSelectMod.Items.Add(tmpResp.IValue + '^' + tmpResp.EValue);
611         if tmpResp.EValue = 'PORTABLE EXAM' then
612           with cboTransport do SelectByID('P'); 
613         Inc(i);
614         tmpResp := Responses.FindResponseByName('MODIFIER',i);
615       end ;
616   end;
617   
618   procedure TfrmODRad.cboCategoryChange(Sender: TObject);
619   var
620     Source: string;
621   begin
622     inherited;
623     if Contract <> '' then Source := Contract
624     else if Research <> '' then Source := Research
625     else Source := '';
626     Contract := '';
627     Research := '';
628     with cboCategory do
629       begin
630         if CharAt(ItemID,1) in ['C','S','R'] then
631           begin
632             SelectSource(Font.Size, CharAt(ItemID,1), Source);
633             if Source = '-1' then
634               InfoBox(TX_NO_AGREE, TX_NO_AGREE_CAP, MB_OK or MB_ICONWARNING)
635             else if CharAt(ItemID,1) in ['C','S'] then
636               Contract := Source
637             else if ItemID='R' then
638               Research := Source;
639           end;
640       end;
641     ControlChange(Self);
642   end;
643   
644   procedure TfrmODRad.FormCreate(Sender: TObject);
645   begin
646     FFormFirstOpened := TRUE;
647     ImageTypeChanged := false;
648     frmFrame.pnlVisit.Enabled := false;
649     AutoSizeDisabled := True;
650     inherited;
651     memHistory.Width := pnlHandR.ClientWidth;
652     memHistory.Height := pnlHandR.ClientHeight - memHistory.Top;
653     FillerID := 'RA';                     // does 'on Display' order check **KCM**
654     StatusText('Loading Dialog Definition');
655     Responses.Clear;
656     DisplayGroup := 0;
657     AllowQuickOrder := True;
658     Responses.Dialog := 'RA OERR EXAM';              // loads formatting info
659     StatusText('Loading Default Values');
660     FastAssign(SubsetOfImagingTypes, cboImType.Items);
661     if Self.EvtID>0 then
662       FEvtDelayDiv := GetEventDiv1(IntToStr(Self.EvtID));
663     PreserveControl(cboImType);
664     PreserveControl(calRequestDate);
665     PreserveControl(cboUrgency);
666     PreserveControl(cboTransport);
667     PreserveControl(cboSubmit);
668     PreserveControl(cboCategory);
669     PreserveControl(calPreOp);
670     PreserveControl(txtReason);
671     PreserveControl(memHistory);      {WPB-1298-30758}
672     if (Patient.Sex <> 'F') then
673     begin
674       //TDP - CQ#19393 change to allow grpPregnant to be tabbed to if screen reader active
675       if ScreenReaderSystemActive then grpPregnant.TabStop := True;
676       radPregnant.Enabled := False;
677       radPregnantNo.Enabled := False;
678       radPregnantUnknown.Enabled := False;
679     end else SetDefaultPregant;
680     FormMonitorBringToFrontEvent(Self, FormFirstOpened);
681   end;
682   
683   {Assigned to cbolmType.OnDropDownClose and cbolmType.OnExit, instead of
684    cbolmType.OnChange, becuase when it is OnChange the delay interfers with
685    Window-Eyes ability to read the drop-down Items.}
686   procedure TfrmODRad.cboImTypeChange(Sender: TObject);
687   begin
688     inherited;
689     ImageTypeChanged := true;
690   end;
691   
692   procedure TfrmODRad.memHistoryExit(Sender: TObject);
693   var
694     AStringList: TStringList;
695   begin
696     inherited;
697     AStringList := TStringList.Create;
698     try
699       FastAssign(memHistory.Lines, AStringList);
700       LimitStringLength(AStringList, 74);
701       FastAssign(AstringList, memHistory.Lines);
702       ControlChange(Self);
703     finally
704       AStringList.Free;
705     end;
706   end;
707   
708   procedure TfrmODRad.FormResize(Sender: TObject);
709   begin
710     inherited;
711     memHistory.Width := pnlHandR.ClientWidth;
712     memHistory.Height := pnlHandR.ClientHeight - memHistory.Top;
713   end;
714   
715   procedure TfrmODRad.cboAvailModKeyDown(Sender: TObject; var Key: Word;
716     Shift: TShiftState);
717   begin
718     inherited;
719     if Key = VK_RETURN then cboAvailModMouseClick(Self);
720   end;
721   
722   procedure TfrmODRad.calPreOpChange(Sender: TObject);
723   begin
724     inherited;
725     FPreOpDate := FloatToStr(calPreOp.FMDateTime);
726     ControlChange(Self);
727   end;
728   
729   procedure TfrmODRad.SetDefaultPregant;
730   begin
731     if (Patient.Sex = 'F') and ((Patient.Age > 55) or (Patient.Age < 12)) then
732     begin
733       radPregnantNo.Checked := True;
734       grpPregnant.TabStop := False;
735     end;
736   end;
737   
738   procedure TfrmODRad.cmdAcceptClick(Sender: TObject);
739   const
740     Txt1 = 'This order can not be saved for the following reason(s):';
741     Txt2 = #13+#13+'A response for the pregnant field must be selected.';
742   var
743     NeedCheckPregnant: boolean;
744   begin
745     if Patient.Sex = 'F' then
746     begin
747       NeedCheckPregnant := True;
748       if radPregnant.Checked then NeedCheckPregnant := False
749       else if radPregnantNo.Checked then NeedCheckPregnant := False
750       else if radPregnantUnknown.Checked then NeedCheckPregnant := False;
751       if NeedCheckPregnant then
752       begin
753         MessageDlg(Txt1+Txt2, mtWarning,[mbOK],0);
754         Exit;
755       end;
756     end;
757     inherited;
758   end;
759   
760   //TDP - CQ#19393 cboSubmit 508 changes. Can change in future to be generic if needed. (See fODLab.pas)
761   procedure TfrmODRad.setup508Label(text: string; lbl: TVA508StaticText; ctrl: TControl);
762   begin
763     if ScreenReaderSystemActive and not ctrl.Enabled then begin
764       lbl.Enabled := True;
765       lbl.Visible := True;
766       lbl.Caption := lblSubmit.Caption + '. Read Only. Value is ' + Text;
767       lbl.Width := lblSubmit.Width + 2;
768     end else
769       lbl.Visible := false;
770   end;
771   
772   procedure TfrmODRad.cboProcedureExit(Sender: TObject);
773   var
774     i: integer;
775     ModList: TStringList;
776   begin
777     inherited;
778     ModList := TStringList.Create;
779     if lstSelectMod.Items.Count > 0 then
780       for i := 0 to lstSelectMod.Count - 1 do
781         ModList.Add(lstSelectMod.Items[i]);
782     cboProcedureSelect(Self);
783     for i := 0 to ModList.Count - 1 do
784     begin
785       lstSelectMod.Items.Add(ModList[i]);
786       lstSelectMod.SelectByID(Piece(ModList[i],U,1));
787     end;
788     with lstSelectMod do
789       for i := 0 to Items.Count - 1 do
790         Responses.Update('MODIFIER',i+1, Piece(Items[i],U,1), Piece(Items[i],U,2));
791     //TDP - Made Order Message next focus if showing and Tab or Entered was pressed
792     if (pnlMessage.Showing) AND ((TabIsPressed()) OR (EnterIsPressed())) then memMessage.SetFocus;
793   end;
794   
795   
796   procedure TfrmODRad.cboImTypeExit(Sender: TObject);
797   begin
798     inherited;
799     ImageTypeChange;
800   end;
801   
802   procedure TfrmODRad.FormClose(Sender: TObject; var Action: TCloseAction);
803   begin
804     inherited;
805     frmFrame.pnlVisit.Enabled := true;
806     FormMonitorBringToFrontEvent(Self, nil);
807   end;
808   
809   procedure TfrmODRad.chkIsolationExit(Sender: TObject);
810   begin
811     inherited;
812     //Fix for CQ: 10025
813     if TabIsPressed() then
814       if NoPregnantSelection() then
815         if radPregnant.CanFocus then
816           radPregnant.SetFocus();
817   end;
818   
819   procedure TfrmODRad.calPreOpExit(Sender: TObject);
820   begin
821     inherited;
822     //Fix for CQ: 10025
823     if ShiftTabIsPressed() then
824       if NoPregnantSelection() then
825         if radPregnant.CanFocus then
826           radPregnant.SetFocus();
827   end;
828   
829   function TfrmODRad.NoPregnantSelection : Boolean;
830   begin
831     result := not ((radPregnant.Checked) or (radPregnantNo.Checked) or (radPregnantUnknown.Checked));
832   end;
833   
834   {TDP - Added to control where focus went now that pnlMessage was being focused
835          out of turn after cboProcedure.}
836   procedure TfrmODRad.pnlMessageExit(Sender: TObject);
837   begin
838     inherited;
839     if TabIsPressed() then cboAvailMod.SetFocus;
840     if ShiftTabIsPressed() then cboProcedure.SetFocus;
841   end;
842   
843   {TDP - Added to control where focus went now that pnlMessage was being focused
844          out of turn after cboProcedure.}
845   procedure TfrmODRad.pnlMessageMouseUp(Sender: TObject; Button: TMouseButton;
846     Shift: TShiftState; X, Y: Integer);
847   begin
848     inherited;
849     cboProcedure.SetFocus;
850   end;
851   
852   procedure TfrmODRad.cboImTypeDropDownClose(Sender: TObject);
853   begin
854     inherited;
855     ImageTypeChange;
856   end;
857   
858   procedure TfrmODRad.ImageTypeChange;
859   begin
860     if not ImageTypeChanged then Exit;
861     ImageTypeChanged := false;
862     if FPredefineOrder then
863       FPredefineOrder := False;
864     if Changing or (cboImtype.ItemIndex = -1) then exit;
865     with cboImType do DisplayGroup := StrToIntDef(Piece(Items[ItemIndex], U, 4), 0) ;
866     if DisplayGroup = 0 then exit;
867     CtrlInits.LoadDefaults(ODForRad(Patient.DFN, FEvtDelayDiv, DisplayGroup));   // ODForRad returns TStrings with defaults
868     FPredefineOrder := False;
869     InitDialog;
870   end;
871   
872   procedure TfrmODRad.FormFirstOpened(Sender: TObject);
873   begin
874     if(FFormFirstOpened) then
875     begin
876       FFormFirstOpened := FALSE;
877       with cboImType do
878         if not FEditCopy and (ItemIEN = 0) and (DroppedDown = False) and (Application.Active) then
879         begin
880           cboImType.DroppedDown := TRUE;
881         end;
882     end;
883   end;
884   
885   end.

Module Calls (2 levels)


fODRad
 ├fODBase
 │ ├fAutoSz
 │ ├uConst
 │ ├rOrders
 │ ├rODBase
 │ ├uCore
 │ ├UBAGlobals
 │ ├UBACore
 │ ├fOCAccept
 │ ├uODBase
 │ ├rCore
 │ ├rMisc
 │ ├fTemplateDialog
 │ ├uEventHooks
 │ ├uTemplates
 │ ├rConsults
 │ ├fOrders
 │ ├uOrders
 │ ├fFrame
 │ ├fODDietLT
 │ └rODDiet
 ├uConst
 ├rODBase...
 ├rODRad
 ├rOrders...
 ├uCore...
 ├rCore...
 ├fODRadApproval
 │ ├fBase508Form
 │ └rODRad
 ├fODRadConShRes
 │ ├fBase508Form...
 │ └rODRad
 ├fLkUpLocation
 │ ├fAutoSz...
 │ ├rCore...
 │ └uConst
 ├fFrame...
 └uFormMonitor

Module Called-By (2 levels)


                      fODRad
                   uOrders┘ 
                   uCore┤   
                 fODBase┤   
                 rODBase┤   
                  fFrame┤   
                 fOrders┤   
             fOrdersSign┤   
                   fMeds┤   
               fARTAllgy┤   
                  fNotes┤   
               fConsults┤   
         fReminderDialog┤   
                 fReview┤   
            fOrdersRenew┤   
               fOrdersCV┤   
                 fODMeds┤   
                 fOMNavA┤   
         fOrderSaveQuick┤   
                  fOMSet┤   
          fOrdersRelease┤   
                 fOMHTML┤   
               fODMedNVA┤   
fODChangeUnreleasedRenew┤   
          fOrdersOnChart┤   
         fODReleaseEvent┤   
               fODActive┘