Module

fODConsult

Path

C:\CPRS\CPRS30\Consults\fODConsult.pas

Last Modified

7/15/2014 3:26:34 PM

Units Used in Interface

Name Comments
fBALocalDiagnoses -
fODBase -
rOrders -
UBAConst -
UBACore -
UBAGlobals -
uConst -

Units Used in Implementation

Name Comments
fConsults -
fFrame -
fPCELex -
fPreReq -
rConsults -
rCore -
rODBase -
rPCE -
uConsults -
uCore -
uODBase -
uTemplates -
uVA508CPRSCompatibility -

Classes

Name Comments
TfrmODCslt -

Procedures

Name Owner Declaration Scope Comments
AdjustMemReasonSize TfrmODCslt procedure AdjustMemReasonSize; Private -
btnDiagnosisClick TfrmODCslt procedure btnDiagnosisClick(Sender: TObject); Public/Published -
btnServiceTreeClick TfrmODCslt procedure btnServiceTreeClick(Sender: TObject); Public/Published -
BuildQuickTree TfrmODCslt procedure BuildQuickTree(QuickList: TStrings; const Parent: string; Node: TTreeNode); Private -
cboServiceExit TfrmODCslt procedure cboServiceExit(Sender: TObject); Public/Published -
cboServiceKeyDown TfrmODCslt procedure cboServiceKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); Public/Published -
cboServiceKeyUp TfrmODCslt procedure cboServiceKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); Public/Published -
cboServiceSelect TfrmODCslt procedure cboServiceSelect(Sender: TObject); Public/Published -
cmdAcceptClick TfrmODCslt procedure cmdAcceptClick(Sender: TObject); Public/Published -
cmdLexSearchClick TfrmODCslt procedure cmdLexSearchClick(Sender: TObject); Public/Published -
cmdQuitClick TfrmODCslt procedure cmdQuitClick(Sender: TObject); Public/Published -
ControlChange TfrmODCslt procedure ControlChange(Sender: TObject); Public/Published -
DisableReason - procedure DisableReason; Local -
DoSetFontSize TfrmODCslt procedure DoSetFontSize(FontSize: integer); Private -
EnableReason - procedure EnableReason; Local -
FormClose TfrmODCslt procedure FormClose(Sender: TObject; var Action: TCloseAction); Public/Published -
FormCreate TfrmODCslt procedure FormCreate(Sender: TObject); Public/Published TfrmODCslt Methods ***********
FormDestroy TfrmODCslt procedure FormDestroy(Sender: TObject); Public/Published -
FormResize TfrmODCslt procedure FormResize(Sender: TObject); Public/Published -
GetProvDxandValidateCode TfrmODCslt procedure GetProvDxandValidateCode(AResponses: TResponses); Private -
InitDialog TfrmODCslt procedure InitDialog; override; Protected -
InitializeGlobalLists - procedure InitializeGlobalLists; Global -
memReasonExit TfrmODCslt procedure memReasonExit(Sender: TObject); Public/Published -
memReasonKeyDown TfrmODCslt procedure memReasonKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); Public/Published -
memReasonKeyPress TfrmODCslt procedure memReasonKeyPress(Sender: TObject; var Key: Char); Public/Published -
memReasonKeyUp TfrmODCslt procedure memReasonKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); Public/Published -
mnuPopProvDxDeleteClick TfrmODCslt procedure mnuPopProvDxDeleteClick(Sender: TObject); Public/Published -
pnlServiceTreeButtonEnter TfrmODCslt procedure pnlServiceTreeButtonEnter(Sender: TObject); Public/Published -
pnlServiceTreeButtonExit TfrmODCslt procedure pnlServiceTreeButtonExit(Sender: TObject); Public/Published -
popReasonCopyClick TfrmODCslt procedure popReasonCopyClick(Sender: TObject); Public/Published -
popReasonCutClick TfrmODCslt procedure popReasonCutClick(Sender: TObject); Public/Published -
popReasonPasteClick TfrmODCslt procedure popReasonPasteClick(Sender: TObject); Public/Published -
popReasonPopup TfrmODCslt procedure popReasonPopup(Sender: TObject); Public/Published -
popReasonReformatClick TfrmODCslt procedure popReasonReformatClick(Sender: TObject); Public/Published -
radInpatientClick TfrmODCslt procedure radInpatientClick(Sender: TObject); Public/Published -
radOutpatientClick TfrmODCslt procedure radOutpatientClick(Sender: TObject); Public/Published -
ReadServerVariables TfrmODCslt procedure ReadServerVariables; Private -
SaveConsultDxForNurse TfrmODCslt procedure SaveConsultDxForNurse(pDiagnosis: string); Private Save the dx entered by nurese if Master BA switch is ON
SetError - procedure SetError(const x: string); Local -
SetFontSize TfrmODCslt procedure SetFontSize(FontSize: integer); override; Public -
SetProvDiagPromptingMode TfrmODCslt procedure SetProvDiagPromptingMode; Private -
setup508Label TfrmODCslt procedure setup508Label(lbl: TVA508StaticText; ctrl: TORComboBox); Private -
SetUpCombatVet TfrmODCslt procedure SetUpCombatVet; Private -
SetUpCopyConsultDiagnoses TfrmODCslt procedure SetUpCopyConsultDiagnoses(pOrderID:string); Private -
SetupDialog TfrmODCslt procedure SetupDialog(OrderAction: Integer; const ID: string); override; Public -
SetUpEarliestDate TfrmODCslt procedure SetUpEarliestDate; Private
Wat v28
wat v28
SetUpQuickOrderDX TfrmODCslt procedure SetUpQuickOrderDX; Private
This procedure is called if the user selects a quick code from the list
 and accepts the order without entering or selection the diagnoses button.
SetupReasonForRequest TfrmODCslt procedure SetupReasonForRequest(OrderAction: integer); Private -
treServiceChange TfrmODCslt procedure treServiceChange(Sender: TObject; Node: TTreeNode); Public/Published -
treServiceCollapsing TfrmODCslt procedure treServiceCollapsing(Sender: TObject; Node: TTreeNode; var AllowCollapse: Boolean); Public/Published -
treServiceEnter TfrmODCslt procedure treServiceEnter(Sender: TObject); Public/Published -
treServiceExit TfrmODCslt procedure treServiceExit(Sender: TObject); Public/Published -
treServiceKeyDown TfrmODCslt procedure treServiceKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); Public/Published -
treServiceKeyUp TfrmODCslt procedure treServiceKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); Public/Published -
treServiceMouseDown TfrmODCslt procedure treServiceMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); Public/Published -
txtAttnNeedData TfrmODCslt procedure txtAttnNeedData(Sender: TObject; const StartFrom: String; Direction, InsertAt: Integer); Public/Published -
txtProvDiagChange TfrmODCslt procedure txtProvDiagChange(Sender: TObject); Public/Published -
Validate TfrmODCslt procedure Validate(var AnErrMsg: string); override; Protected -

Functions

Name Owner Declaration Scope Comments
CanFreeConsultDialog - function CanFreeConsultDialog(dialog : TfrmODBase) : boolean; Interfaced Static Unit Methods ***************
DefaultReasonForRequest TfrmODCslt function DefaultReasonForRequest(Service: string; Resolve: Boolean): TStrings; Protected -
FreeGlobalLists - function FreeGlobalLists : Boolean; Global -
GetItemIndex TfrmODCslt function GetItemIndex(Service: String; Index: integer): integer; Private
TP - HDS00015782:
This function returns ItemIndexOf value for Service Consult when a Quick Order
has the exact same name
NotinIndex TfrmODCslt function NotinIndex(AList: TStringList; i: integer): boolean; Private
TP - HDS00015782:
This function determines if a Consult Service will be added to the cboService
component.  If name does not exist or if name does not exist below the Quick
Order listing, then it is added.
ShowPrerequisites TfrmODCslt function ShowPrerequisites: boolean; Private -

Global Variables

Name Type Declaration Comments
AreGlobalsFree Boolean AreGlobalsFree: boolean; -
BADxUpdated Boolean BADxUpdated: boolean; -
consultQuickOrder Boolean consultQuickOrder: boolean; -
Defaults TStrings SvcList, QuickList, Defaults: TStrings ; -
displayDXCode UnicodeString displayDXCode: string; -
GMRCREAF UnicodeString GMRCREAF: string; -
LastNode Integer LastNode: integer ; -
ProvDx ProvDx: TProvisionalDiagnosis; -
quickCode UnicodeString quickCode: string; -
QuickList TStrings SvcList, QuickList, Defaults: TStrings ; -
SvcList TStrings SvcList, QuickList, Defaults: TStrings ; -

Constants

Name Declaration Scope Comments
TC_INACTIVE_CODE 'Inactive ICD Code' Global -
TX_BAD_DATES 'Latest appropriate date must be equal to or later than earliest date.' Global -
TX_CLOSE_SVC_HRCHY 'Close services/specialties hierarchy tree view' Global -
TX_GROUPER 'This is not an orderable service. Please select a subspecialty' Global -
TX_INACTIVE_CODE_OPTIONAL 'If another code is not selected, no code will be saved.' Global -
TX_INACTIVE_CODE_REQD 'Another code must be selected before the order can be saved.' Global -
TX_INACTIVE_CODE1 'The provisional diagnosis code is not active as of today''s date.' + #13#10 Global -
TX_NO_DIAG 'A provisional diagnosis must be entered for consults to this service.' Global -
TX_NO_PLACE 'A place of consultation must be specified' Global -
TX_NO_REASON 'A reason for this consult must be entered.' Global -
TX_NO_SVC 'A service must be specified.' Global -
TX_NO_URGENCY 'An urgency must be specified.' Global -
TX_NOTTHISSVC_TEXT 'Consults cannot be ordered from this service' Global -
TX_PAST_DATE 'Earliest appropriate date must be today or later.' Global -
TX_SELECT_DIAG 'You must select a diagnosis for consults to this service.' Global -
TX_SVC_ERROR 'This service has not been defined in your Orderable Items file.' + Global -
TX_SVC_HRCHY 'services/specialties hierarchy' Global -
TX_VIEW_SVC_HRCHY 'View services/specialties hierarchically' Global -


Module Source

1     unit fODConsult;
2     
3     {$O-}
4     
5     interface
6     
7     uses
8       Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
9       fODBase, StdCtrls, ORCtrls, ExtCtrls, ComCtrls, ORfn, uConst, Buttons,
10      Menus, UBAGlobals, rOrders, fBALocalDiagnoses, UBAConst, UBACore, ORNet,
11      ORDtTm, VA508AccessibilityManager ;
12    
13    type
14      TfrmODCslt = class(TfrmODBase)
15        pnlMain: TPanel;
16        lblService: TLabel;
17        lblProvDiag: TLabel;
18        lblUrgency: TLabel;
19        lblPlace: TLabel;
20        lblAttn: TLabel;
21        lblLatest: TStaticText;
22        lblEarliest: TStaticText;
23        pnlReason: TPanel;
24        lblReason: TLabel;
25        memReason: TRichEdit;
26        cboService: TORComboBox;
27        cboUrgency: TORComboBox;
28        cboPlace: TORComboBox;
29        txtProvDiag: TCaptionEdit;
30        txtAttn: TORComboBox;
31        treService: TORTreeView;
32        cboCategory: TORComboBox;
33        pnlServiceTreeButton: TKeyClickPanel;
34        btnServiceTree: TSpeedButton;
35        gbInptOpt: TGroupBox;
36        radInpatient: TRadioButton;
37        radOutpatient: TRadioButton;
38        btnDiagnosis: TButton;
39        cmdLexSearch: TButton;
40        calEarliest: TORDateBox;
41        calLatest: TORDateBox;
42        mnuPopProvDx: TPopupMenu;
43        mnuPopProvDxDelete: TMenuItem;
44        popReason: TPopupMenu;
45        popReasonCut: TMenuItem;
46        popReasonCopy: TMenuItem;
47        popReasonPaste: TMenuItem;
48        popReasonPaste2: TMenuItem;
49        popReasonReformat: TMenuItem;
50        pnlCombatVet: TPanel;
51        txtCombatVet: TVA508StaticText;
52        servicelbl508: TVA508StaticText;
53        procedure FormCreate(Sender: TObject);
54        procedure txtAttnNeedData(Sender: TObject; const StartFrom: String;
55          Direction, InsertAt: Integer);
56        procedure radInpatientClick(Sender: TObject);
57        procedure radOutpatientClick(Sender: TObject);
58        procedure treServiceChange(Sender: TObject; Node: TTreeNode);
59        procedure ControlChange(Sender: TObject);
60        procedure treServiceExit(Sender: TObject);
61        procedure cmdAcceptClick(Sender: TObject);
62        procedure memReasonExit(Sender: TObject);
63        procedure cboServiceSelect(Sender: TObject);
64        procedure FormDestroy(Sender: TObject);
65        procedure btnServiceTreeClick(Sender: TObject);
66        procedure treServiceCollapsing(Sender: TObject; Node: TTreeNode;
67          var AllowCollapse: Boolean);
68        procedure treServiceMouseDown(Sender: TObject; Button: TMouseButton;
69          Shift: TShiftState; X, Y: Integer);
70        procedure cmdLexSearchClick(Sender: TObject);
71        procedure mnuPopProvDxDeleteClick(Sender: TObject);
72        procedure txtProvDiagChange(Sender: TObject);
73        procedure cboServiceExit(Sender: TObject);
74        procedure popReasonCutClick(Sender: TObject);
75        procedure popReasonCopyClick(Sender: TObject);
76        procedure popReasonPasteClick(Sender: TObject);
77        procedure popReasonPopup(Sender: TObject);
78        procedure popReasonReformatClick(Sender: TObject);
79        procedure pnlServiceTreeButtonEnter(Sender: TObject);
80        procedure pnlServiceTreeButtonExit(Sender: TObject);
81        procedure treServiceKeyDown(Sender: TObject; var Key: Word;
82          Shift: TShiftState);
83        procedure treServiceKeyUp(Sender: TObject; var Key: Word;
84          Shift: TShiftState);
85        procedure memReasonKeyUp(Sender: TObject; var Key: Word;
86          Shift: TShiftState);
87        procedure memReasonKeyDown(Sender: TObject; var Key: Word;
88          Shift: TShiftState);
89        procedure memReasonKeyPress(Sender: TObject; var Key: Char);
90        procedure cboServiceKeyDown(Sender: TObject; var Key: Word;
91          Shift: TShiftState);
92        procedure cboServiceKeyUp(Sender: TObject; var Key: Word;
93          Shift: TShiftState);
94        procedure btnDiagnosisClick(Sender: TObject);
95        procedure cmdQuitClick(Sender: TObject);
96        procedure FormClose(Sender: TObject; var Action: TCloseAction);
97        procedure FormResize(Sender: TObject);
98        procedure treServiceEnter(Sender: TObject);
99    
100     private
101       FcboServiceKeyDownStopClick : boolean;
102       FKeyBoarding: boolean;
103       FLastServiceID: string;
104       FEditCtrl: TCustomEdit;
105       FNavigatingTab: boolean;
106       LLS_LINE_INDEX: integer;
107       procedure BuildQuickTree(QuickList: TStrings; const Parent: string; Node: TTreeNode);
108       procedure ReadServerVariables;
109       procedure SetProvDiagPromptingMode;
110       procedure SetupReasonForRequest(OrderAction: integer);
111       procedure GetProvDxandValidateCode(AResponses: TResponses);
112       function ShowPrerequisites: boolean;
113       procedure DoSetFontSize(FontSize: integer);
114       procedure SetUpQuickOrderDX;
115       procedure SaveConsultDxForNurse(pDiagnosis: string);  // save the dx entered by nurese if Master BA switch is ON
116       procedure SetUpCopyConsultDiagnoses(pOrderID:string);
117       procedure AdjustMemReasonSize;
118       function NotinIndex(AList: TStringList; i: integer): boolean;
119       function GetItemIndex(Service: String; Index: integer): integer;
120       procedure SetUpCombatVet;
121       procedure SetUpEarliestDate; //wat v28
122       procedure setup508Label(lbl: TVA508StaticText; ctrl: TORComboBox);
123     protected
124       procedure InitDialog; override;
125       procedure Validate(var AnErrMsg: string); override;
126       function DefaultReasonForRequest(Service: string; Resolve: Boolean): TStrings;
127       
128     public
129       procedure SetupDialog(OrderAction: Integer; const ID: string); override;
130       procedure SetFontSize(FontSize: integer); override;
131     end;
132   
133   var
134     LastNode: integer ;
135     displayDXCode: string;
136     consultQuickOrder: boolean;
137   
138   
139   function CanFreeConsultDialog(dialog : TfrmODBase) : boolean;
140   
141   implementation
142   
143   {$R *.DFM}
144   
145   uses
146       rODBase, rConsults, uCore, uConsults, rCore, fConsults, fPCELex, rPCE, fPreReq,
147       ORClasses, clipbrd, uTemplates, fFrame, uODBase, uVA508CPRSCompatibility,
148       VA508AccessibilityRouter;
149   
150   var
151     SvcList, QuickList, Defaults: TStrings ;
152     ProvDx:  TProvisionalDiagnosis;
153     GMRCREAF: string;
154     BADxUpdated: boolean;
155     quickCode: string;
156     AreGlobalsFree: boolean;
157   
158   
159   
160   const
161     TX_NOTTHISSVC_TEXT = 'Consults cannot be ordered from this service' ;
162     TX_NO_SVC          = 'A service must be specified.'    ;
163     TX_NO_REASON       = 'A reason for this consult must be entered.'  ;
164     TX_SVC_ERROR       = 'This service has not been defined in your Orderable Items file.' +
165                          #13#10'Contact IRM for assistance.' ;
166     TX_NO_URGENCY      = 'An urgency must be specified.';
167     TX_NO_PLACE        = 'A place of consultation must be specified';
168     TX_NO_DIAG         = 'A provisional diagnosis must be entered for consults to this service.';
169     TX_SELECT_DIAG     = 'You must select a diagnosis for consults to this service.';
170     TX_GROUPER         = 'This is not an orderable service. Please select a subspecialty';
171     TC_INACTIVE_CODE   = 'Inactive ICD Code';
172     TX_INACTIVE_CODE1  = 'The provisional diagnosis code is not active as of today''s date.' + #13#10;
173     TX_INACTIVE_CODE_REQD     = 'Another code must be selected before the order can be saved.';
174     TX_INACTIVE_CODE_OPTIONAL = 'If another code is not selected, no code will be saved.';
175     TX_PAST_DATE       = 'Earliest appropriate date must be today or later.';
176     TX_BAD_DATES       = 'Latest appropriate date must be equal to or later than earliest date.';
177   
178     TX_SVC_HRCHY = 'services/specialties hierarchy';
179     TX_VIEW_SVC_HRCHY = 'View services/specialties hierarchically';
180     TX_CLOSE_SVC_HRCHY = 'Close services/specialties hierarchy tree view';
181   
182   
183   {************** Static Unit Methods ***************}
184   
185   function CanFreeConsultDialog(dialog : TfrmODBase) : boolean;
186   begin
187     Result := true;
188     if (dialog is TfrmODCslt) then
189       Result := AreGlobalsFree;
190   end;
191   
192   procedure InitializeGlobalLists;
193   begin
194     Defaults := TStringList.Create;
195     SvcList := TStringList.Create;
196     QuickList := TStringList.Create;
197     AreGlobalsFree := false;
198   end;
199   
200   function FreeGlobalLists : Boolean;
201   begin
202     Result := false;
203     if AreGlobalsFree then
204       Exit;
205     Defaults.Free;
206     SvcList.Free;
207     QuickList.Free;
208     AreGlobalsFree := true;
209     Result := true;
210   end;
211   
212   {*************** TfrmODCslt Methods ***********}
213   
214   procedure TfrmODCslt.FormCreate(Sender: TObject);
215   begin
216     frmFrame.pnlVisit.Enabled := false;
217     AutoSizeDisabled := True;
218     inherited;
219     if BILLING_AWARE then
220     begin
221        btnDiagnosis.Visible := True;
222        cmdLexSearch.Visible := False;
223     end
224     else
225     begin
226        btnDiagnosis.Visible := False;
227        cmdLexSearch.Visible := True;
228     end;
229     InitializeGlobalLists;
230     AllowQuickOrder := True;
231     LastNode := 0;
232     FLastServiceID := '' ;
233     GMRCREAF := '';
234     FillChar(ProvDx, SizeOf(ProvDx), 0);
235     FillerID := 'GMRC';                     // does 'on Display' order check **KCM**
236     StatusText('Loading Dialog Definition');
237     Responses.Dialog := 'GMRCOR CONSULT';   // loads formatting info
238     StatusText('Loading Default Values');
239     FastAssign(ODForConsults, Defaults);  // ODForConsults returns TStrings with defaults
240     CtrlInits.LoadDefaults(Defaults);
241     txtAttn.InitLongList('') ;
242     PreserveControl(txtAttn);
243     PreserveControl(calEarliest);
244       if (patient.CombatVet.IsEligible = True) then
245      begin
246        SetUpCombatVet;
247      end
248      else
249       begin
250         txtCombatVet.Enabled := False;
251         pnlCombatVet.SendToBack;
252       end;
253     InitDialog;
254     //Calling virtual SetFontSize in constructor is a bad idea!
255     DoSetFontSize( MainFontSize);
256     FcboServiceKeyDownStopClick := false;
257     consultQuickOrder := false;
258   end;
259   
260   procedure TfrmODCslt.InitDialog;
261   begin
262     inherited;
263     Changing := True;
264     FLastServiceID := '';
265     QuickList.Clear;
266     with CtrlInits do
267     begin
268      ExtractItems(QuickList, Defaults, 'ShortList');
269      if OrderForInpatient then                            //INPATIENT CONSULT
270       begin
271         radInpatient.Checked := True;
272         cboCategory.Items.Clear;
273         cboCategory.Items.Add('I^Inpatient');
274         cboCategory.SelectById('I');
275         SetControl(cboPlace, 'Inpt Place');
276         SetControl(cboUrgency, 'Inpt Cslt Urgencies');        //S.GMRCT
277         SetControl(calEarliest, 'EarliestDate');  //wat v29
278       end
279      else
280       begin
281         radOutpatient.Checked := True;                   //OUTPATIENT CONSULT
282         cboCategory.Items.Clear;
283         cboCategory.Items.Add('O^Outpatient');
284         cboCategory.SelectById('O');
285         SetControl(cboPlace, 'Outpt Place');
286         SetControl(cboUrgency, 'Outpt Urgencies');      //S.GMRCO
287         SetControl(calEarliest, 'EarliestDate');  //wat v29
288       end ;
289     end ;
290     StatusText('Initializing Long List');
291     memOrder.Clear ;
292     memReason.Clear;
293     cboService.Enabled := True;
294     setup508Label(servicelbl508, cboService);
295     cboService.Font.Color := clWindowText;
296     cboService.Height := 25 + (11 * cboService.ItemHeight);
297     btnServiceTree.Enabled := True;
298     pnlServiceTreeButton.Enabled := True;
299     SetProvDiagPromptingMode;
300     ActiveControl := cboService;
301     Changing := False;
302     StatusText('');
303   end;
304   
305   procedure TfrmODCslt.SetupDialog(OrderAction: Integer; const ID: string);
306   const
307     TX_INACTIVE_SVC = 'This consult service is currently inactive and not receiving requests.' + CRLF +
308                       'Please contact your Clinical Coordinator/IRM staff to fix this order.';
309     TX_INACTIVE_SVC_CAP = 'Inactive Service';
310     TX_NO_SVC = 'The order or quick order you have selected does not specify a consult service.' + CRLF +
311                 'Please contact your Clinical Coordinator/IRM staff to fix this order.';
312     TC_NO_SVC = 'No service specified';
313   var
314    i:integer;
315    AList: TStringList;
316    tmpResp: TResponse;
317    SvcIEN: string;
318   begin
319     inherited;
320     LLS_LINE_INDEX := -1;
321     ReadServerVariables;
322     AList := TStringList.Create;
323     try
324       if OrderAction in [ORDER_COPY, ORDER_EDIT, ORDER_QUICK] then with Responses do
325       begin
326         Changing := True;
327         tmpResp := TResponse(FindResponseByName('ORDERABLE',1));
328         if tmpResp <> nil then
329           SvcIEN := GetServiceIEN(tmpResp.IValue)
330         else
331           begin
332             InfoBox(TX_NO_SVC, TC_NO_SVC, MB_ICONERROR or MB_OK);
333             AbortOrder := True;
334             Close;
335             Exit;
336           end;
337         if SvcIEN = '-1' then
338           begin
339             InfoBox(TX_INACTIVE_SVC, TX_INACTIVE_SVC_CAP, MB_OK);
340             AbortOrder := True;
341             Close;
342             Exit;
343           end;
344   
345         cboService.Items.Add(SvcIEN + U + tmpResp.EValue + '^^^^' + tmpResp.IValue);
346         cboService.SelectByID(SvcIEN);
347         tmpResp := TResponse(FindResponseByName('CLASS',1));
348         cboCategory.SelectByID(tmpResp.IValue);
349         if tmpResp.IValue = 'I' then
350           radInpatient.Checked := True
351         else
352           radOutpatient.Checked := True ;
353         SetControl(cboUrgency,    'URGENCY',   1);
354         SetControl(cboPlace,      'PLACE',     1);
355         SetControl(txtAttn,       'PROVIDER',  1);
356         SetControl(calEarliest,   'EARLIEST',  1);
357         SetUpEarliestDate;   //wat v28
358         cboService.Enabled := False;
359         setup508Label(servicelbl508, cboService);
360         cboService.Font.Color := clGrayText;
361         btnServiceTree.Enabled := False;
362         pnlServiceTreeButton.Enabled := False;
363         if (OrderAction in [ORDER_COPY, ORDER_QUICK]) and (not ShowPrerequisites) then
364           begin
365             Close;
366             Exit;
367           end;
368         SetProvDiagPromptingMode;
369         GetProvDxandValidateCode(Responses);
370         SetTemplateDialogCanceled(FALSE);
371         SetControl(memReason,     'COMMENT',   1);
372         if WasTemplateDialogCanceled then
373         begin
374           AbortOrder := True;
375   		SetTemplateDialogCanceled(FALSE);
376           Close;
377           Exit;
378         end;
379         SetTemplateDialogCanceled(FALSE);
380         SetupReasonForRequest(OrderAction);
381         if WasTemplateDialogCanceled then
382         begin
383           AbortOrder := True;
384   		SetTemplateDialogCanceled(FALSE);
385           Close;
386           Exit;
387         end;
388         Changing := False;
389         ControlChange(Self);
390       end
391       else
392       begin
393         if QuickList.Count > 0 then BuildQuickTree(QuickList, '0', nil) ;
394         FastAssign(LoadServiceListWithSynonyms(CN_SVC_LIST_ORD), SvcList);           {RV}
395         FastAssign(SvcList, AList);
396         SortByPiece(AList, U, 2);
397         BuildServiceTree(treService, SvcList, '0', nil) ;
398         with treService do
399           begin
400             for i:=0 to Items.Count-1 do
401               if Items[i].Level > 0 then Items[i].Expanded := False else Items[i].Expanded := True;
402             TopItem  := Items[LastNode] ;
403             Changing := True;
404             Selected := Items[LastNode] ;
405             Changing := False;
406             SendMessage(Handle, WM_HSCROLL, SB_THUMBTRACK, 0);
407           end ;
408         if QuickList.Count > 0 then with cboService do
409           begin
410             FastAssign(QuickList, cboService.Items);
411             Items.Add(LLS_LINE);
412             LLS_LINE_INDEX := Items.IndexOf(Trim(Piece(LLS_LINE, U, 2))); {TP - HDS00015782: Used to determine if QO}
413             Items.Add(LLS_SPACE);
414           end;
415         Changing := True;
416         for i := 0 to AList.Count - 1 do
417           //if (cboService.Items.IndexOf(Trim(Piece(AList.Strings[i], U, 2))) = -1) and   {RV}
418           if (NotinIndex(AList,i)) and   {TP - HDS00015782: Check if service is already in index (not including QO)}
419           //if (cboService.SelectByID(Piece(AList.Strings[i], U, 1)) = -1) and
420              (Piece(AList.Strings[i], U, 5) <> '1') then
421             cboService.Items.Add(AList.Strings[i]);
422         cboService.ItemIndex := 0;
423         Changing := False;
424         if treService.Selected <> nil then
425           begin
426             if (TORTreeNode(treService.Selected).StringData <> '') and
427                (Piece(TORTreeNode(treService.Selected).StringData, U, 5) <> '1') then
428               cboService.ItemIndex := cboService.Items.IndexOf(Trim(Piece(TORTreeNode(treService.Selected).StringData, U, 2)))
429               //cboService.SelectByID(Piece(string(treService.Selected.Data), U, 1))
430             else
431               cboService.ItemIndex := -1;
432           end
433         else
434           cboService.ItemIndex := -1;
435         if cboService.ItemIEN > 0 then
436           begin
437             if not ShowPrerequisites then
438               begin
439                 Close;
440                 Exit;
441               end;
442             QuickCopy(DefaultReasonForRequest(cboService.ItemID, True), memReason);
443           end;
444         PreserveControl(treService);
445         PreserveControl(cboService);
446       end;
447     finally
448       AList.Free;
449     end;
450   end;
451   
452   procedure TfrmODCslt.Validate(var AnErrMsg: string);
453   
454     procedure SetError(const x: string);
455     begin
456       if Length(AnErrMsg) > 0 then AnErrMsg := AnErrMsg + CRLF;
457       AnErrMsg := AnErrMsg + x;
458     end;
459   
460   begin
461     inherited;
462     if (not ContainsVisibleChar(memReason.Text)) then SetError(TX_NO_REASON);
463     if cboUrgency.ItemIEN = 0 then SetError(TX_NO_URGENCY);
464     if cboPlace.ItemID = '' then SetError(TX_NO_PLACE);
465     if cboService.ItemIEN = 0 then
466       SetError(TX_NO_SVC)
467     else
468       begin
469         if Piece(cboService.Items[cboService.ItemIndex],U,5) = '1' then SetError(TX_NOTTHISSVC_TEXT);
470         if (Piece(cboService.Items[cboService.ItemIndex],U,5) <> '1')
471            and (Piece(cboService.Items[cboService.ItemIndex],U,6) = '')
472                                                 then SetError(TX_SVC_ERROR) ;
473       end;
474     if (ProvDx.Reqd = 'R') and (not ContainsVisibleChar(txtProvDiag.Text)) then
475       begin
476         if ProvDx.PromptMode = 'F' then
477           SetError(TX_NO_DIAG)
478         else
479           SetError(TX_SELECT_DIAG);
480       end;
481     if (lblEarliest.Enabled) and (calEarliest.FMDateTime < FMToday) then SetError(TX_PAST_DATE);
482   end;
483   
484   procedure TfrmODCslt.txtAttnNeedData(Sender: TObject;
485     const StartFrom: string; Direction, InsertAt: Integer);
486   begin
487     inherited;
488     txtAttn.ForDataUse(SubSetOfPersons(StartFrom, Direction));
489   end;
490   
491   procedure TfrmODCslt.radInpatientClick(Sender: TObject);
492   begin
493     inherited;
494     with CtrlInits do
495     begin
496       SetControl(cboPlace, 'Inpt Place');
497       SetControl(cboUrgency, 'Inpt Cslt Urgencies');
498       cboCategory.Items.Clear;
499       cboCategory.Items.Add('I^Inpatient') ;
500       cboCategory.SelectById('I');
501     end ;
502     ControlChange(Self);
503   end;
504   
505   procedure TfrmODCslt.radOutpatientClick(Sender: TObject);
506   begin
507     inherited;
508     with CtrlInits do
509     begin
510       SetControl(cboPlace, 'Outpt Place');
511       SetControl(cboUrgency, 'Outpt Urgencies');
512       cboCategory.Items.Clear;
513       cboCategory.Items.Add('O^Outpatient');
514       cboCategory.SelectById('O');
515     end ;
516     ControlChange(Self);
517   end;
518   
519   procedure TfrmODCslt.BuildQuickTree(QuickList: TStrings; const Parent: string; Node: TTreeNode);
520   var
521     i: Integer;
522     QuickInfo, Name: string ;
523     ANode: TTreeNode;
524   begin
525     with QuickList do
526       begin
527         Node := treService.Items.AddChildObject(Node, 'Quick Orders', nil);
528         for i := 0 to Count - 1 do
529          begin
530           Name        := Piece(Strings[i], U, 2);
531           QuickInfo   := Strings[i];
532           ANode := treService.Items.AddChildObject(Node, Name, Pointer(QuickInfo));
533           TORTreeNode(ANode).StringData := QuickInfo;
534          end;
535       end;
536   end;
537   
538   procedure TfrmODCslt.treServiceChange(Sender: TObject; Node: TTreeNode);
539   var
540     i: integer;
541     tmpSvc: string;
542   begin
543     inherited;
544     pnlMessage.Visible := False;
545     if Changing or (treService.Selected = nil)
546        or FKeyBoarding or FcboServiceKeyDownStopClick then exit;
547     Changing := True;
548     with cboService do
549      begin
550       if treService.Selected <> nil then
551         begin
552           if (TORTreeNode(treService.Selected).StringData <> '') and
553              (Piece(TORTreeNode(treService.Selected).StringData, U, 5) <> '1') then
554             cboService.ItemIndex := cboService.Items.IndexOf(Trim(Piece(TORTreeNode(treService.Selected).StringData, U, 2)))
555             //cboService.SelectByID(Piece(string(treService.Selected.Data), U, 1))
556           else
557             begin
558               pnlMessage.TabOrder := treService.TabOrder + 1;
559               OrderMessage(TX_GROUPER);
560               cboService.ItemIndex := -1;
561               Changing := False;
562               Exit;
563             end;
564         end
565       else
566         ItemIndex := -1;
567   (*    if (treService.Selected.Data <> nil) then
568         SelectByID(Piece(string(treService.Selected.Data), U, 1))
569       else
570         ItemIndex := -1;*)
571       Changing := False;
572       if ItemIndex < 0 then exit;
573       if Piece(Items[ItemIndex],U,5) = '1' then
574         begin
575           Responses.Update('ORDERABLE', 1, '', '');
576           memOrder.Clear;
577           cboService.ItemIndex := -1;
578           FLastServiceID := '';
579           Changing := True;
580           treService.Selected := nil;
581           Changing := False;
582           pnlMessage.TabOrder := treService.TabOrder + 1;
583           OrderMessage(TX_GROUPER);
584           Exit;
585         end;
586       treService.Visible := False;
587       memReason.Clear;
588       if ItemID <> FLastServiceID then FLastServiceID := ItemID else Exit;
589       Changing := True;
590       if Sender <> Self then
591         Responses.Clear;       // Sender=Self when called from SetupDialog
592       Changing := False;
593       if CharAt(ItemID, 1) = 'Q' then
594         begin
595           Changing := True;
596           consultQuickOrder := True;   
597           Responses.QuickOrder := ExtractInteger(ItemID);
598           tmpSvc := TResponse(Responses.FindResponseByName('ORDERABLE',1)).IValue;
599           with treService do for i := 0 to Items.Count-1 do
600             begin
601               if Piece(TORTreeNode(Items[i]).StringData, U, 6) = tmpSvc then
602                 begin
603                   Selected := Items[i];
604                   break;
605                 end;
606             end;
607           if treService.Selected <> nil then
608             begin
609               if (TORTreeNode(treService.Selected).StringData <> '') and
610                  (Piece(TORTreeNode(treService.Selected).StringData, U, 5) <> '1') then
611                    cboService.ItemIndex := cboService.Items.IndexOf(Trim(Piece(TORTreeNode(treService.Selected).StringData, U, 2)))
612                 //cboService.SelectByID(Piece(string(treService.Selected.Data), U, 1))
613               else
614                 cboService.ItemIndex := -1;
615             end
616           else
617             cboService.ItemIndex := -1;
618           FLastServiceID := ItemID;
619           cboService.Enabled := False;
620           setup508Label(servicelbl508, cboService);
621           cboService.Font.Color := clGrayText;
622           btnServiceTree.Enabled := False;
623           pnlServiceTreeButton.Enabled := False;
624           Changing := False;
625         end;
626      end;
627     with Responses do if QuickOrder > 0 then
628       begin
629         tmpSvc := TResponse(Responses.FindResponseByName('ORDERABLE',1)).IValue;
630         with treService do for i := 0 to Items.Count-1 do
631           begin
632             if Piece(TORTreeNode(Items[i]).StringData, U, 6) = tmpSvc then
633               begin
634                 Selected := Items[i];
635                 break;
636               end;
637           end;
638         if treService.Selected <> nil then
639           begin
640             if (TORTreeNode(treService.Selected).StringData <> '') and
641                (Piece(TORTreeNode(treService.Selected).StringData, U, 5) <> '1') then
642                   cboService.ItemIndex := cboService.Items.IndexOf(Trim(Piece(TORTreeNode(treService.Selected).StringData, U, 2)))
643               //cboService.SelectByID(Piece(string(treService.Selected.Data), U, 1))
644             else
645               cboService.ItemIndex := -1;
646           end
647         else
648           cboService.ItemIndex := -1;
649         Changing := True;
650         if not ShowPrerequisites then
651           begin
652             Close;
653             Exit;
654           end;
655         SetControl(cboCategory,   'CLASS',      1);
656         if cboCategory.ItemID = 'I' then radInpatient.Checked := True
657         else radOutpatient.Checked := True ;
658         SetControl(cboUrgency,    'URGENCY',     1);
659         SetControl(cboPlace,      'PLACE',     1);
660         SetControl(txtAttn,       'PROVIDER',  1);
661         SetControl(calEarliest,   'EARLIEST',  1);
662         SetTemplateDialogCanceled(FALSE);
663         SetControl(memReason,     'COMMENT',   1);
664         if WasTemplateDialogCanceled and OrderContainsObjects then
665         begin
666           AbortOrder := TRUE;
667   		SetTemplateDialogCanceled(FALSE);
668           Close;
669           Exit;
670         end;
671         if ((cboService.ItemIEN > 0) and (Length(memReason.Text) = 0)) then
672           QuickCopy(DefaultReasonForRequest(cboService.ItemID, True), memReason);
673         SetupReasonForRequest(ORDER_QUICK);
674         GetProvDxandValidateCode(Responses);
675         Changing := False;
676       end
677     else
678       begin
679         if cboService.ItemIEN > 0 then
680           begin
681             if not ShowPrerequisites then
682               begin
683                 Close;
684                 Exit;
685               end;
686             QuickCopy(DefaultReasonForRequest(cboService.ItemID, True), memReason);
687             SetupReasonForRequest(ORDER_NEW);
688           end;
689       end;
690     SetProvDiagPromptingMode;
691     SetUpEarliestDate; //wat v28
692     tmpSvc := Piece(cboService.Items[cboService.ItemIndex], U, 6);
693     pnlMessage.TabOrder := treService.TabOrder + 1;
694     OrderMessage(ConsultMessage(StrToIntDef(tmpSvc, 0)));
695     //OrderMessage(ConsultMessage(cboService.ItemIEN));
696     ControlChange(Self) ;
697   end;
698   
699   procedure TfrmODCslt.ControlChange(Sender: TObject);
700   var
701     x: string;
702     i: integer;
703   begin
704     inherited;
705     if Changing or (cboService.ItemIEN = 0) then Exit;
706     with cboService    do
707       begin
708         if (ItemIEN > 0) and (Piece(Items[ItemIndex], U, 5) <> '1') then
709           begin
710             i := Pos('<', Text);
711             if i > 0 then
712               begin
713                 x := Piece(Copy(Text, i + 1, 99), '>', 1);
714                 x := UpperCase(Copy(x, 1, 1)) + Copy(x, 2, 99);
715               end
716             else
717               x := Text;
718             Responses.Update('ORDERABLE', 1, Piece(Items[ItemIndex], U, 6), x);
719           end
720         else Responses.Update('ORDERABLE', 1, '', '');
721       end;
722     with memReason     do  Responses.Update('COMMENT',   1, TX_WPTYPE, Text);
723     with cboCategory   do  Responses.Update('CLASS',     1, ItemID, Text);
724     with cboUrgency    do  Responses.Update('URGENCY',   1, ItemID, Text);
725     with cboPlace      do  Responses.Update('PLACE',     1, ItemID, Text);
726     with txtAttn       do  Responses.Update('PROVIDER',  1, ItemID, Text);
727     with calEarliest   do if Length(Text) > 0 then Responses.Update('EARLIEST',  1, Text,   Text);
728     //with txtProvDiag   do if Length(Text) > 0 then Responses.Update('MISC',      1, Text,   Text);
729     if Length(ProvDx.Text)                > 0 then Responses.Update('MISC',      1, ProvDx.Text,   ProvDx.Text)
730      else Responses.Update('MISC',      1, '',   '');
731     if Length(ProvDx.Code)                > 0 then Responses.Update('CODE',      1, ProvDx.Code,   ProvDx.Code)
732      else Responses.Update('CODE',      1, '',   '');
733   
734     memOrder.Text := Responses.OrderText;
735   end;
736   
737   procedure TfrmODCslt.treServiceEnter(Sender: TObject);
738   begin
739     inherited;
740     cmdQuit.Cancel := FALSE;
741   end;
742   
743   procedure TfrmODCslt.treServiceExit(Sender: TObject);
744   begin
745     inherited;
746     cmdQuit.Cancel := TRUE;
747     with cboService do
748     begin
749       if ItemIEN > 0 then
750       begin
751         pnlMessage.TabOrder := treService.TabOrder + 1;
752         OrderMessage(ConsultMessage(StrToInt(Piece(Items[ItemIndex],U,6))));
753       end;
754     end;
755   end;
756   
757   procedure TfrmODCslt.SetUpQuickOrderDX;
758   // this procedure is called if the user selects a quick code from the list
759   // and accepts the order without entering or selection the diagnoses button.
760   begin
761      quickCode := ProvDx.Code;
762      if UBACore.IsICD9CodeActive(quickCode,'ICD',0) then
763      begin
764         UBAGlobals.BAConsultDxList.Clear;
765         UBAGlobals.BAConsultDxList.Add(UBAConst.PRIMARY_DX + U + ProvDx.Text + ':' +  quickCode);
766      end;
767   
768   end;
769   
770   procedure TfrmODCslt.cmdAcceptClick(Sender: TObject);
771   var
772     BADiagnosis: string;
773    begin
774    inherited;
775    if treService.Selected <> nil then
776       LastNode := treService.Selected.AbsoluteIndex;
777   
778    if  BILLING_AWARE and CIDCOkToSave  then
779    begin
780       if btnDiagnosis.Enabled then
781         if consultQuickOrder then SetUpQuickOrderDX;
782          if UBAGlobals.BAConsultDxList.Count > 0 then
783          begin
784             UBACore.CompleteConsultOrderRec(UBAGlobals.BAOrderID,UBAGlobals.BAConsultDxList);
785             UBAGlobals.BAConsultDxList.Clear;
786          end;
787       BADiagnosis := ProvDx.Text + '^' + ProvDx.Code;
788    end;
789   
790    if NOT BILLING_AWARE then
791    begin
792      // this will save a dx entered by a nurse to be reviewed by a provided.
793      // this is active if CIDC MASTER SWITCH is ON.
794        if rpcGetBAMasterSwStatus then   // BA master sw is on.
795         if (uCore.User.OrderRole = OR_NURSE) then   // user is a nurse
796        begin
797           if ProvDx.Text <> '' then   // consult dx has been selected
798           begin
799               SaveConsultDxForNurse(ProvDx.Text + ProvDx.Code); // save selected dx, will be displayed to Provider
800           end;
801        end;
802    end;
803   end;
804   
805   procedure TfrmODCslt.memReasonExit(Sender: TObject);
806   var
807     AStringList: TStringList;
808   begin
809     inherited;
810     AStringList := TStringList.Create;
811     try
812       //QuickCopy(memReason, AStringList);
813       AStringList.Text := memReason.Text;
814       LimitStringLength(AStringList, 74);
815       //QuickCopy(AstringList, memReason);
816       memReason.Text := AStringList.Text;
817       ControlChange(Self);
818     finally
819       AStringList.Free;
820     end;
821   end;
822   
823   procedure TfrmODCslt.cboServiceSelect(Sender: TObject);
824   var
825     tmpSvc: string;
826   begin
827     if FcboServiceKeyDownStopClick then
828     begin
829       Exit; //This fixes clearquest: HDS00001418
830       FcboServiceKeyDownStopClick := false;
831     end;
832     memReason.Clear;
833     with cboService do
834       begin
835         setup508Label(servicelbl508, cboService);
836         if (ItemIndex < 0) or (ItemID = '') then
837           begin
838             Responses.Update('ORDERABLE', 1, '', '');
839             memOrder.Clear;
840             FLastServiceID := '';
841             exit;
842           end;
843         if Piece(Items[ItemIndex],U,5) = '1' then
844           begin
845             Responses.Update('ORDERABLE', 1, '', '');
846             memOrder.Clear;
847             FLastServiceID := '';
848             pnlMessage.TabOrder := cboService.TabOrder + 1;
849             OrderMessage(TX_GROUPER);
850             Exit;
851           end;
852         FLastServiceID := ItemID;
853         if CharAt(ItemID, 1) = 'Q' then
854           begin
855             Changing := True;
856             Responses.QuickOrder := ExtractInteger(ItemID);
857             consultQuickOrder := True;
858             tmpSvc := TResponse(Responses.FindResponseByName('ORDERABLE',1)).EValue;
859             ItemIndex := Items.IndexOf(Trim(tmpSvc));
860             If ItemIndex < LLS_LINE_INDEX then       {TP - HDS00015782: Check if index is of a QO}
861               ItemIndex := GetItemIndex(tmpSvc,ItemIndex);
862   (*          tmpSvc := TResponse(Responses.FindResponseByName('ORDERABLE',1)).IValue;
863             for i := 0 to Items.Count-1 do
864               begin
865                 if Piece(Items[i],U,6) = tmpSvc then
866                   begin
867                     ItemIndex := i;
868                     break;
869                   end;
870               end;*)
871             FLastServiceID := ItemID;
872             Enabled := False;
873             setup508Label(servicelbl508, cboService);
874             Font.Color := clGrayText;
875             btnServiceTree.Enabled := False;
876             pnlServiceTreeButton.Enabled := False;
877             Changing := False;
878             with Responses do if QuickOrder > 0 then
879               begin
880                 Changing := True;
881                 if not ShowPrerequisites then
882                   begin
883                     Close;
884                     Exit;
885                   end;
886                 SetControl(cboCategory,   'CLASS',      1);
887                 if cboCategory.ItemID = 'I' then radInpatient.Checked := True
888                 else radOutpatient.Checked := True ;
889                 SetControl(cboUrgency,    'URGENCY',     1);
890                 SetControl(cboPlace,      'PLACE',     1);
891                 SetControl(txtAttn,       'PROVIDER',  1);
892                 SetControl(calEarliest,   'EARLIEST',  1);
893                 SetTemplateDialogCanceled(FALSE);
894                 SetControl(memReason,     'COMMENT',   1);
895                 if WasTemplateDialogCanceled and OrderContainsObjects then
896                 begin
897                   AbortOrder := TRUE;
898   				SetTemplateDialogCanceled(FALSE);
899                   Close;
900                   Exit;
901                 end;
902   //              if ((cboService.ItemIEN > 0) and (Length(memReason.Text) = 0)) then
903   //                QuickCopy(DefaultReasonForRequest(cboService.ItemID, True), memReason);
904                 SetupReasonForRequest(ORDER_QUICK);
905                 GetProvDxandValidateCode(Responses);
906                 Changing := False;
907               end
908             else
909               begin
910                 if cboService.ItemIEN > 0 then
911                   begin
912                     Changing := True;
913                     if not ShowPrerequisites then
914                       begin
915                         Close;
916                         Exit;
917                       end;
918                     QuickCopy(DefaultReasonForRequest(cboService.ItemID, True), memReason);
919                     SetupReasonForRequest(ORDER_NEW);
920                     Changing := False;
921                   end;
922               end;
923           end
924         else
925           begin
926             Changing := True;
927             if not ShowPrerequisites then
928               begin
929                 Close;
930                 Exit;
931               end;
932             QuickCopy(DefaultReasonForRequest(cboService.ItemID, True), memReason);
933             SetupReasonForRequest(ORDER_NEW);
934             Changing := False;
935           end;
936         end;
937     treService.Visible := False;
938     SetProvDiagPromptingMode;
939     tmpSvc := Piece(cboService.Items[cboService.ItemIndex], U, 6);
940     pnlMessage.TabOrder := cboService.TabOrder + 1;
941     OrderMessage(ConsultMessage(StrToIntDef(tmpSvc, 0)));
942     //OrderMessage(ConsultMessage(cboService.ItemIEN));
943     ControlChange(Self) ;
944     SetUpEarliestDate;    //wat v28
945     setup508Label(servicelbl508, cboService);
946   end;
947   
948   procedure TfrmODCslt.FormDestroy(Sender: TObject);
949   begin
950     if not FreeGlobalLists then
951       Exit;
952     inherited;
953   end;
954   
955   procedure TfrmODCslt.btnServiceTreeClick(Sender: TObject);
956   var
957     i: integer;
958   begin
959     inherited;
960     Changing := True;
961     treService.Visible := not treService.Visible;
962     if treService.Visible then
963     begin
964     // for some reason screen reader is reading caption when tree view is not visible
965       treService.Caption := TX_SVC_HRCHY;
966       pnlServiceTreeButton.Caption := TX_CLOSE_SVC_HRCHY;
967       btnServiceTree.Hint := TX_CLOSE_SVC_HRCHY;
968       treService.SetFocus;
969       with treService do for i := 0 to Items.Count-1 do
970       begin
971         if Piece(TORTreeNode(Items[i]).StringData, U, 1) = cboService.ItemID then
972           begin
973             Selected := Items[i];
974             if Piece(TORTreeNode(Items[i]).StringData, U, 5) = '1' then Selected.Expand(True);
975             break;
976           end;
977       end;
978     end
979     else
980     begin
981       treService.Caption := '';
982       pnlServiceTreeButton.Caption := TX_VIEW_SVC_HRCHY;
983       btnServiceTree.Hint := TX_VIEW_SVC_HRCHY;
984       pnlServiceTreeButton.SetFocus;
985     end;
986     Changing := False;
987   end;
988   
989   procedure  TfrmODCslt.ReadServerVariables;
990   begin
991     if StrToIntDef(KeyVariable['GMRCNOAT'], 0) > 0 then
992       begin
993         txtAttn.Enabled    := False;
994         txtAttn.Font.Color := clGrayText;
995         lblAttn.Enabled    := False;
996         txtAttn.Color      := clBtnFace;
997       end
998     else
999       begin
1000        txtAttn.Enabled    := True;
1001        txtAttn.Font.Color := clWindowText;
1002        lblAttn.Enabled    := True;
1003        txtAttn.Color      := clWindow;
1004      end;
1005  
1006    if StrToIntDef(KeyVariable['GMRCNOPD'], 0) > 0 then
1007      begin
1008        if BILLING_AWARE then
1009           btnDiagnosis.Enabled   := False //1.4.18
1010        else
1011           cmdLexSearch.Enabled   := False;
1012        txtProvDiag.Enabled    := False;
1013        txtProvDiag.Font.Color := clGrayText;
1014        txtProvDiag.ReadOnly   := True;
1015        txtProvDiag.Color      := clBtnFace;
1016      end
1017    else SetProvDiagPromptingMode;
1018  
1019    GMRCREAF := KeyVariable['GMRCREAF'];
1020  end;
1021  
1022  procedure TfrmODCslt.treServiceCollapsing(Sender: TObject; Node: TTreeNode;
1023    var AllowCollapse: Boolean);
1024  begin
1025    inherited;
1026    Changing := True;
1027    treService.Selected := nil;
1028    Changing := False;
1029    AllowCollapse := True;
1030  end;
1031  
1032  procedure TfrmODCslt.treServiceMouseDown(Sender: TObject;
1033    Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
1034  var
1035    tmpNode: TORTreeNode;
1036    NodeRect: TRect;
1037  begin
1038    inherited;
1039    if Button <> mbLeft then exit;
1040    tmpNode := TORTreeNode(treService.GetNodeAt(X, Y));
1041    if tmpNode = nil then exit;
1042    NodeRect := tmpNode.DisplayRect(True);
1043    if treService.Selected <> nil then
1044      if (X >= NodeRect.Left) then     // user clicked in the text of the item, not on the bitmap
1045        begin
1046          if tmpNode.StringData <> '' then
1047            if (Piece(tmpNode.StringData, U, 5) <> '1') then
1048              treService.Visible := False;
1049            end;
1050  end;
1051  
1052  procedure TfrmODCslt.cmdLexSearchClick(Sender: TObject);
1053  var
1054    Match: string;
1055    i: integer;
1056  begin
1057    inherited;
1058  
1059   if  BILLING_AWARE then BADxUpdated := FALSE;
1060  
1061   LexiconLookup(Match, LX_ICD);
1062   if Match = '' then Exit;
1063   ProvDx.Code := Piece(Piece(Match, U, 1), '/', 1);
1064   ProvDx.Text := Piece(Match, U, 2);
1065   i := Pos(' (ICD', ProvDx.Text);
1066   if i = 0 then i := Length(ProvDx.Text) + 1;
1067   if ProvDx.Text[i-1] = '*' then i := i - 2;
1068   ProvDx.Text := Copy(ProvDx.Text, 1, i - 1);
1069   txtProvDiag.Text := ProvDx.Text + ' (' + ProvDx.Code + ')';
1070   ProvDx.CodeInactive := False;
1071  end;
1072  
1073  procedure TfrmODCslt.SetProvDiagPromptingMode;
1074  const
1075    TX_USE_LEXICON = 'You must use the "Lexicon" button to select a provisional diagnosis for this service.';
1076    TX_USE_DIAGNOSIS = 'You must use the "Diagnosis" button to select a diagnosis for this service.';
1077  
1078    TX_PROVDX_OPT  = 'Provisional Diagnosis';
1079    TX_PROVDX_REQD = 'Provisional Dx (REQUIRED)';
1080  begin
1081    if BILLING_AWARE then
1082       btnDiagnosis.Enabled    := False //1.4.18
1083    else
1084       cmdLexSearch.Enabled   := False;
1085    txtProvDiag.Enabled    := False;
1086    txtProvDiag.ReadOnly   := True;
1087    txtProvDiag.Color      := clBtnFace;
1088    txtProvDiag.Font.Color := clBtnText;
1089    txtProvDiag.Hint       := '';
1090    if cboService.ItemIEN = 0 then Exit;
1091    ProvDx.PreviousPromptMode := ProvDx.PromptMode;
1092    GetProvDxMode(ProvDx, cboService.ItemID + CSLT_PTR);
1093    //  Returns:  string  A^B
1094    //     A = O (optional), R (required) or S (suppress)
1095    //     B = F (free-text) or L (lexicon)
1096    if (ProvDx.PreviousPromptMode <> '') and (ProvDx.PromptMode <> ProvDx.PreviousPromptMode) then
1097    begin
1098      ProvDx.Code := '';
1099      ControlChange(Self);
1100    end;
1101    with ProvDx do if (Reqd = '') or (PromptMode = '') then Exit;
1102    if ProvDx.Reqd = 'R' then
1103    begin
1104      lblProvDiag.Caption := TX_PROVDX_REQD;
1105      if (BILLING_AWARE)  and (ProvDx.PromptMode[1] = '') then btnDiagnosis.Enabled := True;
1106    end
1107    else
1108      lblProvDiag.Caption := TX_PROVDX_OPT;
1109    if ProvDx.Reqd = 'S' then
1110      begin
1111        cmdLexSearch.Enabled   := False;
1112        txtProvDiag.Enabled    := False;
1113        txtProvDiag.ReadOnly   := True;
1114        txtProvDiag.Color      := clBtnFace;
1115        txtProvDiag.Font.Color := clBtnText;
1116      end
1117    else
1118      case ProvDx.PromptMode[1] of
1119        'F':  begin
1120                cmdLexSearch.Enabled   := False;
1121                txtProvDiag.Enabled    := True;
1122                txtProvDiag.ReadOnly   := False;
1123                txtProvDiag.Color      := clWindow;
1124                txtProvDiag.Font.Color := clWindowText;
1125              end;
1126        'L':  begin
1127                if BILLING_AWARE then
1128                begin
1129                   btnDiagnosis.Enabled   := True; //1.4.18
1130                   txtProvDiag.Hint       := TX_USE_DIAGNOSIS;
1131                end
1132                else
1133                begin
1134                   cmdLexSearch.Enabled   := True;
1135                   txtProvDiag.Hint       := TX_USE_LEXICON;
1136                end;
1137                txtProvDiag.Enabled    := True;
1138                txtProvDiag.ReadOnly   := True;
1139                txtProvDiag.Color      := clInfoBk;
1140                txtProvDiag.Font.Color := clInfoText;
1141             end;
1142      end;
1143  end;
1144  
1145  
1146  procedure TfrmODCslt.setup508Label(lbl: TVA508StaticText; ctrl: TORComboBox);
1147  begin
1148    if ScreenReaderSystemActive and not ctrl.Enabled then begin
1149      lbl.Enabled := True;
1150      lbl.Visible := True;
1151      lbl.Caption := lblService.Caption + ', ' + ctrl.Text;
1152      lbl.Width := (ctrl.Left + ctrl.Width) - lbl.Left;
1153    end else
1154      lbl.Visible := false;
1155  end;
1156  
1157  procedure TfrmODCslt.mnuPopProvDxDeleteClick(Sender: TObject);
1158  begin
1159    inherited;
1160    ProvDx.Text := '';
1161    ProvDx.Code := '';
1162    txtProvDiag.Text := '';
1163    ControlChange(Self);
1164  end;
1165  
1166  procedure TfrmODCslt.txtProvDiagChange(Sender: TObject);
1167  begin
1168    inherited;
1169    if ProvDx.PromptMode = 'F' then
1170    begin
1171      ProvDx.Text := txtProvDiag.Text;
1172       displayDxCode := ProvDx.Text;
1173    end;
1174    ControlChange(Self);
1175  end;
1176  
1177  procedure TfrmODCslt.SetupReasonForRequest(OrderAction: integer);
1178  var
1179    EditReason: string;
1180  
1181    procedure EnableReason;
1182    begin
1183      memReason.Color := clWindow;
1184      memReason.Font.Color := clWindowText;
1185      memReason.ReadOnly := False;
1186      lblReason.Caption := 'Reason for Request';
1187    end;
1188  
1189    procedure DisableReason;
1190    begin
1191      memReason.Color := clInfoBk;
1192      memReason.Font.Color := clInfoText;
1193      memReason.ReadOnly := True;
1194      lblReason.Caption := 'Reason for Request  (not editable)';
1195    end;
1196  
1197  begin
1198    if ((OrderAction = ORDER_QUICK) and (cboService.ItemID <> '') and (Length(memReason.Text) = 0)) then
1199      QuickCopy(DefaultReasonForRequest(cboService.ItemID, True), memReason);
1200    EditReason := GMRCREAF;
1201    if EditReason = '' then EditReason := ReasonForRequestEditable(cboService.ItemID + CSLT_PTR);
1202    case EditReason[1] of
1203      '0':  EnableReason;
1204      '1':  if OrderAction in [ORDER_COPY, ORDER_EDIT] then
1205              EnableReason
1206            else
1207              DisableReason;
1208      '2':  DisableReason
1209    else
1210      EnableReason;
1211    end;
1212  end;
1213  
1214  function TfrmODCslt.ShowPrerequisites: boolean;
1215  var
1216    AList: TStringList;
1217  const
1218    TC_PREREQUISITES = 'Service Prerequisites - ';
1219  begin
1220    Result := True;
1221    AbortOrder := False;
1222    AList := TStringList.Create;
1223    try
1224      with cboService do
1225        if ItemIEN > 0 then
1226          begin
1227            FastAssign(GetServicePrerequisites(ItemID + CSLT_PTR), Alist);
1228            if AList.Count > 0 then
1229              begin
1230                if not DisplayPrerequisites(AList, TC_PREREQUISITES + DisplayText[ItemIndex]) then
1231                  begin
1232                    memOrder.Clear;
1233                    Result := False;
1234                    AbortOrder := True;
1235                 end
1236                else Result := True;
1237              end;
1238          end;
1239    finally
1240      AList.Free;
1241    end;
1242  end;
1243  
1244  procedure TfrmODCslt.cboServiceExit(Sender: TObject);
1245  begin
1246    inherited;
1247    if Length(memOrder.Text) = 0 then Exit;
1248    if (Length(cboService.ItemID) = 0) or (cboService.ItemID = '0') then Exit;
1249    if cboService.ItemID = FLastServiceID then Exit;
1250    cboServiceSelect(cboService);
1251    // CQ #7490, following line commented out v26.24 (RV)
1252    // CQ #9610 and 10074 - uncommented and "if" added v26.54 (RV)
1253    if cboService.Enabled then cboService.SetFocus;
1254    PostMessage(Handle, WM_NEXTDLGCTL, 0, 0);
1255  end;
1256  
1257  procedure TfrmODCslt.popReasonPopup(Sender: TObject);
1258  begin
1259    inherited;
1260    if PopupComponent(Sender, popReason) is TCustomEdit
1261      then FEditCtrl := TCustomEdit(PopupComponent(Sender, popReason))
1262      else FEditCtrl := nil;
1263    if FEditCtrl <> nil then
1264    begin
1265      popReasonCut.Enabled      := FEditCtrl.SelLength > 0;
1266      popReasonCopy.Enabled     := popReasonCut.Enabled;
1267      popReasonPaste.Enabled    := (not TORExposedCustomEdit(FEditCtrl).ReadOnly) and
1268                                     Clipboard.HasFormat(CF_TEXT);
1269    end else
1270    begin
1271      popReasonCut.Enabled      := False;
1272      popReasonCopy.Enabled     := False;
1273      popReasonPaste.Enabled    := False;
1274    end;
1275    popReasonReformat.Enabled := True;
1276  end;
1277  
1278  procedure TfrmODCslt.popReasonCutClick(Sender: TObject);
1279  begin
1280    inherited;
1281    FEditCtrl.CutToClipboard;
1282  end;
1283  
1284  procedure TfrmODCslt.popReasonCopyClick(Sender: TObject);
1285  begin
1286    inherited;
1287    FEditCtrl.CopyToClipboard;
1288  end;
1289  
1290  procedure TfrmODCslt.popReasonPasteClick(Sender: TObject);
1291  begin
1292    inherited;
1293    FEditCtrl.SelText := Clipboard.AsText;
1294  end;
1295  
1296  procedure TfrmODCslt.popReasonReformatClick(Sender: TObject);
1297  begin
1298    inherited;
1299    if Screen.ActiveControl <> memReason then Exit;
1300    ReformatMemoParagraph(memReason);
1301  end;
1302  
1303  function TfrmODCslt.DefaultReasonForRequest(Service: string;
1304    Resolve: Boolean): TStrings;
1305  var
1306    TmpSL: TStringList;
1307    DocInfo: string;
1308    x: string;
1309    HasObjects: boolean;
1310  begin
1311    Resolve := FALSE ;  // override value passed in - resolve on client - PSI-05-093
1312    DocInfo := '';
1313    TmpSL := TStringList.Create;
1314    try
1315      Result := GetDefaultReasonForRequest(Service + CSLT_PTR, Resolve);
1316      FastAssign(Result, TmpSL);
1317      x := TmpSL.Text;
1318      ExpandOrderObjects(x, HasObjects);
1319      TmpSL.Text := x;
1320      Responses.OrderContainsObjects := HasObjects;
1321      ExecuteTemplateOrBoilerPlate(TmpSL, cboService.ItemIEN , ltConsult, nil, 'Reason for Request: ' + cboService.DisplayText[cboService.ItemIndex], DocInfo);
1322      AbortOrder := WasTemplateDialogCanceled;
1323      Responses.OrderContainsObjects := HasObjects or TemplateBPHasObjects;
1324      if AbortOrder then
1325      begin
1326        Result.Text := '';
1327        Close;
1328        Exit;
1329      end
1330      else
1331        FastAssignWith508Msg(TmpSL, Result);
1332    finally
1333      TmpSL.Free;
1334    end;
1335  end;
1336  
1337  procedure TfrmODCslt.pnlServiceTreeButtonEnter(Sender: TObject);
1338  begin
1339    inherited;
1340    (Sender as TPanel).BevelOuter := bvRaised;
1341  end;
1342  
1343  procedure TfrmODCslt.pnlServiceTreeButtonExit(Sender: TObject);
1344  begin
1345    inherited;
1346    (Sender as TPanel).BevelOuter := bvNone;
1347  end;
1348  
1349  procedure TfrmODCslt.treServiceKeyDown(Sender: TObject; var Key: Word;
1350    Shift: TShiftState);
1351  begin
1352    inherited;
1353    case Key of
1354    VK_SPACE, VK_RETURN:
1355      begin
1356        Key := 0;
1357        FKeyBoarding := False;
1358        treServiceChange(Sender, treService.Selected);
1359      end;
1360    VK_ESCAPE:
1361      begin
1362        key := 0;
1363        btnServiceTreeClick(Self);
1364      end    
1365    else
1366      FKeyBoarding := True;
1367    end;
1368  end;
1369  
1370  procedure TfrmODCslt.treServiceKeyUp(Sender: TObject; var Key: Word;
1371    Shift: TShiftState);
1372  begin
1373    inherited;
1374    FKeyBoarding := False;
1375  end;
1376  
1377  procedure TfrmODCslt.DoSetFontSize(FontSize: integer);
1378  begin
1379    memReason.DefAttributes.Size := FontSize;
1380    treService.Font.Size := FontSize * 7 div 8;
1381  end;
1382  
1383  procedure TfrmODCslt.SetFontSize(FontSize: integer);
1384  begin
1385    inherited SetFontSize(FontSize);
1386    DoSetFontSize(FontSize);
1387  end;
1388  
1389  procedure TfrmODCslt.memReasonKeyUp(Sender: TObject; var Key: Word;
1390    Shift: TShiftState);
1391  begin
1392    inherited;
1393    if FNavigatingTab then
1394    begin
1395      if ssShift in Shift then
1396        FindNextControl(Sender as TWinControl, False, True, False).SetFocus //previous control
1397      else if ssCtrl	in Shift then
1398        FindNextControl(Sender as TWinControl, True, True, False).SetFocus; //next control
1399      FNavigatingTab := False;
1400    end;
1401    if (key = VK_ESCAPE) then begin
1402      FindNextControl(Sender as TWinControl, False, True, False).SetFocus; //previous control
1403      key := 0;
1404    end;
1405  end;
1406  
1407  procedure TfrmODCslt.GetProvDxandValidateCode(AResponses: TResponses);
1408  var
1409    tmpDx: TResponse;
1410  
1411  begin
1412    with AResponses do
1413      begin
1414        tmpDx := TResponse(FindResponseByName('MISC',1));
1415        if tmpDx <> nil then ProvDx.Text := tmpDx.Evalue;
1416        tmpDx := TResponse(FindResponseByName('CODE',1));
1417        sourceOrderID := Responses.CopyOrder;
1418        if (tmpDx <> nil) and (tmpDx.EValue <> '') then
1419        begin
1420          if IsActiveICDCode(tmpDx.EValue) then
1421            ProvDx.Code := tmpDx.Evalue
1422          else
1423            begin
1424              if ProvDx.Reqd = 'R' then
1425                InfoBox(TX_INACTIVE_CODE1 + TX_INACTIVE_CODE_REQD, TC_INACTIVE_CODE, MB_ICONWARNING or MB_OK)
1426              else
1427                InfoBox(TX_INACTIVE_CODE1 + TX_INACTIVE_CODE_OPTIONAL, TC_INACTIVE_CODE, MB_ICONWARNING or MB_OK);
1428              ProvDx.Code := '';
1429              ProvDx.Text := '';
1430            end;
1431        end;
1432        txtProvDiag.Text := ProvDx.Text;
1433        if ProvDx.Code <> '' then
1434           txtProvDiag.Text :=  (txtProvDiag.Text + ' (' + ProvDx.Code + ')' )
1435        else
1436        begin
1437           if BILLING_AWARE  then
1438             if (sourceOrderID <> '') and (ProvDx.Code <> '') then  // if sourceid exists then user is copying an order.
1439               SetUpCopyConsultDiagnoses(sourceOrderID);
1440  
1441        end;
1442  
1443     end;
1444  end;
1445  
1446  procedure TfrmODCslt.memReasonKeyDown(Sender: TObject; var Key: Word;
1447    Shift: TShiftState);
1448  begin
1449    inherited;
1450    //The navigating tab controls were inadvertantently adding tab characters
1451    //This should fix it
1452    FNavigatingTab := (Key = VK_TAB) and ([ssShift,ssCtrl] * Shift <> []);
1453    if FNavigatingTab then
1454      Key := 0;
1455  end;
1456  
1457  procedure TfrmODCslt.memReasonKeyPress(Sender: TObject; var Key: Char);
1458  begin
1459    inherited;
1460    if FNavigatingTab then
1461      Key := #0;  //Disable shift-tab processing
1462  end;
1463  
1464  procedure TfrmODCslt.cboServiceKeyDown(Sender: TObject; var Key: Word;
1465    Shift: TShiftState);
1466  begin
1467    inherited;
1468    //This fixes clearquest: HDS00001418 Makes it so OnClick is not called
1469    //Except when Enter or Space is pressed. VK_LBUTTON activates OnClick in TORComboBoxes
1470    FcboServiceKeyDownStopClick := false;
1471    if (Key <> VK_RETURN) {and (Key <> VK_SPACE)} and (Key <> VK_LBUTTON) then  //comment on this line is fix for CQ6789
1472      FcboServiceKeyDownStopClick := True
1473    else
1474      Key := VK_LBUTTON;
1475  end;
1476  
1477  procedure TfrmODCslt.cboServiceKeyUp(Sender: TObject; var Key: Word;
1478    Shift: TShiftState);
1479  begin
1480    inherited;
1481    FcboServiceKeyDownStopClick := false;
1482  end;
1483  
1484  
1485  procedure TfrmODCslt.btnDiagnosisClick(Sender: TObject);
1486  var
1487    leftParan, rightParan: string;
1488    tmpOrderIDList: TStringList;
1489  begin
1490    inherited;
1491    tmpOrderIDList := TStringList.Create;
1492    tmpOrderIDList.Clear;
1493    leftParan := '(';
1494    rightParan := ')';
1495    UBAGlobals.BAtmpOrderList.Clear;
1496    UBAGlobals.BAtmpOrderList.Add(Responses.OrderText);
1497    quickCode := '';
1498    if consultQuickOrder then
1499    begin
1500       quickCode := Piece(txtProvDiag.text,'(',2);
1501       quickCode := Piece(quickCode,')',1);
1502       if UBACore.IsICD9CodeActive(quickCode,'ICD',0) then
1503       begin
1504         UBAGlobals.BAConsultDxList.Clear;
1505         UBAGlobals.BAConsultDxList.Add(UBAConst.PRIMARY_DX + U + Piece(txtProvDiag.text,'(',1) + ':' +  quickCode);
1506       end;
1507  
1508    end;
1509    frmBALocalDiagnoses.Enter(UBAConst.F_CONSULTS, nil);
1510    if displayDxCode = '' then txtProvDiag.Text := ''
1511    else
1512    begin
1513       if displayDxCode <> 'DXCANCEL' then
1514       begin
1515          ProvDx.Code := Piece(displayDxCode,':', 2);
1516          ProvDx.Text := Piece(displayDxCode,':', 1);
1517          txtProvDiag.Text := ProvDx.Text + ' (' + ProvDx.Code + ')';
1518       end;
1519    end;
1520  
1521    ProvDx.CodeInactive := False;
1522  end;
1523  
1524  procedure TfrmODCslt.cmdQuitClick(Sender: TObject);
1525  begin
1526    inherited;
1527    if BILLING_AWARE then UBAGlobals.BAConsultDxList.Clear;
1528  end;
1529  
1530  procedure  TfrmODCslt.SaveConsultDxForNurse(pDiagnosis: string);
1531  var
1532    s,tmpTFactors: string;
1533    tmpList: TStringList;
1534  begin
1535     tmpList := TStringList.Create;
1536     tmpList.Clear;
1537     s := '';
1538     tmpList.Add(UBAGlobals.BAOrderID);
1539     s := GetPatientTFactors(tmpList);
1540     tmpTFactors := ConvertPIMTreatmentFactors(s);
1541     BANurseConsultOrders.Add(UBAGlobals.BAOrderID + '1' + tmpTFactors + U + ProvDX.Code);
1542  end;
1543  
1544  procedure TfrmODCslt.SetUpCopyConsultDiagnoses(pOrderID:string);
1545  var
1546    sourceOrderID, primaryText,primaryCode: string;
1547    sourceOrderList: TStringList;
1548    thisOrderList: TStringList;
1549  begin
1550  //logic handles setting up diagnoses when copying an order.
1551     sourceOrderList := TStringList.Create;
1552     sourceOrderList.Clear;
1553     thisOrderList := TStringList.Create;
1554     thisOrderList.Clear;
1555     if IsOrderBillable(sourceOrderID) then
1556     begin
1557        thisOrderList.Add(sourceOrderID);
1558        sourceOrderList := rpcRetrieveSelectedOrderInfo(thisOrderList);
1559        primaryText := Piece(sourceOrderList.Strings[0],U,4);
1560        primaryCode := Piece(sourceOrderList.Strings[0],U,3);
1561        txtProvDiag.Text := primaryText + ' (' + primaryCode + ')';
1562        ProvDx.CodeInactive := False;
1563        // need to handle the rest of the dx's
1564        UBAGlobals.BAConsultDxList.Clear;
1565        UBAGlobals.BAConsultDxList.Add(UBAConst.PRIMARY_DX + U + Piece(txtProvDiag.text,'(',1) + ':' +  primaryCode);
1566        if (Piece(sourceOrderList.Strings[0],U,5) <> '') then // dx2
1567           UBAGlobals.BAConsultDxList.Add(UBAConst.SECONDARY_DX + U + Piece(sourceOrderList.Strings[0],U,6) + ':' +  Piece(sourceOrderList.Strings[0],U,5));
1568        if  (Piece(sourceOrderList.Strings[0],U,7) <> '') then // dx3
1569           UBAGlobals.BAConsultDxList.Add(UBAConst.SECONDARY_DX + U + Piece(sourceOrderList.Strings[0],U,8) + ':' +  Piece(sourceOrderList.Strings[0],U,7));
1570        if (Piece(sourceOrderList.Strings[0],U,9) <> '') then // dx4
1571           UBAGlobals.BAConsultDxList.Add(UBAConst.SECONDARY_DX + U + Piece(sourceOrderList.Strings[0],U,10) + ':' +  Piece(sourceOrderList.Strings[0],U,9));
1572     end;
1573  end;
1574  
1575  procedure TfrmODCslt.FormClose(Sender: TObject; var Action: TCloseAction);
1576  begin
1577    inherited;
1578    frmFrame.pnlVisit.Enabled := true;
1579  end;
1580  
1581  procedure TfrmODCslt.FormResize(Sender: TObject);
1582  begin
1583    inherited;
1584    AdjustMemReasonSize();
1585  end;
1586  
1587  procedure TfrmODCslt.AdjustMemReasonSize;
1588  const
1589    PIXEL_SPACE = 3;
1590  begin
1591    pnlReason.Top := cboService.Top + cboService.Height + PIXEL_SPACE;
1592    pnlReason.Height := memOrder.Top - pnlReason.Top - PIXEL_SPACE;
1593    if patient.CombatVet.IsEligible then pnlReason.Height := pnlReason.Height - PIXEL_SPACE*20;
1594  end;
1595  
1596  function TfrmODCslt.NotinIndex(AList: TStringList; i: integer): Boolean;   {TP - HDS00015782:}
1597  {This function determines if a Consult Service will be added to the cboService
1598  component.  If name does not exist or if name does not exist below the Quick
1599  Order listing, then it is added.}
1600  var
1601    x: Integer;
1602    y: String;
1603  begin
1604    Result := False;
1605    x := cboService.Items.IndexOf(Trim(Piece(AList.Strings[i], U, 2)));
1606    if (x = -1) then
1607      Result := True;
1608    if (x <> -1) and (x < LLS_LINE_INDEX) then
1609    begin
1610      y := cboService.Items[x];
1611      cboService.Items.Delete(x);
1612      if (cboService.Items.IndexOf(Trim(Piece(AList.Strings[i], U, 2))) = -1) then
1613        Result := True;
1614      cboService.Items.Insert(x,y);
1615    end;
1616  
1617  end;
1618  
1619  function TfrmODCslt.GetItemIndex(Service: String; Index: integer): integer;     {TP - HDS00015782:}
1620  {This function returns ItemIndexOf value for Service Consult when a Quick Order
1621  has the exact same name}
1622  var
1623    y: String;
1624  
1625  begin
1626    y := cboService.Items[Index];
1627    cboService.Items.Delete(Index);
1628    Result := (cboService.Items.IndexOf(Trim(Service)) + 1);
1629    cboService.Items.Insert(Index,y);
1630  end;
1631  
1632  procedure TfrmODCslt.SetUpCombatVet;
1633  begin
1634       pnlCombatVet.BringToFront;
1635       txtCombatVet.Enabled := True;
1636       txtCombatVet.Caption := 'Combat Veteran Eligibility Expires on ' + patient.CombatVet.ExpirationDate;
1637       pnlMain.Top := pnlMain.Top + pnlCombatVet.Height;
1638       pnlMain.Anchors := [akLeft,akTop,akRight];
1639       treService.Anchors := [akLeft,akTop,akRight];
1640       self.Height := self.Height + pnlCombatVet.Height;
1641       treService.Anchors := [akLeft,akTop,akRight,akBottom];
1642       pnlMain.Anchors := [akLeft,akTop,akRight,akBottom];
1643  end;
1644  
1645  procedure TfrmODCslt.SetUpEarliestDate;  //wat v28
1646  begin
1647    if IsProstheticsService(cboService.ItemIEN) = '1' then
1648      begin
1649        lblEarliest.Enabled := False;
1650        calEarliest.Enabled := False;
1651        calEarliest.Text := '';
1652        Responses.Update('EARLIEST',1,'','');
1653      end
1654    else
1655      begin
1656        lblEarliest.Enabled := True;
1657        calEarliest.Enabled := True;
1658        if calEarliest.Text = 'T' then calEarliest.Text := 'TODAY';
1659      end;
1660  end;
1661  
1662  end.

Module Calls (2 levels)


fODConsult
 ├fODBase
 │ ├fAutoSz
 │ ├uConst
 │ ├rOrders
 │ ├rODBase
 │ ├uCore
 │ ├UBAGlobals
 │ ├UBACore
 │ ├fOCAccept
 │ ├uODBase
 │ ├rCore
 │ ├rMisc
 │ ├fTemplateDialog
 │ ├uEventHooks
 │ ├uTemplates
 │ ├rConsults
 │ ├fOrders
 │ ├uOrders
 │ ├fFrame
 │ ├fODDietLT
 │ └rODDiet
 ├uConst
 ├UBAGlobals...
 ├fBALocalDiagnoses
 │ ├fAutoSz...
 │ ├fPCELex
 │ ├uConsults
 │ ├rPCE
 │ ├UBAGlobals...
 │ ├UBACore...
 │ ├uCore...
 │ ├rCore...
 │ ├rOrders...
 │ ├fOrdersSign
 │ ├UBAConst
 │ ├UBAMessages
 │ ├fReview
 │ ├fODConsult...
 │ └fFrame...
 ├UBAConst
 ├UBACore...
 ├rODBase...
 ├rConsults...
 ├uCore...
 ├uConsults...
 ├rCore...
 ├fPCELex...
 ├rPCE...
 ├fPreReq
 │ ├fBase508Form
 │ ├uReports
 │ ├rReports
 │ └rMisc...
 ├uTemplates...
 ├fFrame...
 ├uODBase...
 └uVA508CPRSCompatibility
   ├uDlgComponents
   ├fFrame...
   ├uCore...
   └mTemplateFieldButton

Module Called-By (2 levels)


                  fODConsult
                   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┘ │ 
                fOrders...┤ 
         fBALocalDiagnoses┘ 
              UBAGlobals┤   
          fOrdersSign...┤   
              fReview...┤   
           fODConsult...┘