| [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. | 
|---|