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