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