Module

fEditProc

Path

C:\CPRS\CPRS30\Consults\fEditProc.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 -
rPCE -
uCore -

Classes

Name Comments
TfrmEditProc -

Procedures

Name Owner Declaration Scope Comments
btnCmtCancelClick TfrmEditProc procedure btnCmtCancelClick(Sender: TObject); Public/Published -
btnCmtOtherClick TfrmEditProc procedure btnCmtOtherClick(Sender: TObject); Public/Published -
calEarliestExit TfrmEditProc procedure calEarliestExit(Sender: TObject); Public/Published -
calLatestExit TfrmEditProc procedure calLatestExit(Sender: TObject); Public/Published -
cboProcNeedData TfrmEditProc procedure cboProcNeedData(Sender: TObject; const StartFrom: String; Direction, InsertAt: Integer); Public/Published -
cboProcSelect TfrmEditProc procedure cboProcSelect(Sender: TObject); Public/Published -
cmdAcceptClick TfrmEditProc procedure cmdAcceptClick(Sender: TObject); Public/Published -
cmdLexSearchClick TfrmEditProc procedure cmdLexSearchClick(Sender: TObject); Public/Published -
cmdQuitClick TfrmEditProc procedure cmdQuitClick(Sender: TObject); Public/Published -
ControlChange TfrmEditProc procedure ControlChange(Sender: TObject); Public/Published -
FormClose TfrmEditProc procedure FormClose(Sender: TObject; var Action: TCloseAction); Public/Published -
InitDialog TfrmEditProc procedure InitDialog; Protected -
memCommentExit TfrmEditProc procedure memCommentExit(Sender: TObject); Public/Published Added OnExit code for CQ17822 WAT
memCommentKeyUp TfrmEditProc procedure memCommentKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); Public/Published -
memReasonExit TfrmEditProc procedure memReasonExit(Sender: TObject); Public/Published -
memReasonKeyDown TfrmEditProc procedure memReasonKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); Public/Published -
memReasonKeyPress TfrmEditProc procedure memReasonKeyPress(Sender: TObject; var Key: Char); Public/Published -
mnuPopProvDxDeleteClick TfrmEditProc procedure mnuPopProvDxDeleteClick(Sender: TObject); Public/Published -
OrderMessage TfrmEditProc procedure OrderMessage(const AMessage: string); Public/Published -
popReasonCopyClick TfrmEditProc procedure popReasonCopyClick(Sender: TObject); Public/Published -
popReasonCutClick TfrmEditProc procedure popReasonCutClick(Sender: TObject); Public/Published -
popReasonPasteClick TfrmEditProc procedure popReasonPasteClick(Sender: TObject); Public/Published -
popReasonPopup TfrmEditProc procedure popReasonPopup(Sender: TObject); Public/Published -
popReasonReformatClick TfrmEditProc procedure popReasonReformatClick(Sender: TObject); Public/Published -
radInpatientClick TfrmEditProc procedure radInpatientClick(Sender: TObject); Public/Published -
radOutpatientClick TfrmEditProc procedure radOutpatientClick(Sender: TObject); Public/Published -
SetError - procedure SetError(const x: string); Local -
SetProvDiagPromptingMode TfrmEditProc procedure SetProvDiagPromptingMode; Private -
SetUpCombatVet TfrmEditProc procedure SetUpCombatVet; Private -
txtAttnNeedData TfrmEditProc procedure txtAttnNeedData(Sender: TObject; const StartFrom: String; Direction, InsertAt: Integer); Public/Published -
Validate TfrmEditProc procedure Validate(var AnErrMsg: string); Protected -

Functions

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

Global Variables

Name Type Declaration Comments
Defaults TStringList Defaults: TStringList; -
frmEditProc TfrmEditProc frmEditProc: TfrmEditProc; -
NewRec OldRec, NewRec: TEditResubmitRec; -
OldRec OldRec, NewRec: TEditResubmitRec; -
ProvDx ProvDx: TProvisionalDiagnosis; -
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_PROC 'A procedure must be specified.' Global -
TX_NO_REASON 'A reason for this procedure must be entered.' Global -
TX_NO_SERVICE 'A service must be selected to perform this procedure.' Global -
TX_NO_URGENCY 'An urgency must be specified.' 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 -


Module Source

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

Module Calls (2 levels)


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

Module Called-By (2 levels)


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