Module

fConsultAct

Path

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

Last Modified

7/15/2014 3:26:34 PM

Initialization Code

initialization
   SvcList := TStringList.Create ;

Finalization Code

finalization
   SvcList.Free ;


end.

Units Used in Interface

Name Comments
fBase508Form -
uCore -

Units Used in Implementation

Name Comments
fConsultAlertTo -
fConsults -
rConsults -
rCore -
rOrders -
uConsults -

Classes

Name Comments
TfrmConsultAction -

Procedures

Name Owner Declaration Scope Comments
cboServiceSelect TfrmConsultAction procedure cboServiceSelect(Sender: TObject); {**REV**} Public/Published REV**
ckAlertClick TfrmConsultAction procedure ckAlertClick(Sender: TObject); Public/Published -
cmdCancelClick TfrmConsultAction procedure cmdCancelClick(Sender: TObject); Public/Published -
cmdOKClick TfrmConsultAction procedure cmdOKClick(Sender: TObject); Public/Published -
NewPersonNeedData TfrmConsultAction procedure NewPersonNeedData(Sender: TObject; const StartFrom: string; Direction, InsertAt: Integer); Public/Published ============================= Control events ================================
ProviderNeedData TfrmConsultAction procedure ProviderNeedData(Sender: TObject; const StartFrom: string; Direction, InsertAt: Integer); Public/Published -
SetupAddComment TfrmConsultAction procedure SetupAddComment; Private -
SetupAdminComplete TfrmConsultAction procedure SetupAdminComplete; Private -
SetupOther TfrmConsultAction procedure SetupOther; Private -
SetupReceive TfrmConsultAction procedure SetupReceive; Private -
SetupSchedule TfrmConsultAction procedure SetupSchedule; Private -
SetupSigFindings TfrmConsultAction procedure SetupSigFindings; Private -
ShowAutoAlertText TfrmConsultAction procedure ShowAutoAlertText; Private
Procedure TfrmConsultAction.ShowAutoAlertText;      ****  SEE BELOW FOR REPLACEMENT - v27.9 Phelps/Vertigan
const
  TX_ALERT1          = 'An alert will automatically be sent to ';
  TX_ALERT_PROVIDER  = 'the ordering provider';
  TX_ALERT_SVC_USERS = 'notification recipients for this service.';
  TX_ALERT_NOBODY    = 'No automatic alerts will be sent.';  // this should be rare to never
var
  x: string;
begin
  case FUserLevel of
     UL_NONE, UL_REVIEW:
       begin
         if FUserIsRequester then
           x := TX_ALERT1 + TX_ALERT_SVC_USERS
         else
           x := TX_ALERT1 + TX_ALERT_PROVIDER + ' and to ' + TX_ALERT_SVC_USERS;
       end;
     UL_UPDATE, UL_ADMIN, UL_UPDATE_AND_ADMIN:
       begin
         if FUserIsRequester then
           x := TX_ALERT_NOBODY
         else
           x := TX_ALERT1 + TX_ALERT_PROVIDER + '.';
       end;
   end;
   lblAutoAlerts.Caption := x;
end;
SigFindPanelShow TfrmConsultAction procedure SigFindPanelShow; Private -
treServiceChange TfrmConsultAction procedure treServiceChange(Sender: TObject; Node: TTreeNode); Public/Published -
treServiceExit TfrmConsultAction procedure treServiceExit(Sender: TObject); Public/Published -

Functions

Name Owner Declaration Scope Comments
SetActionContext - function SetActionContext(FontSize: Integer; ActionCode: integer; IsProcedure: boolean; ProcID: string; UserLevel: integer): boolean; Interfaced Displays action input form for consults and sets up broker calls
SetupForward TfrmConsultAction function SetupForward(IsProcedure: boolean; ProcIEN: integer): boolean; Private =================== Setup form for different actions ===========================

Global Variables

Name Type Declaration Comments
frmConsultAction TfrmConsultAction frmConsultAction: TfrmConsultAction; -
RecipientList RecipientList: TRecipientList ; -
SvcList TStrings SvcList: TStrings ; -
uChanging Boolean uChanging: Boolean; -

Constants

Name Declaration Scope Comments
TX_COMMENTS_CAP 'No comments entered' Interfaced -
TX_COMMENTS_TEXT 'Comments are required for this action.' Interfaced -
TX_DATE_CAP 'Invalid date' Interfaced -
TX_DATE_TEXT 'Enter a valid date for this action.' Interfaced -
TX_FUTDATE_TEXT 'Dates or times in the future are not allowed.' Interfaced -
TX_FWD_NO_CSLT_SVCS_TEXT 'There are no services that you can forward this consult to' Interfaced -
TX_FWD_NO_PROC_SVCS_TEXT 'There are no additional services that can perform this procedure.' Interfaced -
TX_NOFORWARD_CAP 'Unable to forward' Interfaced -
TX_NOFORWARD_SELF 'A consult cannot be forwarded to the same service already responsible.' Interfaced -
TX_NOFORWARD_TEXT 'Service must be specified.' Interfaced -
TX_NOTTHISSVC_TEXT 'Consults cannot be forwarded to this service. Please select a subspecialty' Interfaced -
TX_NOURGENCY_TEXT 'Urgency must be specified' Interfaced -
TX_PERSON_CAP 'Missing person' Interfaced -
TX_PERSON_TEXT 'Select a person to perform this action or press Cancel.' Interfaced -
TX_SIGFIND_CAP 'No significant findings status entered' Interfaced -
TX_SIGFIND_TEXT 'A significant findings selection is required.' Interfaced -


Module Source

1     unit fConsultAct;
2     
3     interface
4     
5     uses
6       Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ORFN,
7       StdCtrls, ExtCtrls, ORCtrls, uCore, ComCtrls, ORDtTm, fBase508Form,
8       VA508AccessibilityManager;
9     
10    type
11      TfrmConsultAction = class(TfrmBase508Form)
12        lblActionBy: TOROffsetLabel;
13        calDateofAction: TORDateBox;
14        lblDateofAction: TOROffsetLabel;
15        cboPerson: TORComboBox;
16        memComments: TCaptionMemo;
17        lblComments: TOROffsetLabel;
18        lblToService: TOROffsetLabel;
19        cboAttentionOf: TORComboBox;
20        lblAttentionOf: TOROffsetLabel;
21        lblUrgency: TOROffsetLabel;
22        cmdOK: TORAlignButton;
23        cmdCancel: TORAlignButton;
24        cboUrgency: TORComboBox;
25        pnlBase: TPanel;
26        pnlForward: TPanel;
27        pnlOther: TPanel;
28        treService: TORTreeView;
29        pnlComments: TPanel;
30        pnlAllActions: TPanel;
31        grpSigFindings: TRadioGroup;
32        pnlSigFind: TPanel;
33        cboService: TORComboBox;
34        pnlAlert: TPanel;
35        ckAlert: TCheckBox;
36        Label1: TMemo;
37        lblAutoAlerts: TStaticText;
38        procedure cmdCancelClick(Sender: TObject);
39        procedure cmdOKClick(Sender: TObject);
40        procedure NewPersonNeedData(Sender: TObject; const StartFrom: string;
41          Direction, InsertAt: Integer);
42        procedure ProviderNeedData(Sender: TObject; const StartFrom: string;
43          Direction, InsertAt: Integer);
44        procedure ckAlertClick(Sender: TObject);
45        procedure treServiceChange(Sender: TObject; Node: TTreeNode);
46        procedure treServiceExit(Sender: TObject);
47        procedure cboServiceSelect(Sender: TObject);           {**REV**}
48      private
49         FActionType: integer ;
50         FChanged: boolean ;
51         FActionBy: Int64;
52         FActionDate: TFMDateTime;
53         FToService: integer ;
54         FAttentionOf: int64 ;
55         FUrgency: integer ;
56         FSigFind: string;
57         FComments: TStrings ;
58         FAlert: integer ;
59         FAlertTo: string ;
60         FIsProcedure: boolean;
61         FProcIEN: integer;
62         FUserLevel: integer;
63         FUserIsRequester: boolean;
64         function SetupForward(IsProcedure: boolean; ProcIEN: integer): boolean;
65         procedure SetupAddComment;
66         procedure SetupAdminComplete;
67         procedure SetupSigFindings;
68         procedure SigFindPanelShow;
69         procedure SetupReceive;
70         procedure SetupSchedule;
71         procedure SetupOther;
72         procedure ShowAutoAlertText;
73      end;
74    
75    function SetActionContext(FontSize: Integer; ActionCode: integer; IsProcedure: boolean; ProcID: string; UserLevel: integer): boolean;
76    
77    var
78      frmConsultAction: TfrmConsultAction;
79      SvcList: TStrings ;
80      uChanging: Boolean;
81    
82    const
83      TX_FWD_NO_CSLT_SVCS_TEXT = 'There are no services that you can forward this consult to' ;
84      TX_FWD_NO_PROC_SVCS_TEXT = 'There are no additional services that can perform this procedure.' ;
85      TX_NOTTHISSVC_TEXT = 'Consults cannot be forwarded to this service. Please select a subspecialty' ;
86      TX_NOFORWARD_TEXT  = 'Service must be specified.' ;
87      TX_NOFORWARD_SELF  = 'A consult cannot be forwarded to the same service already responsible.';
88      TX_NOFORWARD_CAP   = 'Unable to forward' ;
89      TX_NOURGENCY_TEXT  = 'Urgency must be specified';
90      TX_PERSON_TEXT     = 'Select a person to perform this action or press Cancel.';
91      TX_PERSON_CAP      = 'Missing person';
92      TX_DATE_TEXT       = 'Enter a valid date for this action.' ;
93      TX_DATE_CAP        = 'Invalid date' ;
94      TX_FUTDATE_TEXT    = 'Dates or times in the future are not allowed.';
95      TX_COMMENTS_TEXT   = 'Comments are required for this action.' ;
96      TX_COMMENTS_CAP    = 'No comments entered' ;
97      TX_SIGFIND_TEXT    = 'A significant findings selection is required.' ;
98      TX_SIGFIND_CAP     = 'No significant findings status entered' ;
99    
100   implementation
101   
102   {$R *.DFM}
103   
104   uses rCore, rConsults, uConsults, fConsults, fConsultAlertTo, rOrders;
105   
106   var
107     RecipientList: TRecipientList ;
108   
109   function SetActionContext(FontSize: Integer; ActionCode: integer; IsProcedure: boolean; ProcID: string; UserLevel: integer): boolean;
110   { displays action input form for consults and sets up broker calls }
111   begin
112     Result := False;
113     frmConsultAction := TfrmConsultAction.Create(Application);
114     try
115       ResizeAnchoredFormToFont(frmConsultAction);
116       with frmConsultAction do
117        begin
118         //I wish I knew why the resize wasn't working on the buttons
119         cmdCancel.Left := pnlAllActions.ClientWidth - cmdCancel.Width -7;
120         cmdOK.Left := cmdCancel.Left - cmdOK.Width - 10;
121         FChanged     := False;
122         FActionType  := ActionCode ;
123         FIsProcedure := IsProcedure;
124         FProcIEN     := StrToIntDef(Piece(ProcID, ';', 1), 0);
125         FUserLevel   := UserLevel;
126         FUserIsRequester := (User.DUZ = ConsultRec.SendingProvider);
127         Caption      := ActionType[ActionCode] ;
128         RecipientList.Recipients    := '' ;
129         RecipientList.Changed       := False ;
130   
131         case FActionType of
132           CN_ACT_FORWARD:         if not SetupForward(FIsProcedure, FProcIEN) then exit;
133           CN_ACT_ADD_CMT:         SetupAddComment;
134           CN_ACT_ADMIN_COMPLETE:  SetupAdminComplete;
135           CN_ACT_SIGFIND:         SetupSigFindings;
136           CN_ACT_RECEIVE:         SetupReceive;
137           CN_ACT_SCHEDULE:        SetupSchedule;
138         else                      SetupOther;
139         end;
140   
141         ShowModal ;
142         Result := FChanged ;
143        end ;
144     finally
145       frmConsultAction.Release;
146     end;
147   end;
148   
149   //=================== Setup form for different actions ===========================
150   
151   function TfrmConsultAction.SetupForward(IsProcedure: boolean; ProcIEN: integer): boolean;
152   var
153     i: integer;
154     OrdItmIEN: integer;
155     attention: string;                                                              //wat cq 15561
156     AList: TStringList;                                                             {WAT cq 19626}
157   begin
158    pnlSigFind.Visible := False;
159    with frmConsultAction do Height := Height - pnlSigFind.Height;
160    pnlComments.Visible := True;
161    memComments.Clear;
162    AList := TStringList.Create;
163   try                                                                               {WAT cq 19626}
164    if IsProcedure then
165      begin
166        OrdItmIEN := GetOrderableIen(IntToStr(ConsultRec.ORFileNumber));
167        FastAssign(GetProcedureServices(OrdItmIEN), SvcList);
168        //FastAssign(GetProcedureServices(ProcIEN), SvcList);   RPC expects pointer to 101.43, NOT 123.3  (RV)
169        i := SvcList.IndexOf(IntToStr(ConsultRec.ToService) + U + Trim(ExternalName(ConsultRec.ToService, 123.5)));
170        if i > -1 then SvcList.Delete(i);
171        treService.Visible := False;
172      end
173    else
174      FastAssign(LoadServiceListWithSynonyms(CN_SVC_LIST_FWD, ConsultRec.IEN), SvcList);           {RV}
175    if (IsProcedure and (SvcList.Count <= 0)) then
176      begin
177        InfoBox(TX_FWD_NO_PROC_SVCS_TEXT, TX_NOFORWARD_CAP, MB_OK or MB_ICONWARNING);
178        Result := False  ;
179        Exit ;
180      end
181    else if ((not IsProcedure) and (Piece(SvcList.Strings[0],U,1) = '-1')) then
182      begin
183        InfoBox(TX_FWD_NO_CSLT_SVCS_TEXT, TX_NOFORWARD_CAP, MB_OK or MB_ICONWARNING);
184        Result := False  ;
185        Exit ;
186      end
187    else
188      begin
189        FastAssign(SvcList, AList);                                                  {WAT cq 19626}
190        SortByPiece(AList, U, 2);                                                    {WAT cq 19626}
191        //SortByPiece(TStringList(SvcList), U, 2);                                   {RV}
192        for i := 0 to SvcList.Count - 1 do
193           if (cboService.Items.IndexOf(Trim(Piece(SvcList.Strings[i], U, 2))) = -1) and   {RV}
194             (Piece(SvcList.Strings[i], U, 5) <> '1') then
195            cboService.Items.Add(SvcList.Strings[i]);
196        if not IsProcedure then
197          begin
198            BuildServiceTree(treService, SvcList, '0', nil) ;
199            with treService do
200              for i:=0 to Items.Count-1 do
201                begin
202                  if Items[i].Level > 0 then Items[i].Expanded := False
203                    else Items[i].Expanded := True;
204                  TopItem := Items[0] ;
205                  Selected := Items[0] ;
206                end ;
207          end;
208        pnlForward.Visible := True ;
209      end ;
210    if cboService.Items.Count = 1 then cboService.ItemIndex := 0;
211    FToService := cboService.ItemIEN;
212    //wat cq 15561
213    //cboAttentionOf.InitLongList('') ;
214    FAttentionOf := ConsultRec.Attention;
215    attention := ExternalName(FAttentionOf,200);
216    cboAttentionOf.InitLongList(attention);
217    cboAttentionOf.SelectByIEN(FAttentionOf);
218    //end cq 15561
219    with cboUrgency do
220     begin
221       FastAssign(SubSetOfUrgencies(ConsultRec.IEN), cboUrgency.Items) ;
222       MixedCaseList(Items) ;
223       SelectByIEN(ConsultRec.Urgency);
224       if ItemIndex = -1 then
225         begin
226           for i := 0 to Items.Count-1 do
227             if DisplayText[i] = 'Routine' then break ;
228           ItemIndex := i ;
229         end;
230     end ;
231     FUrgency := cboUrgency.ItemIEN;
232     //lblActionBy.Caption := 'Responsible Clinician';  //  v20.1 RV
233     //cboPerson.OnNeedData := ProviderNeedData;        //
234     lblActionBy.Caption := 'Responsible Person';       //
235     cboPerson.Caption := lblActionBy.Caption;
236     cboPerson.OnNeedData := NewPersonNeedData;         //
237     cboPerson.InitLongList(User.Name)  ;
238     cboPerson.SelectByIEN(User.DUZ);
239     ckAlert.Visible := False ;
240     lblAutoAlerts.Visible := False;
241     Result := True;
242   finally
243     AList.Free;                                                                      {WAT cq 19626}
244   end;
245   end;
246   
247   procedure TfrmConsultAction.SetupAddComment;
248   begin
249     pnlForward.Visible := False ;
250     //with frmConsultAction do Width := Width - pnlForward.Width ;
251     pnlSigFind.Visible := False;
252     with frmConsultAction do Height := Height - pnlSigFind.Height;
253     ckAlert.Visible             := True ;
254     lblAutoAlerts.Visible       := True;
255     ShowAutoAlertText;
256   (*  RecipientList.Recipients    := '' ;
257     RecipientList.Changed       := False ;*)
258     lblActionBy.Visible         := False ;
259     cboPerson.Visible           := False ;
260     pnlComments.Visible := True;
261     memComments.Clear;
262     ActiveControl := memComments ;
263   end;
264   
265   procedure TfrmConsultAction.SetupSchedule;
266   begin
267     pnlForward.Visible := False ;
268     //with frmConsultAction do Width := Width - pnlForward.Width ;
269     pnlSigFind.Visible := False;
270     with frmConsultAction do Height := Height - pnlSigFind.Height;
271     ckAlert.Visible             := True ;
272     lblAutoAlerts.Visible       := True;
273     ShowAutoAlertText;
274   (*  RecipientList.Recipients    := '' ;
275     RecipientList.Changed       := False ;*)
276     lblActionBy.Visible         := True ;
277     cboPerson.Visible           := True ;
278     lblActionBy.Caption := 'Responsible Person';
279     cboPerson.Caption := lblActionBy.Caption;
280     cboPerson.OnNeedData := NewPersonNeedData;
281     cboPerson.InitLongList(User.Name)  ;
282     cboPerson.SelectByIEN(User.DUZ);
283     pnlComments.Visible := True;
284     memComments.Clear;
285     ActiveControl := memComments ;
286   end;
287   
288   procedure TfrmConsultAction.SetupAdminComplete;
289   begin
290     SigFindPanelShow ;
291     pnlForward.Visible := False ;
292     //with frmConsultAction do Width := Width - pnlForward.Width ;
293     ckAlert.Visible             := False ;
294     lblAutoAlerts.Visible       := False;
295   
296     //lblActionBy.Caption := 'Responsible Provider';
297     //cboPerson.OnNeedData := ProviderNeedData;   //RIC-0100-21228 - need ALL users here
298     //cboPerson.InitLongList('')  ;
299     //cboPerson.ItemIndex := -1;
300     lblActionBy.Caption := 'Responsible Person';
301     cboPerson.Caption := lblActionBy.Caption;
302     cboPerson.OnNeedData := NewPersonNeedData;
303     cboPerson.InitLongList(User.Name)  ;
304     cboPerson.SelectByIEN(User.DUZ);
305   
306     pnlComments.Visible := True;
307     memComments.Clear;
308   (*  if not FUserIsRequester then RecipientList.Recipients := IntToStr(ConsultRec.SendingProvider);
309     RecipientList.Changed := not FUserIsRequester;*)
310     ActiveControl := memComments ;
311   end;
312   
313   procedure TfrmConsultAction.SetupSigFindings;
314   begin
315     SigFindPanelShow ;
316     pnlForward.Visible := False ;
317     //with frmConsultAction do Width := Width - pnlForward.Width ;
318     ckAlert.Visible             := True ;
319     lblAutoAlerts.Visible       := True;
320     ShowAutoAlertText;
321   (*  RecipientList.Recipients    := '' ;
322     RecipientList.Changed       := False ;*)
323     lblActionBy.Visible         := False ;
324     cboPerson.Visible           := False ;
325     pnlComments.Visible := True;
326     memComments.Clear;
327     ActiveControl := memComments ;
328   end;
329   
330   procedure TfrmConsultAction.SigFindPanelShow;
331   var
332     i: integer;
333   begin
334     pnlSigFind.Visible := True;        
335     with grpSigFindings do        
336       begin
337         for i := 0 to 2 do if Copy(Items[i],1,1)=ConsultRec.Findings then ItemIndex := i ;
338         if ItemIndex = -1 then        
339           begin
340             ItemIndex := 2;        
341             Caption := Caption + 'Not yet entered';
342           end
343         else        
344           Caption := Caption + Items[ItemIndex];
345       end;
346   end ;
347   
348   procedure TfrmConsultAction.SetupReceive;
349   begin
350     pnlForward.Visible := False ;
351     //with frmConsultAction do Width := Width - pnlForward.Width ;
352     pnlComments.Visible := True;                                                              // V14?
353     ckAlert.Visible := False ;
354     lblAutoAlerts.Visible := False;
355     pnlSigFind.Visible := False;
356     with frmConsultAction do Height := Height - pnlSigFind.Height;// - pnlComments.Height ;   // V14?
357     cboPerson.OnNeedData := NewPersonNeedData;
358     cboPerson.InitLongList(User.Name)  ;
359     cboPerson.SelectByIEN(User.DUZ);        
360     ActiveControl := calDateOfAction;
361   end;
362   
363   procedure TfrmConsultAction.SetupOther;
364   begin
365     pnlForward.Visible := False ;
366     //with frmConsultAction do Width := Width - pnlForward.Width ;
367     pnlSigFind.Visible := False;
368     with frmConsultAction do Height := Height - pnlSigFind.Height;
369     lblActionBy.Caption := 'Action by';
370     cboPerson.Caption := lblActionBy.Caption;
371     cboPerson.OnNeedData := NewPersonNeedData;
372     cboPerson.InitLongList(User.Name)  ;        
373     cboPerson.SelectByIEN(User.DUZ);
374     ckAlert.Visible := False ;        
375     lblAutoAlerts.Visible := False;
376     pnlComments.Visible := True;
377     memComments.Clear;
378     ActiveControl := memComments ;
379   end;
380   
381   // ============================= Control events ================================
382   
383   procedure TfrmConsultAction.NewPersonNeedData(Sender: TObject; const StartFrom: string;
384     Direction, InsertAt: Integer);
385   begin
386     inherited;
387     (Sender as TORComboBox).ForDataUse(SubSetOfPersons(StartFrom, Direction));
388   end;
389   
390   procedure TfrmConsultAction.ProviderNeedData(Sender: TObject; const StartFrom: string;
391     Direction, InsertAt: Integer);
392   begin
393     inherited;
394     (Sender as TORComboBox).ForDataUse(SubSetOfProviders(StartFrom, Direction));
395   end;
396   
397   procedure TfrmConsultAction.cmdCancelClick(Sender: TObject);
398   begin
399     FChanged := False ;
400     Close ;
401   end;
402   
403   procedure TfrmConsultAction.cmdOKClick(Sender: TObject);
404   var
405     Alist: TStringList;
406   begin
407     Alist := TStringList.Create ;
408     try
409       if (cboPerson.ItemIEN = 0)
410           and (FActionType <> CN_ACT_ADD_CMT)
411           and (FActionType <> CN_ACT_SIGFIND) then
412         begin
413           InfoBox(TX_PERSON_TEXT, TX_PERSON_CAP, MB_OK or MB_ICONWARNING);
414           Exit;
415         end;
416   
417       if ((FActionType = CN_ACT_SIGFIND) or (FActionType = CN_ACT_ADMIN_COMPLETE))
418       and (grpSigFindings.ItemIndex < 0) then
419         begin
420           InfoBox(TX_SIGFIND_TEXT, TX_SIGFIND_CAP, MB_OK or MB_ICONWARNING);
421           Exit;
422         end;
423   
424       if   ((FActionType = CN_ACT_DENY)
425          or (FActionType = CN_ACT_DISCONTINUE)
426          or (FActionType = CN_ACT_ADD_CMT)
427          or (FActionType = CN_ACT_ADMIN_COMPLETE))
428          and (memComments.Lines.Count = 0) then
429         begin
430             InfoBox(TX_COMMENTS_TEXT, TX_COMMENTS_CAP, MB_OK or MB_ICONWARNING);
431             Exit;
432         end;
433   
434       if (FActionType = CN_ACT_FORWARD) then
435        begin
436          if (FIsProcedure and (cboService.ItemIndex = -1) and (FToService = 0 )) or
437             ((not FIsProcedure) and (treService.Selected = nil) and (FToService = 0 )) then
438            begin
439             InfoBox(TX_NOFORWARD_TEXT, TX_NOFORWARD_CAP, MB_OK or MB_ICONWARNING);
440             Exit;
441            end;
442          if (not FIsProcedure) and (cboService.ItemIEN = ConsultRec.ToService) then
443            begin
444             InfoBox(TX_NOFORWARD_SELF, TX_NOFORWARD_CAP, MB_OK or MB_ICONWARNING);
445             Exit;
446            end;
447          if cboUrgency.ItemIEN = 0 then
448            begin
449              InfoBox(TX_NOURGENCY_TEXT, TX_NOFORWARD_CAP, MB_OK or MB_ICONWARNING);
450              Exit;
451            end;
452          if (FIsProcedure and (Piece(cboService.Items[cboService.ItemIndex], U, 5) = '1')) or
453             ((not FIsProcedure) and (Piece(TORTreeNode(treService.Selected).StringData, U, 5) = '1')) then
454            begin
455             InfoBox(TX_NOTTHISSVC_TEXT, TX_NOFORWARD_CAP, MB_OK or MB_ICONWARNING);
456             Exit;
457            end;
458        end ;
459   
460       if calDateofAction.Text <> '' then
461         begin
462           FActionDate := StrToFMDateTime(calDateofAction.Text) ;
463           if FActionDate = -1 then
464             begin
465               InfoBox(TX_DATE_TEXT, TX_DATE_CAP, MB_OK or MB_ICONWARNING);
466               calDateofAction.SetFocus ;
467               exit ;
468             end
469           else if FActionDate > FMNow then
470             begin
471               InfoBox(TX_FUTDATE_TEXT, TX_DATE_CAP, MB_OK or MB_ICONWARNING);
472               calDateofAction.SetFocus ;
473               exit ;
474             end;
475         end
476       else
477         FActionDate := FMNow ;
478   
479       FActionBy      := cboPerson.ItemIEN;
480       FAttentionOf   := cboAttentionOf.ItemIEN ;
481       FUrgency       := cboUrgency.ItemIEN ;
482       if (FActionType = CN_ACT_SIGFIND) or (FActionType = CN_ACT_ADMIN_COMPLETE) then
483         FSigFind       := Copy(grpSigFindings.Items[grpSigFindings.ItemIndex],2,1);
484       LimitEditWidth(memComments, 74);
485       FComments := memComments.Lines ;
486       if ((ckAlert.Checked) (*or (FActionType = CN_ACT_ADMIN_COMPLETE)*))
487           and RecipientList.Changed then
488         begin
489           FAlert   := 1  ;
490           FAlertTo := RecipientList.Recipients ;
491         end
492       else
493         begin
494           FAlert   := 0;
495           FAlertTo := '';
496         end ;
497   
498       case FActionType of
499         CN_ACT_RECEIVE    :
500           ReceiveConsult(Alist, ConsultRec.IEN, FActionBy, FActionDate, FComments) ;
501         CN_ACT_SCHEDULE   :
502           ScheduleConsult(Alist, ConsultRec.IEN, FActionBy, FActionDate, FAlert, FAlertTo, FComments) ;
503         CN_ACT_DENY       :
504           DenyConsult(Alist, ConsultRec.IEN, FActionBy, FActionDate, FComments) ;
505         CN_ACT_DISCONTINUE:
506           DiscontinueConsult(Alist, ConsultRec.IEN, FActionBy, FActionDate, FComments) ;
507         CN_ACT_FORWARD    :
508           ForwardConsult(Alist, ConsultRec.IEN, FToService, FActionBy, FAttentionOf, FUrgency, FActionDate, FComments);
509         CN_ACT_ADD_CMT    :
510           AddComment(Alist, ConsultRec.IEN, FComments, FActionDate, FAlert, FAlertTo) ;
511         CN_ACT_SIGFIND    :
512           SigFindings(Alist, ConsultRec.IEN, FSigFind, FComments, FActionDate, FAlert, FAlertTo) ;
513         CN_ACT_ADMIN_COMPLETE :
514           AdminComplete(Alist,ConsultRec.IEN, FSigFind, FComments, FActionBy, FActionDate, FAlert, FAlertTo);
515       end ;
516       if AList.Count > 0 then
517       begin
518         if StrToInt(Piece(Alist[0],u,1)) > 0 then
519           begin
520             InfoBox(Piece(Alist[0],u,2), 'Unable to '+ActionType[FActionType], MB_OK or MB_ICONWARNING);
521             FChanged :=  False ;
522           end
523         else
524           FChanged := True;
525       end
526       else
527         FChanged := True ;
528     finally
529       Alist.Free ;
530     end ;
531     Close ;
532   end ;
533   
534   procedure TfrmConsultAction.ckAlertClick(Sender: TObject);
535   begin
536      if ckAlert.Checked then SelectRecipients(Font.Size, FActionType, RecipientList) ;
537   end;
538   
539   
540   procedure TfrmConsultAction.treServiceChange(Sender: TObject; Node: TTreeNode);
541   begin
542     if uChanging or FIsProcedure then Exit;
543     FToService  := StrToIntDef(Piece(TORTreeNode(treService.Selected).StringData, U, 1), 0);
544   (*  if (treService.Selected.Data <> nil) and (Piece(string(treService.Selected.Data), U, 5) <> '1') then
545       cboService.SelectByID(Piece(string(treService.Selected.Data), U, 1))*)
546     //cboService.SelectByID(Piece(string(treService.Selected.Data), U, 1));
547      cboService.ItemIndex := cboService.Items.IndexOf(Trim(treService.Selected.Text));  {RV}
548      ActiveControl := cboService;                                                 {RV}
549   end;
550   
551   procedure TfrmConsultAction.treServiceExit(Sender: TObject);
552   begin
553   (*  if (Piece(TORTreeNode(treService.Selected).StringData, U, 5) = '1') then      WHY IS THIS IN HERE?  (rv - v15.5)
554       InfoBox(TX_NOTTHISSVC_TEXT, TX_NOFORWARD_CAP, MB_OK or MB_ICONWARNING);*)
555   end;
556   
557   procedure TfrmConsultAction.cboServiceSelect(Sender: TObject);
558   var                                                                       
559     i: integer;                                                             
560   begin                                                                     
561     if not FIsProcedure then
562       begin
563         uChanging := True;
564         with treService do for i := 0 to Items.Count-1 do
565           begin
566             if Piece(TORTreeNode(Items[i]).StringData, U, 1) = cboService.ItemID then
567               begin
568                 Selected := Items[i];
569                 //treServiceChange(Self, Items[i]);
570                 break;
571               end;
572           end;
573         uChanging := False;
574         FToService  := StrToIntDef(Piece(TORTreeNode(treService.Selected).StringData, U, 1), 0);
575       end
576     else 
577       FToService  := cboService.ItemIEN;
578   end;                                                                      
579   
580   (*procedure TfrmConsultAction.ShowAutoAlertText;      ****  SEE BELOW FOR REPLACEMENT - v27.9 Phelps/Vertigan
581   const
582     TX_ALERT1          = 'An alert will automatically be sent to ';
583     TX_ALERT_PROVIDER  = 'the ordering provider';
584     TX_ALERT_SVC_USERS = 'notification recipients for this service.';
585     TX_ALERT_NOBODY    = 'No automatic alerts will be sent.';  // this should be rare to never
586   var
587     x: string;
588   begin
589     case FUserLevel of
590        UL_NONE, UL_REVIEW:
591          begin
592            if FUserIsRequester then
593              x := TX_ALERT1 + TX_ALERT_SVC_USERS
594            else
595              x := TX_ALERT1 + TX_ALERT_PROVIDER + ' and to ' + TX_ALERT_SVC_USERS;
596          end;
597        UL_UPDATE, UL_ADMIN, UL_UPDATE_AND_ADMIN:
598          begin
599            if FUserIsRequester then
600              x := TX_ALERT_NOBODY
601            else
602              x := TX_ALERT1 + TX_ALERT_PROVIDER + '.';
603          end;
604      end;
605      lblAutoAlerts.Caption := x;
606   end;*)
607   
608   procedure TfrmConsultAction.ShowAutoAlertText;
609   const
610     TX_ALERT1          = 'An alert will automatically be sent to ';
611     TX_ALERT_PROVIDER  = 'the ordering provider';
612     TX_ALERT_SVC_USERS = 'notification recipients for this service.';
613     TX_ALERT_NOBODY    = 'No automatic alerts will be sent.';  // this should be rare to never
614   var
615     x: string;
616   begin
617     case FUserLevel of
618        UL_NONE, UL_REVIEW:
619          begin
620            if FUserIsRequester then
621              x := TX_ALERT1 + TX_ALERT_SVC_USERS
622            else
623              x := TX_ALERT1 + TX_ALERT_PROVIDER + ' and to ' + TX_ALERT_SVC_USERS;
624          end;
625        UL_UPDATE, UL_ADMIN, UL_UPDATE_AND_ADMIN:
626          begin
627            if FUserIsRequester then
628              //x := TX_ALERT_NOBODY   Replace with following line
629               x := TX_ALERT1 + TX_ALERT_SVC_USERS
630            else
631              x := TX_ALERT1 + TX_ALERT_PROVIDER + '.';
632          end;
633        UL_UNRESTRICTED:
634          begin
635            if FUserIsRequester then
636              x := TX_ALERT1 + TX_ALERT_SVC_USERS
637            else
638              x := TX_ALERT1 + TX_ALERT_PROVIDER + ' and to ' + TX_ALERT_SVC_USERS;
639          end;
640      end;
641      lblAutoAlerts.Caption := x;
642   end;
643   
644   
645   initialization
646      SvcList := TStringList.Create ;
647   
648   finalization
649      SvcList.Free ;
650   
651   
652   end.

Module Calls (2 levels)


fConsultAct
 ├uCore
 │ ├rCore
 │ ├uConst
 │ ├uCombatVet
 │ ├rTIU
 │ ├rOrders
 │ ├rConsults
 │ └uOrders
 ├fBase508Form
 │ ├uConst
 │ └uHelpManager
 ├rCore...
 ├rConsults...
 ├uConsults
 │ └uConst
 ├fConsults
 │ ├fHSplit
 │ ├uConsults...
 │ ├rOrders...
 │ ├uPCE
 │ ├uConst
 │ ├fDrawers
 │ ├rTIU...
 │ ├uTIU
 │ ├uDocTree
 │ ├fPrintList
 │ ├rCore...
 │ ├uCore...
 │ ├rConsults...
 │ ├fConsultBS
 │ ├fConsultBD
 │ ├fSignItem
 │ ├fConsultBSt
 │ ├fConsultsView
 │ ├fConsultAct...
 │ ├fEncnt
 │ ├rPCE
 │ ├fEncounterFrame
 │ ├fRptBox
 │ ├fConsult513Prt
 │ ├fCsltNote
 │ ├fAddlSigners
 │ ├fFrame
 │ ├fNoteDR
 │ ├fEditProc
 │ ├fEditConsult
 │ ├uOrders...
 │ ├uSpell
 │ ├fTemplateEditor
 │ ├fNotePrt
 │ ├fNotes
 │ ├fNoteProps
 │ ├fNotesBP
 │ ├fReminderTree
 │ ├fReminderDialog
 │ ├uReminders
 │ ├fConsMedRslt
 │ ├fTemplateFieldEditor
 │ ├dShared
 │ ├rTemplates
 │ ├fIconLegend
 │ ├fNoteIDParents
 │ ├fNoteCPFields
 │ ├uTemplates
 │ ├fTemplateDialog
 │ └uVA508CPRSCompatibility
 ├fConsultAlertTo
 │ ├fBase508Form...
 │ └rCore...
 └rOrders...

Module Called-By (2 levels)


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