Module

fEditConsult

Path

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

Last Modified

7/15/2014 3:26:34 PM

Units Used in Interface

Name Comments
fAutoSz -
fBase508Form -
uConst -
uConsults -

Units Used in Implementation

Name Comments
fConsults -
fPCELex -
fRptBox -
rConsults -
rCore -
rODBase -
rOrders -
rPCE -
UBAGlobals -
uCore -

Classes

Name Comments
TfrmEditCslt -

Procedures

Name Owner Declaration Scope Comments
btnCmtCancelClick TfrmEditCslt procedure btnCmtCancelClick(Sender: TObject); Public/Published -
btnCmtOtherClick TfrmEditCslt procedure btnCmtOtherClick(Sender: TObject); Public/Published -
calEarliestExit TfrmEditCslt procedure calEarliestExit(Sender: TObject); Public/Published -
calLatestExit TfrmEditCslt procedure calLatestExit(Sender: TObject); Public/Published -
cmdAcceptClick TfrmEditCslt procedure cmdAcceptClick(Sender: TObject); Public/Published
Begin BillingAware
newDxRec: TBADxRecord;
AnOrder: TOrder;
End BillingAware
cmdLexSearchClick TfrmEditCslt procedure cmdLexSearchClick(Sender: TObject); Public/Published -
cmdQuitClick TfrmEditCslt procedure cmdQuitClick(Sender: TObject); Public/Published -
ControlChange TfrmEditCslt procedure ControlChange(Sender: TObject); Public/Published -
FormClose TfrmEditCslt procedure FormClose(Sender: TObject; var Action: TCloseAction); Public/Published -
InitDialog TfrmEditCslt procedure InitDialog; Protected -
memCommentExit TfrmEditCslt procedure memCommentExit(Sender: TObject); Public/Published Added OnExit code for CQ17822 WAT
memCommentKeyDown TfrmEditCslt procedure memCommentKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); Public/Published -
memCommentKeyPress TfrmEditCslt procedure memCommentKeyPress(Sender: TObject; var Key: Char); Public/Published -
memCommentKeyUp TfrmEditCslt procedure memCommentKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); Public/Published -
memReasonExit TfrmEditCslt procedure memReasonExit(Sender: TObject); Public/Published -
mnuPopProvDxDeleteClick TfrmEditCslt procedure mnuPopProvDxDeleteClick(Sender: TObject); Public/Published -
OrderMessage TfrmEditCslt procedure OrderMessage(const AMessage: string); Public/Published -
popReasonCopyClick TfrmEditCslt procedure popReasonCopyClick(Sender: TObject); Public/Published -
popReasonCutClick TfrmEditCslt procedure popReasonCutClick(Sender: TObject); Public/Published -
popReasonPasteClick TfrmEditCslt procedure popReasonPasteClick(Sender: TObject); Public/Published -
popReasonPopup TfrmEditCslt procedure popReasonPopup(Sender: TObject); Public/Published -
popReasonReformatClick TfrmEditCslt procedure popReasonReformatClick(Sender: TObject); Public/Published -
radInpatientClick TfrmEditCslt procedure radInpatientClick(Sender: TObject); Public/Published -
radOutpatientClick TfrmEditCslt procedure radOutpatientClick(Sender: TObject); Public/Published -
SetError - procedure SetError(const x: string); Local -
SetProvDiagPromptingMode TfrmEditCslt procedure SetProvDiagPromptingMode; Private FLatestDate: TFMDateTime;
SetUpCombatVet TfrmEditCslt procedure SetUpCombatVet; Private -
SetUpEarliestDate TfrmEditCslt procedure SetUpEarliestDate; Private Wat v28
txtAttnNeedData TfrmEditCslt procedure txtAttnNeedData(Sender: TObject; const StartFrom: String; Direction, InsertAt: Integer); Public/Published -
Validate TfrmEditCslt procedure Validate(var AnErrMsg: string); Protected -

Functions

Name Owner Declaration Scope Comments
EditResubmitConsult - function EditResubmitConsult(FontSize: Integer; ConsultIEN: integer): boolean; Interfaced -
ValidSave TfrmEditCslt function ValidSave: Boolean; Protected -

Global Variables

Name Type Declaration Comments
BADxUpdated Boolean BADxUpdated: boolean; Begin BillingAware
Defaults TStringList Defaults: TStringList; -
frmEditCslt TfrmEditCslt frmEditCslt: TfrmEditCslt; -
NewRec OldRec, NewRec: TEditResubmitRec; -
OldRec OldRec, NewRec: TEditResubmitRec; -
ProvDx ProvDx: TProvisionalDiagnosis; -
SvcList TStrings SvcList: TStrings ; -
uMessageVisible DWORD uMessageVisible: DWORD; -

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_INACTIVE_CODE '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 use the "Lexicon" button to select a diagnosis for consults to this service.' Global -
TX_SVC_ERROR 'This service has not been defined in your Orderable Items file.' + Global -


Module Source

1     unit fEditConsult;
2     
3     interface
4     
5     uses
6       Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7       StdCtrls, ORCtrls, ExtCtrls, ComCtrls, ORfn, uConst, uConsults, Buttons,
8       Menus, fAutoSz, ORDtTm, VA508AccessibilityManager, fBase508Form;
9     
10    type
11      TfrmEditCslt = class(TfrmAutoSz)
12        pnlMessage: TPanel;
13        imgMessage: TImage;
14        memMessage: TRichEdit;
15        cmdAccept: TButton;
16        cmdQuit: TButton;
17        pnlMain: TPanel;
18        lblService: TLabel;
19        lblReason: TLabel;
20        lblComment: TLabel;
21        lblComments: TLabel;
22        lblUrgency: TStaticText;
23        lblPlace: TStaticText;
24        lblAttn: TStaticText;
25        lblProvDiag: TStaticText;
26        lblInpOutp: TStaticText;
27        memReason: TRichEdit;
28        cboService: TORComboBox;
29        cboUrgency: TORComboBox;
30        radInpatient: TRadioButton;
31        radOutpatient: TRadioButton;
32        cboPlace: TORComboBox;
33        txtProvDiag: TCaptionEdit;
34        txtAttn: TORComboBox;
35        cboCategory: TORComboBox;
36        memComment: TRichEdit;
37        btnCmtCancel: TButton;
38        btnCmtOther: TButton;
39        cmdLexSearch: TButton;
40        lblEarliest: TStaticText;
41        calEarliest: TORDateBox;
42        lblLatest: TStaticText;
43        calLatest: TORDateBox;
44        mnuPopProvDx: TPopupMenu;
45        mnuPopProvDxDelete: TMenuItem;
46        popReason: TPopupMenu;
47        popReasonCut: TMenuItem;
48        popReasonCopy: TMenuItem;
49        popReasonPaste: TMenuItem;
50        popReasonPaste2: TMenuItem;
51        popReasonReformat: TMenuItem;
52        pnlCombatVet: TPanel;
53        txtCombatVet: TVA508StaticText;
54        procedure txtAttnNeedData(Sender: TObject; const StartFrom: String;
55          Direction, InsertAt: Integer);
56        procedure radInpatientClick(Sender: TObject);
57        procedure radOutpatientClick(Sender: TObject);
58        procedure ControlChange(Sender: TObject);
59        procedure FormClose(Sender: TObject; var Action: TCloseAction);
60        procedure cmdQuitClick(Sender: TObject);
61        procedure cmdAcceptClick(Sender: TObject);
62        procedure memReasonExit(Sender: TObject);
63        procedure OrderMessage(const AMessage: string);
64        procedure btnCmtCancelClick(Sender: TObject);
65        procedure btnCmtOtherClick(Sender: TObject);
66        procedure cmdLexSearchClick(Sender: TObject);
67        procedure mnuPopProvDxDeleteClick(Sender: TObject);
68        procedure popReasonCutClick(Sender: TObject);
69        procedure popReasonCopyClick(Sender: TObject);
70        procedure popReasonPasteClick(Sender: TObject);
71        procedure popReasonPopup(Sender: TObject);
72        procedure popReasonReformatClick(Sender: TObject);
73        procedure memCommentKeyUp(Sender: TObject; var Key: Word;
74          Shift: TShiftState);
75        procedure memCommentKeyDown(Sender: TObject; var Key: Word;
76          Shift: TShiftState);
77        procedure memCommentKeyPress(Sender: TObject; var Key: Char);
78        procedure calEarliestExit(Sender: TObject);
79        procedure calLatestExit(Sender: TObject);
80        procedure memCommentExit(Sender: TObject);
81      private
82        FLastServiceID: string;
83        FChanged: boolean;
84        FChanging: boolean;
85        FEditCtrl: TCustomEdit;
86        FNavigatingTab: boolean;
87        FEarliestDate: TFMDateTime;
88        FProstheticsSvc: boolean;
89        //FLatestDate: TFMDateTime;
90        procedure SetProvDiagPromptingMode;
91        procedure SetUpCombatVet;
92        procedure SetUpEarliestDate;
93      protected
94        procedure InitDialog;
95        procedure Validate(var AnErrMsg: string);
96        function  ValidSave: Boolean;
97      end;
98    
99    function EditResubmitConsult(FontSize: Integer; ConsultIEN: integer): boolean;
100   
101   var
102     frmEditCslt: TfrmEditCslt;
103   
104   implementation
105   
106   {$R *.DFM}
107   
108   uses
109       rODBase, rConsults, uCore, rCore, fConsults, fRptBox, fPCELex, rPCE,
110       ORClasses, clipbrd, UBAGlobals, rOrders ;
111   
112   var
113     SvcList: TStrings ;
114     OldRec, NewRec: TEditResubmitRec;
115     Defaults: TStringList;
116     uMessageVisible: DWORD;
117     ProvDx: TProvisionalDiagnosis;
118   {Begin BillingAware}
119     BADxUpdated: boolean;
120   {End BillingAware}
121   
122   const
123     TX_NOTTHISSVC_TEXT = 'Consults cannot be ordered from this service' ;
124     TX_NO_SVC          = 'A service must be specified.'    ;
125     TX_NO_REASON       = 'A reason for this consult must be entered.'  ;
126     TX_SVC_ERROR       = 'This service has not been defined in your Orderable Items file.' +
127                          #13#10'Contact IRM for assistance.' ;
128     TX_NO_URGENCY      = 'An urgency must be specified.';
129     TX_NO_PLACE        = 'A place of consultation must be specified';
130     TX_NO_DIAG         = 'A provisional diagnosis must be entered for consults to this service.';
131     TX_SELECT_DIAG     = 'You must use the "Lexicon" button to select a diagnosis for consults to this service.';
132     TX_INACTIVE_CODE   = 'The provisional diagnosis code is not active as of today''s date.' + #13#10 +
133                          'Another code must be selected';
134     TC_INACTIVE_CODE   = 'Inactive ICD Code';
135     TX_PAST_DATE       = 'Earliest appropriate date must be today or later.';
136     TX_BAD_DATES       = 'Latest appropriate date must be equal to or later than earliest date.';
137   
138   function EditResubmitConsult(FontSize: Integer; ConsultIEN: integer): boolean;
139   begin
140     Result := False;
141     if ConsultIEN = 0 then exit;
142     FillChar(OldRec, SizeOf(OldRec), 0);
143     FillChar(NewRec, SizeOf(NewRec), 0);
144     FillChar(ProvDx, SizeOf(ProvDx), 0);
145     OldRec := LoadConsultForEdit(ConsultIEN);
146     NewRec.IEN := OldRec.IEN;
147     NewRec.RequestType := OldRec.RequestType;
148     with NewRec do
149       begin
150         RequestReason:= TStringList.Create ;
151         DenyComments:= TStringList.Create ;
152         OtherComments:= TStringList.Create ;
153         NewComments:= TStringList.Create ;
154       end;
155     StatusText('Loading Consult for Edit');
156     frmEditCslt := TfrmEditCslt.Create(Application);
157     SvcList     := TStringList.Create ;
158     Defaults    := TStringList.Create;
159     try
160       with frmEditCslt do
161         begin
162           ResizeAnchoredFormToFont(frmEditCslt);
163           FChanged     := False;
164           InitDialog;
165           ShowModal ;
166           Result := FChanged ;
167         end ;
168     finally
169       OldRec.RequestReason.Free;
170       OldRec.DenyComments.Free;
171       OldRec.OtherComments.Free;
172       OldRec.NewComments.Free;
173       NewRec.RequestReason.Free;
174       NewRec.DenyComments.Free;
175       NewRec.OtherComments.Free;
176       NewRec.NewComments.Free;
177       SvcList.Free;
178       Defaults.Free;
179       frmEditCslt.Release;
180     end;
181   end;
182   
183   procedure TfrmEditCslt.InitDialog;
184   var
185    i:integer;
186   begin
187     FChanging := True;
188     FastAssign(ODForConsults, Defaults);
189     FLastServiceID := '';
190     cboService.Items.Clear;
191     if OldRec.InpOutp <> '' then
192       case OldRec.InpOutp[1] of
193         'I': radInpatient.Checked  := True;                 //INPATIENT CONSULT
194         'O': radOutpatient.Checked := True;                 //OUTPATIENT CONSULT
195       end
196     else
197       begin
198         if Patient.Inpatient then
199           radInpatient.Checked  := True
200         else
201           radOutpatient.Checked := True;  
202       end;
203     StatusText('Initializing Long List');
204     FastAssign(LoadServiceList(CN_SVC_LIST_ORD), SvcList)   ;
205     with cboService do
206       begin
207         for i := 0 to SvcList.Count - 1 do
208           if SelectByID(Piece(SvcList.Strings[i], U, 1)) = -1 then
209             Items.Add(SvcList.Strings[i]);
210         SelectByID(IntToStr(OldRec.ToService));
211       end;
212     cboPlace.SelectByID(OldRec.Place);
213     with cboUrgency do for i := 0 to Items.Count-1 do
214       if UpperCase(DisplayText[i]) = UpperCase(OldRec.UrgencyName) then ItemIndex := i;
215     SetUpEarliestDate;         //wat v28
216     if Not FProstheticsSvc then         //wat v28
217       begin
218         calEarliest.FMDateTime := OldRec.EarliestDate;
219         FEarliestDate := OldRec.EarliestDate;
220         //calLatest.FMDateTime := OldRec.LatestDate;
221         //FLatestDate := OldRec.LatestDate;
222       end;
223     txtProvDiag.Text := OldRec.ProvDiagnosis;
224     ProvDx.Code := OldRec.ProvDxCode;
225     if OldRec.ProvDxCodeInactive then
226      begin
227       InfoBox(TX_INACTIVE_CODE, TC_INACTIVE_CODE, MB_ICONWARNING or MB_OK);
228       ProvDx.CodeInactive := True;
229      end;
230     QuickCopy(OldRec.RequestReason, memReason);
231     memComment.Clear ;
232     btnCmtCancel.Enabled := (OldRec.DenyComments.Count > 0);
233     btnCmtOther.Enabled := (OldRec.OtherComments.Count > 0);
234     txtAttn.InitLongList(OldRec.AttnName) ;
235     if OldRec.Attention > 0 then
236       txtAttn.SelectByIEN(OldRec.Attention)
237     else
238       txtAttn.ItemIndex := -1;
239     SetProvDiagPromptingMode;
240     if (patient.CombatVet.IsEligible = True) then
241      begin
242       SetUpCombatVet;
243      end
244      else
245       begin
246         txtCombatVet.Enabled := False;
247         pnlCombatVet.SendToBack;
248       end;
249     FChanging := False;
250     StatusText('');
251   end;
252   
253   procedure TfrmEditCslt.Validate(var AnErrMsg: string);
254   
255     procedure SetError(const x: string);
256     begin
257       if Length(AnErrMsg) > 0 then AnErrMsg := AnErrMsg + CRLF;
258       AnErrMsg := AnErrMsg + x;
259     end;
260   
261   begin
262     inherited;
263     if cboService.ItemIEN = 0               then SetError(TX_NO_SVC);
264     if cboUrgency.ItemIEN = 0 then SetError(TX_NO_URGENCY);
265     if cboPlace.ItemID = '' then SetError(TX_NO_PLACE);
266     if memReason.Lines.Count = 0            then SetError(TX_NO_REASON);
267     with cboService do
268       begin
269         if Piece(Items[ItemIndex], U, 5) = '1' then SetError(TX_NOTTHISSVC_TEXT);
270         if (Piece(Items[ItemIndex],U,5) <> '1')
271            and (Piece(Items[ItemIndex], U, 6) = '')
272                                                 then SetError(TX_SVC_ERROR) ;
273       end;
274     if (ProvDx.Reqd = 'R') and (Length(txtProvDiag.Text) = 0) then
275       begin
276         if ProvDx.PromptMode = 'F' then
277           SetError(TX_NO_DIAG)
278         else
279           SetError(TX_SELECT_DIAG);
280       end;
281     if OldRec.ProvDxCodeInactive and ProvDx.CodeInactive then
282       SetError(TX_INACTIVE_CODE);
283     if Not FProstheticsSvc then     //wat v28
284       begin
285          if calEarliest.FMDateTime < FMToday     then SetError(TX_PAST_DATE);
286       end;
287   
288   end;
289   
290   procedure TfrmEditCslt.txtAttnNeedData(Sender: TObject;
291     const StartFrom: string; Direction, InsertAt: Integer);
292   begin
293     inherited;
294     txtAttn.ForDataUse(SubSetOfPersons(StartFrom, Direction));
295   end;
296   
297   procedure TfrmEditCslt.radInpatientClick(Sender: TObject);
298   begin
299     inherited;
300     cboUrgency.Items.Clear;
301     cboPlace.Items.Clear;
302     cboCategory.Items.Clear;
303     cboCategory.Items.Add('I^Inpatient');
304     cboCategory.SelectById('I');
305     ExtractItems(cboPlace.Items, Defaults, 'Inpt Place');
306     ExtractItems(cboUrgency.Items, Defaults, 'Inpt Cslt Urgencies');      //S.GMRCR
307     ControlChange(Self);
308   end;
309   
310   procedure TfrmEditCslt.radOutpatientClick(Sender: TObject);
311   begin
312     inherited;
313     cboUrgency.Items.Clear;
314     cboPlace.Items.Clear;
315     cboCategory.Items.Clear;
316     cboCategory.Items.Add('O^Outpatient');
317     cboCategory.SelectById('O');
318     ExtractItems(cboPlace.Items, Defaults, 'Outpt Place');
319     ExtractItems(cboUrgency.Items, Defaults, 'Outpt Urgencies');     //S.GMRCO
320     ControlChange(Self);
321   end;
322   
323   
324   procedure TfrmEditCslt.ControlChange(Sender: TObject);
325   begin
326     if FChanging then exit;
327     with NewRec do
328       begin
329         with cboService do if ItemIEN > 0 then
330           if ItemIEN <> OldRec.ToService then
331             begin
332               ToService     := ItemIEN;
333               ToServiceName := Text;
334             end
335           else
336             begin
337               ToService     := 0;
338               ToServiceName := '';
339             end;
340   
341        with cboCategory do if Length(ItemID) > 0 then
342          if ItemID <> OldRec.InpOutP then
343            InpOutP := ItemID
344          else
345            InpOutP := '';
346   
347        with cboUrgency do if ItemIEN > 0 then
348          if StrToIntDef(Piece(Items[ItemIndex], U, 3), 0) <> OldRec.Urgency then
349            begin
350              Urgency     := StrToIntDef(Piece(Items[ItemIndex], U, 3), 0);
351              UrgencyName := Text;
352            end
353          else
354            begin
355              Urgency     := 0;
356              UrgencyName := '';
357            end;
358   
359        if FEarliestDate > 0 then
360        begin
361          if FEarliestDate <> OldRec.EarliestDate then
362            EarliestDate := FEarliestDate
363          else
364            EarliestDate := 0;
365        end;
366   
367   (*     if FLatestDate > 0 then
368        begin
369          if FLatestDate <> OldRec.LatestDate then
370            LatestDate := FLatestDate
371          else
372            LatestDate := 0;
373        end;*)
374   
375        with cboPlace do if Length(ItemID) > 0 then
376          if ItemID <> OldRec.Place then
377            begin
378              Place     := ItemID;
379              PlaceName := Text;
380            end
381          else
382            begin
383              Place     := '';
384              PlaceName := '';
385            end;
386   
387        with txtAttn do
388          if ItemIEN > 0 then
389            begin
390              if ItemIEN <> OldRec.Attention then
391                begin
392                  Attention := ItemIEN;
393                  AttnName  := Text;
394                end
395              else
396                begin
397                  Attention := 0;
398                  AttnName  := '';
399                end;
400            end
401          else  // blank
402            begin
403              if OldRec.Attention > 0 then
404                begin
405                  Attention := -1;
406                  AttnName  := '';
407                end
408              else
409                begin
410                  Attention := 0;
411                  AttnName  := '';
412                end;
413            end;
414   
415        with txtProvDiag do
416          if Length(Text) > 0 then
417            begin
418              if Text <> OldRec.ProvDiagnosis then
419                ProvDiagnosis := Text
420              else
421                ProvDiagnosis := '';
422   
423              if ProvDx.Code <> OldRec.ProvDxCode then
424                ProvDxCode := ProvDx.Code
425              else
426                ProvDxCode := '';
427   
428              if OldRec.ProvDxCodeInactive then
429                ProvDx.CodeInactive := (ProvDx.Code = OldRec.ProvDxCode);
430            end
431          else  //blank
432            begin
433              ProvDx.Code := '';
434              ProvDx.CodeInactive := False;
435              if OldRec.ProvDiagnosis <> '' then
436                ProvDiagnosis := '@'
437              else
438                ProvDiagnosis := '';
439            end;
440   
441        with memReason do if Lines.Count > 0 then
442           if Lines.Equals(OldRec.RequestReason) then
443             RequestReason.Clear
444           else
445             QuickCopy(memReason, RequestReason);
446   
447         with memComment do
448           if GetTextLen > 0 then
449             QuickCopy(memComment, NewComments)
450           else
451             NewComments.Clear;
452       end;
453   end;
454   
455   procedure TfrmEditCslt.FormClose(Sender: TObject; var Action: TCloseAction);
456   const
457     TX_ACCEPT = 'Resubmit this request?' + CRLF + CRLF;
458     TX_ACCEPT_CAP = 'Unsaved Changes';
459   begin
460     if FChanged then
461       if InfoBox(TX_ACCEPT, TX_ACCEPT_CAP, MB_YESNO) = ID_YES then
462         if not ValidSave then Action := caNone;
463   end;
464   
465   procedure TfrmEditCslt.calEarliestExit(Sender: TObject);
466   begin
467     inherited;
468     FEarliestDate := calEarliest.FMDateTime;
469     ControlChange(Self);
470   end;
471   
472   procedure TfrmEditCslt.calLatestExit(Sender: TObject);
473   begin
474     inherited;
475     //FLatestDate := calLatest.FMDateTime;
476     //ControlChange(Self);
477   end;
478   
479   procedure TfrmEditCslt.cmdAcceptClick(Sender: TObject);
480   {Begin BillingAware}
481   var
482     BADiagnosis: string;
483     //newDxRec: TBADxRecord;
484     //AnOrder: TOrder;
485   {End BillingAware}
486   begin
487   
488   {Begin BillingAware}
489     if  BILLING_AWARE then
490     begin
491        if BADxUpdated then
492        begin
493           BADiagnosis := ProvDx.Text + '^' + ProvDx.Code;
494           UBAGlobals.Dx1 := BADiagnosis;  //  add selected dx to BA Dx List.
495           UBAGlobals.SimpleAddTempDxList(UBAGlobals.BAOrderID);
496        end;
497     end;
498   {End BillingAware}
499   
500     if ValidSave then
501       begin
502         FChanged := (ResubmitConsult(NewRec) = '0');
503         Close;
504       end;
505   end;
506   
507   procedure TfrmEditCslt.memReasonExit(Sender: TObject);
508   var
509     AStringList: TStringList;
510   begin
511     inherited;
512     AStringList := TStringList.Create;
513     try
514       //QuickCopy(memReason, AStringList);
515       AStringList.Text := memReason.Text;
516       LimitStringLength(AStringList, 74);
517       //QuickCopy(AstringList, memReason);
518       memReason.Text := AStringList.Text;
519       ControlChange(Self);
520     finally
521       AStringList.Free;
522     end;
523   end;
524   
525   procedure TfrmEditCslt.cmdQuitClick(Sender: TObject);
526   begin
527     inherited;
528     FChanged := False;
529     Close;
530   end;
531   
532   function TfrmEditCslt.ValidSave: Boolean;
533   const
534     TX_NO_SAVE     = 'This request cannot be saved for the following reason(s):' + CRLF + CRLF;
535     TX_NO_SAVE_CAP = 'Unable to Save Request';
536     TX_SAVE_ERR    = 'Unexpected error - it was not possible to save this request.';
537   var
538     ErrMsg: string;
539   begin
540     Result := True;
541     Validate(ErrMsg);
542     if Length(ErrMsg) > 0 then
543     begin
544       InfoBox(TX_NO_SAVE + ErrMsg, TX_NO_SAVE_CAP, MB_OK);
545       Result := False;
546     end;
547     if (ProvDx.Reqd = 'R') and (Length(txtProvDiag.Text) = 0) and (ProvDx.PromptMode = 'L') then
548       cmdLexSearchClick(Self);
549   end;
550   
551   procedure TfrmEditCslt.SetUpCombatVet;
552   begin
553     pnlCombatVet.BringToFront;
554     txtCombatVet.Enabled := True;
555     txtCombatVet.Caption := 'Combat Veteran Eligibility Expires on ' + patient.CombatVet.ExpirationDate;
556     pnlMain.Top := pnlMain.Top + pnlCombatVet.Height;
557     pnlMain.Anchors := [akLeft, akTop, akRight];
558     self.Height := self.Height + pnlCombatVet.Height;
559     pnlMain.Anchors := [akLeft, akTop, akRight, akBottom];
560     ActiveControl := txtCombatVet;
561   end;
562   
563   
564   procedure TfrmEditCslt.OrderMessage(const AMessage: string);
565   begin
566     memMessage.Lines.SetText(PChar(AMessage));
567     if ContainsVisibleChar(AMessage) then
568     begin
569       pnlMessage.Visible := True;
570       pnlMessage.BringToFront;
571       uMessageVisible := GetTickCount;
572     end
573     else pnlMessage.Visible := False;
574   end;
575   
576   procedure TfrmEditCslt.btnCmtCancelClick(Sender: TObject);
577   begin
578     ReportBox(OldRec.DenyComments, 'Cancellation Comments', False);
579   end;
580   
581   procedure TfrmEditCslt.btnCmtOtherClick(Sender: TObject);
582   begin
583     ReportBox(OldRec.OtherComments, 'Added Comments', False);
584   end;
585   
586   procedure TfrmEditCslt.cmdLexSearchClick(Sender: TObject);
587   var
588     Match: string;
589     i: integer;
590   begin
591     inherited;
592   {Begin BillingAware}
593     if  BILLING_AWARE then BADxUpdated := FALSE;
594   {End BillingAware}
595     LexiconLookup(Match, LX_ICD);
596     if Match = '' then Exit;
597     ProvDx.Code := Piece(Match, U, 1);
598     ProvDx.Text := Piece(Match, U, 2);
599     i := Pos(' (ICD', ProvDx.Text);
600     if i = 0 then i := Length(ProvDx.Text) + 1;
601     if ProvDx.Text[i-1] = '*' then i := i - 2;
602     ProvDx.Text := Copy(ProvDx.Text, 1, i - 1);
603     txtProvDiag.Text := ProvDx.Text + ' (' + ProvDx.Code + ')';
604   {Begin BillingAware}
605     if  BILLING_AWARE then BADxUpdated := TRUE;
606   {End BillingAware}
607     ProvDx.CodeInactive := False;
608   end;
609   
610   procedure TfrmEditCslt.SetProvDiagPromptingMode;
611   const
612     TX_USE_LEXICON = 'You must use the "Lexicon" button to select a provisional diagnosis for this service.';
613     TX_PROVDX_OPT  = 'Provisional Diagnosis';
614     TX_PROVDX_REQD = 'Provisional Dx (REQUIRED)';
615   begin
616     cmdLexSearch.Enabled   := False;
617     txtProvDiag.Enabled    := False;
618     txtProvDiag.ReadOnly   := True;
619     txtProvDiag.Color      := clBtnFace;
620     txtProvDiag.Font.Color := clBtnText;
621     lblProvDiag.Enabled    := False;
622     txtProvDiag.Hint       := '';
623     if cboService.ItemIEN = 0 then Exit;
624     GetProvDxMode(ProvDx, cboService.ItemID + CSLT_PTR);
625     //  Returns:  string  A^B
626     //     A = O (optional), R (required) or S (suppress)
627     //     B = F (free-text) or L (lexicon)
628     with ProvDx do if (Reqd = '') or (PromptMode = '') then Exit;
629     if ProvDx.Reqd = 'R' then
630       lblProvDiag.Caption := TX_PROVDX_REQD
631     else
632       lblProvDiag.Caption := TX_PROVDX_OPT;
633     if ProvDx.Reqd = 'S' then
634       begin
635         cmdLexSearch.Enabled   := False;
636         txtProvDiag.Enabled    := False;
637         txtProvDiag.ReadOnly   := True;
638         txtProvDiag.Color      := clBtnFace;
639         txtProvDiag.Font.Color := clBtnText;
640         lblProvDiag.Enabled    := False;
641       end
642     else
643       case ProvDx.PromptMode[1] of
644         'F':  begin
645                 cmdLexSearch.Enabled   := False;
646                 txtProvDiag.Enabled    := True;
647                 txtProvDiag.ReadOnly   := False;
648                 txtProvDiag.Color      := clWindow;
649                 txtProvDiag.Font.Color := clWindowText;
650                 lblProvDiag.Enabled    := True;
651               end;
652         'L':  begin
653                 cmdLexSearch.Enabled   := True;
654                 txtProvDiag.Enabled    := True;
655                 txtProvDiag.ReadOnly   := True;
656                 txtProvDiag.Color      := clInfoBk;
657                 txtProvDiag.Font.Color := clInfoText;
658                 lblProvDiag.Enabled    := True;
659                 txtProvDiag.Hint       := TX_USE_LEXICON;
660               end;
661       end;
662   end;
663   
664   procedure TfrmEditCslt.mnuPopProvDxDeleteClick(Sender: TObject);
665   begin
666     inherited;
667     ProvDx.Text := '';
668     ProvDx.Code := '';
669     ProvDx.CodeInactive := False;
670     txtProvDiag.Text := '';
671     ControlChange(Self);
672   end;
673   
674   procedure TfrmEditCslt.popReasonPopup(Sender: TObject);
675   begin
676     inherited;
677     if PopupComponent(Sender, popReason) is TCustomEdit
678       then FEditCtrl := TCustomEdit(PopupComponent(Sender, popReason))
679       else FEditCtrl := nil;
680     if FEditCtrl <> nil then
681     begin
682       popReasonCut.Enabled      := FEditCtrl.SelLength > 0;
683       popReasonCopy.Enabled     := popReasonCut.Enabled;
684       popReasonPaste.Enabled    := (not TORExposedCustomEdit(FEditCtrl).ReadOnly) and
685                                      Clipboard.HasFormat(CF_TEXT);
686     end else
687     begin
688       popReasonCut.Enabled      := False;
689       popReasonCopy.Enabled     := False;
690       popReasonPaste.Enabled    := False;
691     end;
692     popReasonReformat.Enabled := True;
693   end;
694   
695   procedure TfrmEditCslt.popReasonCutClick(Sender: TObject);
696   begin
697     inherited;
698     FEditCtrl.CutToClipboard;
699   end;
700   
701   procedure TfrmEditCslt.popReasonCopyClick(Sender: TObject);
702   begin
703     inherited;
704     FEditCtrl.CopyToClipboard;
705   end;
706   
707   procedure TfrmEditCslt.popReasonPasteClick(Sender: TObject);
708   begin
709     inherited;
710     FEditCtrl.SelText := Clipboard.AsText;
711   end;
712   
713   procedure TfrmEditCslt.popReasonReformatClick(Sender: TObject);
714   begin
715     inherited;
716     if (Screen.ActiveControl <> memReason) and
717        (Screen.ActiveControl <> memComment)then Exit;
718     ReformatMemoParagraph(TCustomMemo(FEditCtrl));
719   end;
720   
721   procedure TfrmEditCslt.memCommentKeyUp(Sender: TObject; var Key: Word;
722     Shift: TShiftState);
723   begin
724     if FNavigatingTab then
725     begin
726       if ssShift in Shift then
727         FindNextControl(Sender as TWinControl, False, True, False).SetFocus //previous control
728       else if ssCtrl	in Shift then
729         FindNextControl(Sender as TWinControl, True, True, False).SetFocus; //next control
730       FNavigatingTab := False;
731     end;
732     if (key = VK_ESCAPE) then begin
733       FindNextControl(Sender as TWinControl, False, True, False).SetFocus; //previous control
734       key := 0;
735     end;
736   end;
737   
738   procedure TfrmEditCslt.memCommentExit(Sender: TObject);
739   //added OnExit code for CQ17822 WAT
740   var
741     AStringList: TStringList;
742   begin
743     inherited;
744     AStringList := TStringList.Create;
745     try
746       //QuickCopy(memComment, AStringList);
747       AStringList.Text := memComment.Text;
748       LimitStringLength(AStringList, 74);
749       //QuickCopy(AstringList, memComment);
750       memComment.Text := AStringList.Text;
751       ControlChange(Self);   
752     finally
753       AStringList.Free;
754     end;
755   end;
756   
757   procedure TfrmEditCslt.memCommentKeyDown(Sender: TObject; var Key: Word;
758     Shift: TShiftState);
759   begin
760     //The navigating tab controls were inadvertantently adding tab characters
761     //This should fix it
762     FNavigatingTab := (Key = VK_TAB) and ([ssShift,ssCtrl] * Shift <> []);
763     if FNavigatingTab then
764       Key := 0;
765   end;
766   
767   procedure TfrmEditCslt.memCommentKeyPress(Sender: TObject; var Key: Char);
768   begin
769     if FNavigatingTab then
770       Key := #0;  //Disable shift-tab processin
771   end;
772   
773   procedure TfrmEditCslt.SetUpEarliestDate;  //wat v28
774   begin
775     if IsProstheticsService(cboService.ItemIEN) = '1' then
776       begin
777         lblEarliest.Enabled := False;
778         calEarliest.Enabled := False;
779         calEarliest.Text := '';
780         FProstheticsSvc := true;
781       end
782     else
783       begin
784         lblEarliest.Enabled := True;
785         calEarliest.Enabled := True;
786         FProstheticsSvc := false;
787       end;
788   end;
789   
790   end.

Module Calls (2 levels)


fEditConsult
 ├uConsults
 │ └uConst
 ├fAutoSz
 │ └fBase508Form
 ├fBase508Form...
 ├rConsults
 │ ├rCore
 │ ├uCore
 │ ├uConsults...
 │ └uTIU
 ├uCore...
 ├rCore...
 ├fRptBox
 │ ├fFrame
 │ ├fBase508Form...
 │ ├uReports
 │ └rReports
 ├fPCELex
 │ ├uCore...
 │ ├fBase508Form...
 │ ├mTreeGrid
 │ ├rPCE
 │ ├uProbs
 │ ├rProbs
 │ └UBAGlobals
 ├rPCE...
 └UBAGlobals...

Module Called-By (2 levels)


       fEditConsult
        fConsults┘ 
         fFrame┤   
         fNotes┤   
     fPrintList┤   
fReminderDialog┤   
        fReview┤   
       fSurgery┤   
    fConsultAct┤   
      fCsltNote┘