| 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
 | 
|---|
| 467 |       FSigFind       := Copy(grpSigFindings.Items[grpSigFindings.ItemIndex],2,1);
 | 
|---|
| 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.
 | 
|---|