source: cprs/trunk/CPRS-Chart/fPtSel.pas@ 893

Last change on this file since 893 was 830, checked in by Kevin Toppenberg, 14 years ago

Upgrading to version 27
File size: 47.7 KB
Line 
1unit fPtSel;
2{ Allows patient selection using various pt lists. Allows display & processing of alerts. }
3 //vwpt enhancements included
4
5{$OPTIMIZATION OFF} // REMOVE AFTER UNIT IS DEBUGGED
6
7{$define VAA}
8
9interface
10
11uses
12 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
13 StdCtrls, ORCtrls, ExtCtrls, ORFn, ORNet, ORDtTmRng, Gauges, Menus, ComCtrls,
14 UBAGlobals, UBACore, fBase508Form, VA508AccessibilityManager, uConst;
15
16type
17 TfrmPtSel = class(TfrmBase508Form)
18 pnlPtSel: TORAutoPanel;
19 cboPatient: TORComboBox;
20 lblPatient: TLabel;
21 cmdOK: TButton;
22 cmdCancel: TButton;
23 pnlNotifications: TORAutoPanel;
24 cmdProcessInfo: TButton;
25 cmdProcessAll: TButton;
26 cmdProcess: TButton;
27 cmdForward: TButton;
28 sptVert: TSplitter;
29 cmdSaveList: TButton;
30 pnlDivide: TORAutoPanel;
31 lblNotifications: TLabel;
32 ggeInfo: TGauge;
33 cmdRemove: TButton;
34 popNotifications: TPopupMenu;
35 mnuProcess: TMenuItem;
36 mnuRemove: TMenuItem;
37 mnuForward: TMenuItem;
38 lstvAlerts: TCaptionListView;
39 N1: TMenuItem;
40 RadioGroup1: TRadioGroup ;
41 //RadioGroup1: TRadioGroup;
42 cmdComments: TButton;
43 procedure cmdOKClick(Sender: TObject);
44 procedure cmdCancelClick(Sender: TObject);
45 procedure cboPatientChange(Sender: TObject);
46 procedure cboPatientKeyPause(Sender: TObject);
47 procedure cboPatientMouseClick(Sender: TObject);
48 procedure cboPatientEnter(Sender: TObject);
49 procedure cboPatientExit(Sender: TObject);
50 procedure cboPatientNeedData(Sender: TObject; const StartFrom: string;
51 Direction, InsertAt: Integer);
52 procedure cboPatientDblClick(Sender: TObject);
53 procedure cmdProcessClick(Sender: TObject);
54 procedure cmdSaveListClick(Sender: TObject);
55 procedure cmdProcessInfoClick(Sender: TObject);
56 procedure cmdProcessAllClick(Sender: TObject);
57 procedure lstvAlertsDblClick(Sender: TObject);
58 procedure cmdForwardClick(Sender: TObject);
59 procedure cmdRemoveClick(Sender: TObject);
60 procedure FormDestroy(Sender: TObject);
61 procedure pnlPtSelResize(Sender: TObject);
62 procedure FormClose(Sender: TObject; var Action: TCloseAction);
63 procedure cboPatientKeyDown(Sender: TObject; var Key: Word;
64 Shift: TShiftState);
65 procedure lstvAlertsColumnClick(Sender: TObject; Column: TListColumn);
66 procedure lstvAlertsCompare(Sender: TObject; Item1, Item2: TListItem; Data: Integer; var Compare: Integer);
67 function DupLastSSN(const DFN: string): Boolean;
68 procedure lstFlagsClick(Sender: TObject);
69 procedure lstFlagsKeyDown(Sender: TObject; var Key: Word;
70 Shift: TShiftState);
71 procedure lstvAlertsSelectItem(Sender: TObject; Item: TListItem;
72 Selected: Boolean);
73 procedure ShowButts(ShowButts: Boolean);
74 procedure lstvAlertsInfoTip(Sender: TObject; Item: TListItem;
75 var InfoTip: String);
76 procedure lstvAlertsKeyDown(Sender: TObject; var Key: Word;
77 Shift: TShiftState);
78 procedure FormShow(Sender: TObject);
79 procedure FormCreate(Sender: TObject);
80 procedure FormResize(Sender: TObject);
81 procedure cmdCommentsClick(Sender: TObject);
82
83 //VWPT ENAHANCED PATIENT LOOKUP
84 function IsOther(itemindex:Integer):Boolean;
85
86 procedure onclick1(Sender: TObject);
87
88 private
89 FsortCol: integer;
90 FsortAscending: boolean;
91 FLastPt: string;
92 FsortDirection: string;
93 FUserCancelled: boolean;
94 FNotificationBtnsAdjusted: Boolean;
95 FAlertsNotReady: boolean;
96 procedure WMReadyAlert(var Message: TMessage); message UM_MISC;
97 procedure ReadyAlert;
98 procedure AdjustFormSize(ShowNotif: Boolean; FontSize: Integer);
99 procedure ClearIDInfo;
100 procedure ShowIDInfo;
101 procedure ShowFlagInfo;
102 procedure SetCaptionTop;
103 procedure SetPtListTop(IEN: Int64);
104 procedure RPLDisplay;
105 procedure AlertList;
106 procedure ReformatAlertDateTime;
107 procedure AdjustButtonSize(pButton:TButton);
108 procedure AdjustNotificationButtons;
109
110 public
111 procedure Loaded; override;
112 end;
113
114procedure SelectPatient(ShowNotif: Boolean; FontSize: Integer; var UserCancelled: boolean);
115
116var
117 frmPtSel: TfrmPtSel;
118 FDfltSrc, FDfltSrcType: string;
119 IsRPL, RPLJob, DupDFN: string; // RPLJob stores server $J job number of RPL pt. list.
120 RPLProblem: boolean; // Allows close of form if there's an RPL problem.
121 PtStrs: TStringList;
122
123 //vwpt enhancement
124 itimson : integer = 1;
125 enhanceskip : integer = 0;
126 radiogrp1index : integer = 0;
127
128
129implementation
130
131{$R *.DFM}
132
133uses rCore, uCore, fDupPts, fPtSens, fPtSelDemog, fPtSelOptns, fPatientFlagMulti,
134 uOrPtf, fAlertForward, rMisc, fFrame, fRptBox, VA508AccessibilityRouter;
135
136resourcestring
137 StrFPtSel_lstvAlerts_Co = 'C'+U+'fPtSel.lstvAlerts.Cols';
138
139const
140 AliasString = ' -- ALIAS';
141
142 //VWPT ENAHANCED PATIENT LOOKUP
143function TfrmPtSel.IsOther(itemindex:Integer):Boolean;
144var
145 i:Integer ;
146
147begin
148 Result := True;
149 if (RadioGroup1.ItemIndex = -1) or (RadioGroup1.ItemIndex = 0) or (itimson = 0) then Result := False;
150end;
151
152procedure SelectPatient(ShowNotif: Boolean; FontSize: Integer; var UserCancelled: boolean);
153{ displays patient selection dialog (with optional notifications), updates Patient object }
154var
155 frmPtSel: TfrmPtSel;
156begin
157 frmPtSel := TfrmPtSel.Create(Application);
158 RPLProblem := false;
159 try
160 with frmPtSel do
161 begin
162 AdjustFormSize(ShowNotif, FontSize); // Set initial form size
163 FDfltSrc := DfltPtList;
164 FDfltSrcType := Piece(FDfltSrc, U, 2);
165 FDfltSrc := Piece(FDfltSrc, U, 1);
166 if (IsRPL = '1') then // Deal with restricted patient list users.
167 FDfltSrc := '';
168 frmPtSelOptns.SetDefaultPtList(FDfltSrc);
169 if RPLProblem then
170 begin
171 frmPtSel.Release;
172 Exit;
173 end;
174 Notifications.Clear;
175 FsortCol := -1;
176 AlertList;
177 ClearIDInfo;
178 if (IsRPL = '1') then // Deal with restricted patient list users.
179 RPLDisplay; // Removes unnecessary components from view.
180 FUserCancelled := FALSE;
181 ShowModal;
182 UserCancelled := FUserCancelled;
183 end;
184 finally
185 frmPtSel.Release;
186 end;
187end;
188
189procedure TfrmPtSel.AdjustFormSize(ShowNotif: Boolean; FontSize: Integer);
190{ Adjusts the initial size of the form based on the font used & if notifications should show. }
191var
192 Rect: TRect;
193// TheFormHeight: integer;
194 SplitterTop, t1, t2, t3: integer;
195begin
196 ResizeAnchoredFormToFont(self);
197// TheFormHeight := pnlPtSel.Height;
198 // Make the form bigger (140%) to show notifications and show notification controls.
199 if ShowNotif then
200 begin
201// TheFormHeight := Round(TheFormHeight * 2.4);
202// pnlDivide.Height := lblNotifications.Height + 4;
203 pnlDivide.Visible := True;
204 lstvAlerts.Visible := True;
205 pnlNotifications.Visible := True;
206 pnlPtSel.BevelOuter := bvRaised;
207// ClientHeight := TheFormHeight;
208 end
209 else
210 begin
211 pnlDivide.Visible := False;
212 lstvAlerts.Visible := False;
213 pnlNotifications.Visible := False;
214// ClientHeight := TheFormHeight;
215// pnlPtSel.Anchors := [akLeft,akRight,akTop,akBottom];
216 end;
217// ClientHeight := TheFormHeight;
218// VertScrollBar.Range := TheFormHeight;
219
220 //After all of this calcualtion, we still use the saved preferences when possible
221 SetFormPosition(self);
222 Rect := BoundsRect;
223 ForceInsideWorkArea(Rect);
224 BoundsRect := Rect;
225
226 if frmFrame.EnduringPtSelSplitterPos <> 0 then
227 SplitterTop := frmFrame.EnduringPtSelSplitterPos
228 else
229 SetUserBounds2(Name+'.'+sptVert.Name,SplitterTop, t1, t2, t3);
230 if SplitterTop <> 0 then
231 pnlPtSel.Height := SplitterTop;
232 FNotificationBtnsAdjusted := False;
233 AdjustButtonSize(cmdSaveList);
234 AdjustButtonSize(cmdProcessInfo);
235 AdjustButtonSize(cmdProcessAll);
236 AdjustButtonSize(cmdProcess);
237 AdjustButtonSize(cmdForward);
238 AdjustButtonSize(cmdRemove);
239 AdjustButtonSize(cmdComments);
240 AdjustNotificationButtons;
241end;
242
243procedure TfrmPtSel.SetCaptionTop;
244{ Show patient list name, set top list to 'Select ...' if appropriate. }
245var
246 x: string;
247begin
248 x := '';
249 lblPatient.Caption := 'Patients';
250 if (not User.IsReportsOnly) then
251 begin
252 case frmPtSelOptns.SrcType of
253 TAG_SRC_DFLT: lblPatient.Caption := 'Patients (' + FDfltSrc + ')';
254 TAG_SRC_PROV: x := 'Provider';
255 TAG_SRC_TEAM: x := 'Team';
256 TAG_SRC_SPEC: x := 'Specialty';
257 TAG_SRC_CLIN: x := 'Clinic';
258 TAG_SRC_WARD: x := 'Ward';
259 TAG_SRC_ALL: { Nothing };
260 end; // case stmt
261 end; // begin
262 if Length(x) > 0 then with cboPatient do
263 begin
264 RedrawSuspend(Handle);
265 ClearIDInfo;
266 ClearTop;
267 Text := '';
268 Items.Add('^Select a ' + x + '...');
269 Items.Add(LLS_LINE);
270 Items.Add(LLS_SPACE);
271 cboPatient.InitLongList('');
272 //VWPT
273 //cboPatient.LongList := True;
274 //cboPateint.HintonItem := True;
275 //end
276 RedrawActivate(cboPatient.Handle);
277 end;
278end;
279
280{ List Source events: }
281
282procedure TfrmPtSel.SetPtListTop(IEN: Int64);
283{ Sets top items in patient list according to list source type and optional list source IEN. }
284var
285 NewTopList: string;
286 FirstDate, LastDate: string;
287begin
288 // NOTE: Some pieces in RPC returned arrays are rearranged by ListPtByDflt call in rCore!
289 IsRPL := User.IsRPL;
290 if (IsRPL = '') then // First piece in ^VA(200,.101) should always be set (to 1 or 0).
291 begin
292 InfoBox('Patient selection list flag not set.', 'Incomplete User Information', MB_OK);
293 RPLProblem := true;
294 Exit;
295 end;
296 // FirstDate := 0; LastDate := 0; // Not req'd, but eliminates hint.
297 // Assign list box TabPosition, Pieces properties according to type of list to be displayed.
298 // (Always use Piece "2" as the first in the list to assure display of patient's name.)
299 cboPatient.pieces := '2,3'; // This line and next: defaults set - exceptions modifield next.
300 cboPatient.tabPositions := '20,28';
301 if ((frmPtSelOptns.SrcType = TAG_SRC_DFLT) and (FDfltSrc = 'Combination')) then
302 begin
303 cboPatient.pieces := '2,3,4,5,9';
304 cboPatient.tabPositions := '20,28,35,45';
305 end;
306 if ((frmPtSelOptns.SrcType = TAG_SRC_DFLT) and
307 (FDfltSrcType = 'Ward')) or (frmPtSelOptns.SrcType = TAG_SRC_WARD) then
308 cboPatient.tabPositions := '35';
309 if ((frmPtSelOptns.SrcType = TAG_SRC_DFLT) and
310 (AnsiStrPos(pChar(FDfltSrcType), 'Clinic') <> nil)) or (frmPtSelOptns.SrcType = TAG_SRC_CLIN) then
311 begin
312 cboPatient.pieces := '2,3,9';
313 cboPatient.tabPositions := '24,45';
314 end;
315 NewTopList := IntToStr(frmPtSelOptns.SrcType) + U + IntToStr(IEN); // Default setting.
316 if (frmPtSelOptns.SrcType = TAG_SRC_CLIN) then with frmPtSelOptns.cboDateRange do
317 begin
318 if ItemID = '' then Exit; // Need both clinic & date range.
319 FirstDate := Piece(ItemID, ';', 1);
320 LastDate := Piece(ItemID, ';', 2);
321 NewTopList := IntToStr(frmPtSelOptns.SrcType) + U + IntToStr(IEN) + U + ItemID; // Modified for clinics.
322 end;
323 if NewTopList = frmPtSelOptns.LastTopList then Exit; // Only continue if new top list.
324 frmPtSelOptns.LastTopList := NewTopList;
325 RedrawSuspend(cboPatient.Handle);
326 ClearIDInfo;
327 cboPatient.ClearTop;
328 cboPatient.Text := '';
329 if (IsRPL = '1') then // Deal with restricted patient list users.
330 begin
331 RPLJob := MakeRPLPtList(User.RPLList); // MakeRPLPtList is in rCore, writes global "B" x-ref list.
332 if (RPLJob = '') then
333 begin
334 InfoBox('Assignment of valid OE/RR Team List Needed.', 'Unable to build Patient List', MB_OK);
335 RPLProblem := true;
336 Exit;
337 end;
338 end
339 else
340 begin
341 case frmPtSelOptns.SrcType of
342 TAG_SRC_DFLT: ListPtByDflt(cboPatient.Items);
343 TAG_SRC_PROV: ListPtByProvider(cboPatient.Items, IEN);
344 TAG_SRC_TEAM: ListPtByTeam(cboPatient.Items, IEN);
345 TAG_SRC_SPEC: ListPtBySpecialty(cboPatient.Items, IEN);
346 TAG_SRC_CLIN: ListPtByClinic(cboPatient.Items, frmPtSelOptns.cboList.ItemIEN, FirstDate, LastDate);
347 TAG_SRC_WARD: ListPtByWard(cboPatient.Items, IEN);
348 TAG_SRC_ALL: ListPtTop(cboPatient.Items);
349 end;
350 end;
351 if frmPtSelOptns.cboList.Visible then
352 lblPatient.Caption := 'Patients (' + frmPtSelOptns.cboList.Text + ')';
353 if frmPtSelOptns.SrcType = TAG_SRC_ALL then
354 lblPatient.Caption := 'Patients (All Patients)';
355 with cboPatient do if ShortCount > 0 then
356 begin
357 Items.Add(LLS_LINE);
358 Items.Add(LLS_SPACE);
359 end;
360 cboPatient.Caption := lblPatient.Caption;
361 cboPatient.InitLongList('');
362 RedrawActivate(cboPatient.Handle);
363end;
364
365{ Patient Select events: }
366
367procedure TfrmPtSel.cboPatientEnter(Sender: TObject);
368begin
369 cmdOK.Default := True;
370 if cboPatient.ItemIndex >= 0 then
371 begin
372 ShowIDInfo;
373 ShowFlagInfo;
374 end;
375end;
376
377procedure TfrmPtSel.cboPatientExit(Sender: TObject);
378begin
379 cmdOK.Default := False;
380end;
381
382procedure TfrmPtSel.cboPatientChange(Sender: TObject);
383
384 procedure ShowMatchingPatients;
385 begin
386 with cboPatient do
387 begin
388 ClearIDInfo;
389 if ShortCount > 0 then
390 begin
391 if ShortCount = 1 then
392 begin
393 ItemIndex := 0;
394 ShowIDInfo;
395 ShowFlagInfo;
396 end;
397 Items.Add(LLS_LINE);
398 Items.Add(LLS_SPACE);
399 end;
400 InitLongList('');
401 end;
402 end;
403
404var caption:string;
405index:integer;
406
407
408begin
409 with cboPatient do
410 if IsOther(integer(1))and (IsRPL <> '1')and (enhanceskip=0) and (frmPtSelOptns.IsEnhanced(Text))and (not frmPtSelOptns.IsPatientName(Text)) then
411 begin
412 if (IsRPL = '1') then
413 ///ListPtByRPLLast5(Items, Text) Messagebox error
414 else
415 begin
416 index := RadioGroup1.ItemIndex;
417 caption := piece(RadioGroup1.Items[index],'&',2);
418 //Application.MessageBox(pChar(caption), pChar('Message'),MB_OK);
419 //caption := '' ; //derivative of integer(1) or other index of radio button selection
420 ListPtByOther(Items, Text,caption); // one extra argument on radio button selection
421 if Items.Count>0 then
422 begin
423 //itimson :=0 ;//no check for timson change in cbopatient until after click event finished
424 RadioGroup1.ItemIndex := 0;
425 RadioGroup1.SetFocus;
426 RadioGroup1.Refresh;
427 end;
428 ShowMatchingPatients;
429 end;
430 end
431 else if frmPtSelOptns.IsLast5(Text) then
432 begin
433 if (IsRPL = '1') then
434 ListPtByRPLLast5(Items, Text)
435 else
436 ListPtByLast5(Items, Text);
437 ShowMatchingPatients;
438 end
439 else if frmPtSelOptns.IsFullSSN(Text) then
440 begin
441 if (IsRPL = '1') then
442 ListPtByRPLFullSSN(Items, Text)
443 else
444 ListPtByFullSSN(Items, Text);
445 ShowMatchingPatients
446 end
447 else if (not IsOther(integer(1))) and (IsRPL <> '1')and (enhanceskip=0) and (frmPtSelOptns.IsEnhanced(Text)) and (not frmPtSelOptns.IsPatientName(Text)) then
448 begin
449
450 ListPtByTimson(Items,Text) ;
451 ShowMatchingPatients;
452 //vwpt enhanced changes
453 //check for change here if itimson flag =1 .no matter what however, even if 0,
454 //set it back to 1
455 //itimson :=1;
456 //end vwpt enhanced
457
458
459 end
460 //enhanceskip := 0 ;
461end;
462
463procedure TfrmPtSel.cboPatientKeyPause(Sender: TObject);
464begin
465 if Length(cboPatient.ItemID) > 0 then //*DFN*
466 begin
467 ShowIDInfo;
468 ShowFlagInfo;
469 end else
470 begin
471 ClearIDInfo;
472 end;
473end;
474
475procedure TfrmPtSel.cboPatientMouseClick(Sender: TObject);
476begin
477 if Length(cboPatient.ItemID) > 0 then //*DFN*
478 begin
479 ShowIDInfo;
480 ShowFlagInfo;
481 end else
482 begin
483 ClearIDInfo;
484 end;
485end;
486
487procedure TfrmPtSel.cboPatientDblClick(Sender: TObject);
488begin
489 // vwpt enhanced on click or double clck set mode back to normal to a.) not allow change event
490 //erroneously checked with false lookup, and b.0 immedicately put back into normal mode
491 //without separate step needed.
492 if (RadioGroup1.ItemIndex > 0) then
493 begin
494 //itimson :=0 ;//no check for timson change in cbopatient until after click event finished
495 RadioGroup1.ItemIndex := 0;
496 RadioGroup1.SetFocus;
497 RadioGroup1.Refresh;
498 end;
499 //enhanceskip:=1 ;
500
501//end vwpt enhanced
502 if Length(cboPatient.ItemID) > 0 then cmdOKClick(Self); //*DFN*
503end;
504
505procedure TfrmPtSel.cboPatientNeedData(Sender: TObject; const StartFrom: string;
506 Direction, InsertAt: Integer);
507var
508 i: Integer;
509 NoAlias, Patient: String;
510 PatientList: TStringList;
511begin
512 NoAlias := StartFrom;
513 with Sender as TORComboBox do
514 if Items.Count > ShortCount then
515 begin
516 NoAlias := Piece(Items[Items.Count-1], U, 1) + U + NoAlias;
517 if Direction < 0 then
518 NoAlias := Copy(NoAlias, 1, Length(NoAlias) - 1);
519 end;
520 if pos(AliasString, NoAlias) > 0 then
521 NoAlias := Copy(NoAlias, 1, pos(AliasString, NoAlias) - 1);
522 PatientList := TStringList.Create;
523 try
524 begin
525 if (IsRPL = '1') then // Restricted patient lists uses different feed for long list box:
526 FastAssign(ReadRPLPtList(RPLJob, NoAlias, Direction), PatientList)
527 else
528 begin
529 FastAssign(SubSetOfPatients(NoAlias, Direction), PatientList);
530 for i := 0 to PatientList.Count - 1 do // Add " - Alias" to alias names:
531 begin
532 Patient := PatientList[i];
533 // Piece 6 avoids display problems when mixed with "RPL" lists:
534 if (Uppercase(Piece(Patient, U, 2)) <> Uppercase(Piece(Patient, U, 6))) then
535 begin
536 SetPiece(Patient, U, 2, Piece(Patient, U, 2) + AliasString);
537 PatientList[i] := Patient;
538 end;
539 end;
540 end;
541 cboPatient.ForDataUse(PatientList);
542 end;
543 finally
544 PatientList.Free;
545 end;
546end;
547
548procedure TfrmPtSel.ClearIDInfo;
549begin
550 frmPtSelDemog.ClearIDInfo;
551end;
552
553procedure TfrmPtSel.ShowIDInfo;
554begin
555 frmPtSelDemog.ShowDemog(cboPatient.ItemID);
556end;
557
558procedure TfrmPtSel.WMReadyAlert(var Message: TMessage);
559begin
560 ReadyAlert;
561 Message.Result := 0;
562end;
563
564{ Command Button events: }
565
566procedure TfrmPtSel.cmdOKClick(Sender: TObject);
567{ Checks for restrictions on the selected patient and sets up the Patient object. }
568const
569 DLG_CANCEL = False;
570var
571 NewDFN: string; //*DFN*
572 DateDied: TFMDateTime;
573 AccessStatus: integer;
574begin
575// vwpt enhanced on click or double clck set mode back to normal to a.) not allow change event
576//erroneiusly checked with false lookup, and b.0 immedicately put back into normal mode
577//without separate step needed.
578 if (RadioGroup1.ItemIndex > 0 ) then
579 begin
580 //itimson :=0 ;//no check for timson change in cbopatient until after click event finished
581 RadioGroup1.ItemIndex := 0;
582 RadioGroup1.SetFocus;
583 RadioGroup1.Refresh;
584 end;
585
586//end vwpt enhanced
587if not (Length(cboPatient.ItemID) > 0) then //*DFN*
588 begin
589 InfoBox('A patient has not been selected.', 'No Patient Selected', MB_OK);
590 Exit;
591 end;
592 NewDFN := cboPatient.ItemID; //*DFN*
593 if FLastPt <> cboPatient.ItemID then
594 begin
595 HasActiveFlg(FlagList, HasFlag, cboPatient.ItemID);
596 flastpt := cboPatient.ItemID;
597 end;
598
599 If DupLastSSN(NewDFN) then // Check for, deal with duplicate patient data.
600 if (DupDFN = 'Cancel') then
601 Exit
602 else
603 NewDFN := DupDFN;
604 if not AllowAccessToSensitivePatient(NewDFN, AccessStatus) then exit;
605 DateDied := DateOfDeath(NewDFN);
606 if (DateDied > 0) and (InfoBox('This patient died ' + FormatFMDateTime('mmm dd,yyyy hh:nn', DateDied) + CRLF +
607 'Do you wish to continue?', 'Deceased Patient', MB_YESNO or MB_DEFBUTTON2) = ID_NO) then
608 Exit;
609 // 9/23/2002: Code used to check for changed pt. DFN here, but since same patient could be
610 // selected twice in diff. Encounter locations, check was removed and following code runs
611 // no matter; in fFrame code then updates Encounter display if Encounter.Location has changed.
612 // NOTE: Some pieces in RPC returned arrays are modified/rearranged by ListPtByDflt call in rCore!
613 Patient.DFN := NewDFN; // The patient object in uCore must have been created already!
614 Encounter.Clear;
615 Changes.Clear; // An earlier call to ReviewChanges should have cleared this.
616 if (frmPtSelOptns.SrcType = TAG_SRC_CLIN) and (frmPtSelOptns.cboList.ItemIEN > 0) and
617 IsFMDateTime(Piece(cboPatient.Items[cboPatient.ItemIndex], U, 4)) then // Clinics, not by default.
618 begin
619 Encounter.Location := frmPtSelOptns.cboList.ItemIEN;
620 with cboPatient do Encounter.DateTime := MakeFMDateTime(Piece(Items[ItemIndex], U, 4));
621 end
622 else if (frmPtSelOptns.SrcType = TAG_SRC_DFLT) and (DfltPtListSrc = 'C') and
623 IsFMDateTime(Piece(cboPatient.Items[cboPatient.ItemIndex], U, 4))then
624 with cboPatient do // "Default" is a clinic.
625 begin
626 Encounter.Location := StrToIntDef(Piece(Items[ItemIndex], U, 10), 0); // Piece 10 is ^SC( location IEN in this case.
627 Encounter.DateTime := MakeFMDateTime(Piece(Items[ItemIndex], U, 4));
628 end
629 else if ((frmPtSelOptns.SrcType = TAG_SRC_DFLT) and (FDfltSrc = 'Combination') and
630 (copy(Piece(cboPatient.Items[cboPatient.ItemIndex], U, 3), 1, 2) = 'Cl')) and
631 (IsFMDateTime(Piece(cboPatient.Items[cboPatient.ItemIndex], U, 8))) then
632 with cboPatient do // "Default" combination, clinic pt.
633 begin
634 Encounter.Location := StrToIntDef(Piece(Items[ItemIndex], U, 7), 0); // Piece 7 is ^SC( location IEN in this case.
635 Encounter.DateTime := MakeFMDateTime(Piece(Items[ItemIndex], U, 8));
636 end
637 else if Patient.Inpatient then // Everything else:
638 begin
639 Encounter.Inpatient := True;
640 Encounter.Location := Patient.Location;
641 Encounter.DateTime := Patient.AdmitTime;
642 Encounter.VisitCategory := 'H';
643 end;
644 if User.IsProvider then Encounter.Provider := User.DUZ;
645
646 GetBAStatus(Encounter.Provider,Patient.DFN);
647 //HDS00005025
648 if BILLING_AWARE then
649 if Assigned(UBAGLOBALS.BAOrderList) then UBAGLOBALS.BAOrderList.Clear;
650 FUserCancelled := FALSE;
651 Close;
652end;
653
654procedure TfrmPtSel.cmdCancelClick(Sender: TObject);
655begin
656 // Leave Patient object unchanged
657 FUserCancelled := TRUE;
658 Close;
659end;
660
661procedure TfrmPtSel.cmdCommentsClick(Sender: TObject);
662var
663 tmpCmt: TStringList;
664begin
665 if FAlertsNotReady then exit;
666 inherited;
667 tmpCmt := TStringList.Create;
668 try
669 tmpCmt.Text := lstvAlerts.Selected.SubItems[8];
670 LimitStringLength(tmpCmt, 74);
671 tmpCmt.Insert(0, StringOfChar('-', 74));
672 tmpCmt.Insert(0, lstvAlerts.Selected.SubItems[4]);
673 tmpCmt.Insert(0, lstvAlerts.Selected.SubItems[3]);
674 tmpCmt.Insert(0, lstvAlerts.Selected.SubItems[0]);
675 ReportBox(tmpCmt, 'Forwarded by: ' + lstvAlerts.Selected.SubItems[5], TRUE);
676 lstvAlerts.SetFocus;
677 finally
678 tmpCmt.Free;
679 end;
680end;
681
682procedure TfrmPtSel.cmdProcessClick(Sender: TObject);
683var
684 AFollowUp, i, infocount: Integer;
685 enableclose: boolean;
686 ADFN, x, RecordID, XQAID: string; //*DFN*
687begin
688 if FAlertsNotReady then exit;
689 enableclose := false;
690 with lstvAlerts do
691 begin
692 if SelCount <= 0 then Exit;
693
694 // Count information-only selections for gauge
695 infocount := 0;
696 for i:= 0 to Items.Count - 1 do if Items[i].Selected then
697 if (Items[i].SubItems[0] = 'I') then Inc(infocount);
698
699 if infocount >= 1 then
700 begin
701 ggeInfo.Visible := true; (*BOB*)
702 ggeInfo.MaxValue := infocount;
703 end;
704
705 for i := 0 to Items.Count - 1 do if Items[i].Selected then
706 { Items[i].Selected = Boolean TRUE if item is selected
707 " .Caption = Info flag ('I')
708 " .SubItems[0] = Patient ('ABC,PATIE (A4321)')
709 " . " [1] = Patient location ('[2B]')
710 " . " [2] = Alert urgency level ('HIGH, Moderate, low')
711 " . " [3] = Alert date/time ('2002/12/31@12:10')
712 " . " [4] = Alert message ('New order(s) placed.')
713 " . " [5] = Forwarded by/when
714 " . " [6] = XQAID ('OR,66,50;1416;3021231.121024')
715 'TIU6028;1423;3021203.09')
716 " . " [7] = Remove without processing flag ('YES')
717 " . " [8] = Forwarding comments (if applicable) }
718 begin
719 XQAID := Items[i].SubItems[6];
720 RecordID := Items[i].SubItems[0] + ': ' + Items[i].SubItems[4] + '^' + XQAID;
721 //RecordID := patient: alert message^XQAID ('ABC,PATIE (A4321): New order(s) placed.^OR,66,50;1416;3021231.121024')
722 if Items[i].Caption = 'I' then
723 // If Caption is 'I' delete the information only alert.
724 begin
725 ggeInfo.Progress := ggeInfo.Progress + 1;
726 DeleteAlert(XQAID);
727 end
728 else if Piece(XQAID, ',', 1) = 'OR' then
729 // OR,16,50;1311;2980626.100756
730 begin
731 ADFN := Piece(XQAID, ',', 2); //*DFN*
732 AFollowUp := StrToIntDef(Piece(Piece(XQAID, ';', 1), ',', 3), 0);
733 Notifications.Add(ADFN, AFollowUp, RecordID);
734 enableclose := true;
735 end
736 else if Copy(XQAID, 1, 6) = 'TIUERR' then
737 InfoBox(Piece(RecordID, U, 1) + #13#10#13#10 +
738 'The CPRS GUI cannot yet process this type of alert. Please use List Manager.',
739 'Unable to Process Alert', MB_OK)
740 else if Copy(XQAID, 1, 3) = 'TIU' then
741 // TIU6028;1423;3021203.09
742 begin
743 x := GetTIUAlertInfo(XQAID);
744 if Piece(x, U, 2) <> '' then
745 begin
746 ADFN := Piece(x, U, 2); //*DFN*
747 AFollowUp := StrToIntDef(Piece(Piece(x, U, 3), ';', 1), 0);
748 Notifications.Add(ADFN, AFollowUp, RecordID + '^^' + Piece(x, U, 3));
749 enableclose := true;
750 end
751 else
752 DeleteAlert(XQAID);
753 end
754 else //other alerts cannot be processed
755 InfoBox('This alert cannot be processed by the CPRS GUI.', Items[i].SubItems[0] + ': ' + Items[i].SubItems[4], MB_OK); end;
756 if enableclose = true then
757 Close
758 else
759 begin
760 ggeInfo.Visible := False;
761 // Update notification list:
762 lstvAlerts.Clear;
763 AlertList;
764 //display alerts sorted according to parameter settings:
765 FsortCol := -1; //CA - display alerts in correct sort
766 FormShow(Sender);
767 end;
768 if Items.Count = 0 then ShowButts(False);
769 if SelCount <= 0 then ShowButts(False);
770 end;
771 GetBAStatus(User.DUZ,Patient.DFN);
772end;
773
774procedure TfrmPtSel.cmdSaveListClick(Sender: TObject);
775begin
776 frmPtSelOptns.cmdSaveListClick(Sender);
777end;
778
779procedure TfrmPtSel.cmdProcessInfoClick(Sender: TObject);
780 // Select and process all items that are information only in the lstvAlerts list box.
781var
782 i: integer;
783begin
784 if FAlertsNotReady then exit;
785 if lstvAlerts.Items.Count = 0 then Exit;
786 if InfoBox('You are about to process all your INFORMATION alerts.' + CRLF
787 + 'These alerts will not be presented to you for individual' + CRLF
788 + 'review and they will be permanently removed from your' + CRLF
789 + 'alert list. Do you wish to continue?',
790 'Warning', MB_YESNO or MB_ICONWARNING) = IDYES then
791 begin
792 for i := 0 to lstvAlerts.Items.Count-1 do
793 lstvAlerts.Items[i].Selected := False; //clear any selected alerts so they aren't processed
794 for i := 0 to lstvAlerts.Items.Count-1 do
795 if lstvAlerts.Items[i].Caption = 'I' then
796 lstvAlerts.Items[i].Selected := True;
797 cmdProcessClick(Self);
798 ShowButts(False);
799 end;
800end;
801
802procedure TfrmPtSel.cmdProcessAllClick(Sender: TObject);
803var
804 i: integer;
805begin
806 if FAlertsNotReady then exit;
807 for i := 0 to lstvAlerts.Items.Count-1 do
808 lstvAlerts.Items[i].Selected := True;
809 cmdProcessClick(Self);
810 ShowButts(False);
811end;
812
813procedure TfrmPtSel.lstvAlertsDblClick(Sender: TObject);
814begin
815 cmdProcessClick(Self);
816end;
817
818procedure TfrmPtSel.cmdForwardClick(Sender: TObject);
819var
820 i: integer;
821 Alert: String;
822begin
823 if FAlertsNotReady then exit;
824 try
825 with lstvAlerts do
826 begin
827 if SelCount <= 0 then Exit;
828 for i := 0 to Items.Count - 1 do
829 if Items[i].Selected then
830 try
831 Alert := Items[i].SubItems[6] + '^' + Items[i].Subitems[0] + ': ' +
832 Items[i].Subitems[4];
833 ForwardAlertTo(Alert);
834 finally
835 Items[i].Selected := False;
836 end;
837 end;
838 finally
839 if lstvAlerts.SelCount <= 0 then ShowButts(False);
840 end;
841end;
842
843procedure TfrmPtSel.cmdRemoveClick(Sender: TObject);
844var
845 i: integer;
846begin
847 if FAlertsNotReady then exit;
848 with lstvAlerts do
849 begin
850 if SelCount <= 0 then Exit;
851 for i := 0 to Items.Count - 1 do
852 if Items[i].Selected then
853 begin
854 if Items[i].SubItems[7] = '1' then //remove flag enabled
855 DeleteAlertforUser(Items[i].SubItems[6])
856 else InfoBox('This alert cannot be removed.', Items[i].SubItems[0] + ': ' + Items[i].SubItems[4], MB_OK);
857 end;
858 end;
859 lstvAlerts.Clear;
860 AlertList;
861 FsortCol := -1; //CA - display alerts in correct sort
862 FormShow(Sender); //CA - display alerts in correct sort
863 if lstvAlerts.Items.Count = 0 then ShowButts(False);
864 if lstvAlerts.SelCount <= 0 then ShowButts(False);
865end;
866
867procedure TfrmPtSel.FormDestroy(Sender: TObject);
868begin
869 SaveUserBounds(Self);
870 frmFrame.EnduringPtSelSplitterPos := pnlPtSel.Height;
871 end;
872
873procedure TfrmPtSel.FormResize(Sender: TObject);
874begin
875 inherited;
876 FNotificationBtnsAdjusted := False;
877 AdjustButtonSize(cmdSaveList);
878 AdjustButtonSize(cmdProcessInfo);
879 AdjustButtonSize(cmdProcessAll);
880 AdjustButtonSize(cmdProcess);
881 AdjustButtonSize(cmdForward);
882 AdjustButtonSize(cmdComments);
883 AdjustButtonSize(cmdRemove);
884 AdjustNotificationButtons;
885end;
886
887procedure TfrmPtSel.pnlPtSelResize(Sender: TObject);
888begin
889 frmPtSelDemog.Left := cboPatient.Left + cboPatient.Width + 9;
890 // frmPtSelDemog.Width := frmPtSel.CmdCancel.Left - frmPtSelDemog.Left-2;// before vwpt enhancements pnlPtSel.Width - frmPtSelDemog.Left - 2;
891 frmPtSelOptns.Width := cboPatient.Left-8;
892end;
893
894procedure TfrmPtSel.Loaded;
895begin
896 inherited;
897// This needs to be in Loaded rather than FormCreate or the TORAutoPanel resize logic breaks.
898 //vwpt enhancements
899 CmdOK.parent := pnlPtSel;
900 CmdCancel.parent := pnlPtSel;
901 //end vwpt
902 frmPtSelDemog := TfrmPtSelDemog.Create(Self); // Was application - kcm
903 with frmPtSelDemog do
904 begin
905 parent := pnlPtSel;
906 Top := 4; //before vwpt change was 65
907 Left := cboPatient.Left + cboPatient.Width + 9;
908 //Width := pnlPtSel.Width - Left - 2; //before vwpt change
909 Width := CmdCancel.Left - Left-2 ;
910 TabOrder := cmdCancel.TabOrder + 1; //Place after cancel button
911 Show;
912 end;
913
914 with RadioGroup1 do
915 begin
916 parent := pnlPtSel;
917 TabOrder := cmdCancel.TabOrder + 2;
918 Show;
919 end;
920 //end vwpt enhancements
921
922 frmPtSelOptns := TfrmPtSelOptns.Create(Self); // Was application - kcm
923 with frmPtSelOptns do
924 begin
925 parent := pnlPtSel;
926 Top := 4;
927 Left := 4;
928 Width := cboPatient.Left-8;
929 SetCaptionTopProc := SetCaptionTop;
930 SetPtListTopProc := SetPtListTop;
931 if RPLProblem then
932 Exit;
933 TabOrder := cmdSaveList.TabOrder; //Put just before save default list button
934 Show;
935 end;
936 FLastPt := '';
937 //Begin at alert list, or patient listbox if no alerts
938 if lstvAlerts.Items.Count = 0 then
939 ActiveControl := cboPatient;
940end;
941
942procedure TfrmPtSel.RPLDisplay;
943begin
944
945// Make unneeded components invisible:
946cmdSaveList.visible := false;
947frmPtSelOptns.visible := false;
948
949end;
950
951procedure TfrmPtSel.FormClose(Sender: TObject; var Action: TCloseAction);
952var
953 colSizes : String;
954begin
955 colSizes := '';
956 with lstvAlerts do begin
957 colSizes := IntToStr(Columns[0].Width) + ','; //Info Caption
958 colSizes := colSizes + IntToStr(Columns[1].Width) + ','; //Patient SubItems[0]
959 colSizes := colSizes + IntToStr(Columns[2].Width) + ','; //Location SubItems[1]
960 colSizes := colSizes + IntToStr(Columns[3].Width) + ','; //Urgency SubItems[2]
961 colSizes := colSizes + IntToStr(Columns[4].Width) + ','; //Alert Date/Time SubItems[3]
962 colSizes := colSizes + IntToStr(Columns[5].Width) + ','; //Message Text SubItems[4]
963 colSizes := colSizes + IntToStr(Columns[6].Width); //Forwarded By/When SubItems[5]
964 end;
965 SizeHolder.SetSize(StrFPtSel_lstvAlerts_Co,colSizes);
966
967if (IsRPL = '1') then // Deal with restricted patient list users.
968 KillRPLPtList(RPLJob); // Kills server global data each time.
969 // (Global created by MakeRPLPtList in rCore.)
970end;
971
972procedure TfrmPtSel.FormCreate(Sender: TObject);
973begin
974 inherited;
975 DefaultButton := cmdOK;
976 FAlertsNotReady := FALSE;
977end;
978
979procedure TfrmPtSel.cboPatientKeyDown(Sender: TObject; var Key: Word;
980 Shift: TShiftState);
981begin
982 if (Key = Ord('D')) and (ssCtrl in Shift) then begin
983 Key := 0;
984 frmPtSelDemog.ToggleMemo;
985 end;
986end;
987
988function ConvertDate(var thisList: TStringList; listIndex: integer) : string;
989{
990 Convert date portion from yyyy/mm/dd to mm/dd/yyyy
991}
992var
993 //thisListItem: TListItem;
994 thisDateTime: string[16];
995 tempDt: string;
996 tempYr: string;
997 tempTime: string;
998 newDtTime: string;
999 k: byte;
1000 piece1: string;
1001 piece2: string;
1002 piece3: string;
1003 piece4: string;
1004 piece5: string;
1005 piece6: string;
1006 piece7: string;
1007 piece8: string;
1008 piece9: string;
1009 piece10: string;
1010 piece11: string;
1011begin
1012 piece1 := '';
1013 piece2 := '';
1014 piece3 := '';
1015 piece4 := '';
1016 piece5 := '';
1017 piece6 := '';
1018 piece7 := '';
1019 piece8 := '';
1020 piece9 := '';
1021 piece10 := '';
1022 piece11 := '';
1023
1024 piece1 := Piece(thisList[listIndex],U,1);
1025 piece2 := Piece(thisList[listIndex],U,2);
1026 piece3 := Piece(thisList[listIndex],U,3);
1027 piece4 := Piece(thisList[listIndex],U,4);
1028 //piece5 := Piece(thisList[listIndex],U,5);
1029 piece6 := Piece(thisList[listIndex],U,6);
1030 piece7 := Piece(thisList[listIndex],U,7);
1031 piece8 := Piece(thisList[listIndex],U,8);
1032 piece9 := Piece(thisList[listIndex],U,9);
1033 piece10 := Piece(thisList[listIndex],U,1);
1034
1035 thisDateTime := Piece(thisList[listIndex],U,5);
1036
1037 tempYr := '';
1038 for k := 1 to 4 do
1039 tempYr := tempYr + thisDateTime[k];
1040
1041 tempDt := '';
1042 for k := 6 to 10 do
1043 tempDt := tempDt + thisDateTime[k];
1044
1045 tempTime := '';
1046 //Use 'Length' to prevent stuffing the control chars into the date when a trailing zero is missing
1047 for k := 11 to Length(thisDateTime) do //16 do
1048 tempTime := tempTime + thisDateTime[k];
1049
1050 newDtTime := '';
1051 newDtTime := newDtTime + tempDt + '/' + tempYr + tempTime;
1052 piece5 := newDtTime;
1053
1054 Result := piece1 +U+ piece2 +U+ piece3 +U+ piece4 +U+ piece5 +U+ piece6 +U+ piece7 +U+ piece8 +U+ piece9 +U+ piece10 +U+ piece11;
1055end;
1056
1057procedure TfrmPtSel.AlertList;
1058var
1059 List: TStringList;
1060 NewItem: TListItem;
1061 I,J: Integer;
1062 Comment,colSizes : String;
1063begin
1064 // Load the items
1065 colSizes := '';
1066 lstvAlerts.Items.Clear;
1067 List := TStringList.Create;
1068 NewItem := nil;
1069 try
1070 LoadNotifications(List);
1071 for I := 0 to List.Count - 1 do
1072 begin
1073 // List[i] := ConvertDate(List, i); //cla commented out 8/9/04 CQ #4749
1074
1075 if Piece(List[I], U, 1) <> 'Forwarded by: ' then
1076 begin
1077 NewItem := lstvAlerts.Items.Add;
1078 NewItem.Caption := Piece(List[I], U, 1);
1079 for J := 2 to DelimCount(List[I], U) + 1 do
1080 NewItem.SubItems.Add(Piece(List[I], U, J));
1081 end
1082 else //this list item is forwarding information
1083 begin
1084 NewItem.SubItems[5] := Piece(List[I], U, 2);
1085 Comment := Piece(List[I], U, 3);
1086 if Length(Comment) > 0 then NewItem.SubItems[8] := 'Fwd Comment: ' + Comment;
1087 end;
1088 end;
1089 finally
1090 List.Free;
1091 end;
1092 with lstvAlerts do
1093 begin
1094 colSizes := SizeHolder.GetSize(StrFPtSel_lstvAlerts_Co);
1095 if colSizes = '' then begin
1096 Columns[0].Width := 40; //Info Caption
1097 Columns[1].Width := 195; //Patient SubItems[0]
1098 Columns[2].Width := 75; //Location SubItems[1]
1099 Columns[3].Width := 95; //Urgency SubItems[2]
1100 Columns[4].Width := 150; //Alert Date/Time SubItems[3]
1101 Columns[5].Width := 310; //Message Text SubItems[4]
1102 Columns[6].Width := 290; //Forwarded By/When SubItems[5]
1103 end else begin
1104 Columns[0].Width := StrToInt(piece(colSizes,',',1)); //Info Caption
1105 Columns[1].Width := StrToInt(piece(colSizes,',',2)); //Patient SubItems[0]
1106 Columns[2].Width := StrToInt(piece(colSizes,',',3)); //Location SubItems[1]
1107 Columns[3].Width := StrToInt(piece(colSizes,',',4)); //Urgency SubItems[2]
1108 Columns[4].Width := StrToInt(piece(colSizes,',',5)); //Alert Date/Time SubItems[3]
1109 Columns[5].Width := StrToInt(piece(colSizes,',',6)); //Message Text SubItems[4]
1110 Columns[6].Width := StrToInt(piece(colSizes,',',7)); //Forwarded By/When SubItems[5]
1111 end;
1112
1113 //Items not displayed in Columns: XQAID SubItems[6]
1114 // Remove w/o process SubItems[7]
1115 // Forwarding comments SubItems[8]
1116 end;
1117 //with lstvAlerts do ca comment out 12/24/03 to prevent default selection of first alert on list
1118 //if (ItemIndex = -1) and (Items.Count > 0) then
1119 //ItemIndex := 0;
1120end;
1121
1122procedure TfrmPtSel.lstvAlertsColumnClick(Sender: TObject; Column: TListColumn);
1123begin
1124
1125 if (FsortCol = Column.Index) then
1126 FsortAscending := not FsortAscending;
1127
1128 if FsortAscending then
1129 FsortDirection := 'F'
1130 else
1131 FsortDirection := 'R';
1132
1133 FsortCol := Column.Index;
1134
1135 if FsortCol = 4 then
1136 ReformatAlertDateTime // hds7397- ge 2/6/6 sort and display date/time column correctly - as requested
1137 else
1138 lstvAlerts.AlphaSort;
1139
1140 //Set the Notifications sort method to last-used sort-type
1141 //ie., user clicked on which column header last use of CPRS?
1142 case Column.Index of
1143 0: rCore.SetSortMethod('I', FsortDirection);
1144 1: rCore.SetSortMethod('P', FsortDirection);
1145 2: rCore.SetSortMethod('L', FsortDirection);
1146 3: rCore.SetSortMethod('U', FsortDirection);
1147 4: rCore.SetSortMethod('D', FsortDirection);
1148 5: rCore.SetSortMethod('M', FsortDirection);
1149 6: rCore.SetSortMethod('F', FsortDirection);
1150 end;
1151end;
1152
1153procedure TfrmPtSel.lstvAlertsCompare(Sender: TObject; Item1, Item2: TListItem; Data: Integer; var Compare: Integer);
1154begin
1155 if not(Sender is TListView) then Exit;
1156 if FsortAscending then
1157 begin
1158 if FsortCol = 0 then Compare := CompareStr(Item1.Caption, Item2.Caption)
1159 else Compare := CompareStr(Item1.SubItems[FsortCol - 1], Item2.SubItems[FsortCol - 1]);
1160 end
1161 else
1162 begin
1163 if FsortCol = 0 then Compare := CompareStr(Item2.Caption, Item1.Caption)
1164 else Compare := CompareStr(Item2.SubItems[FsortCol - 1], Item1.SubItems[FsortCol - 1]);
1165 end;
1166end;
1167
1168function TfrmPtSel.DupLastSSN(const DFN: string): Boolean;
1169var
1170 i: integer;
1171 frmPtDupSel: tForm;
1172begin
1173 Result := False;
1174
1175 // Check data on server for duplicates:
1176 CallV('DG CHK BS5 XREF ARRAY', [DFN]);
1177 if (RPCBrokerV.Results[0] <> '1') then // No duplicates found.
1178 Exit;
1179 Result := True;
1180 PtStrs := TStringList.Create;
1181 with RPCBrokerV do if Results.Count > 0 then
1182 begin
1183 for i := 1 to Results.Count - 1 do
1184 begin
1185 if Piece(Results[i], U, 1) = '1' then
1186 PtStrs.Add(Piece(Results[i], U, 2) + U + Piece(Results[i], U, 3) + U +
1187 FormatFMDateTimeStr('mmm dd,yyyy', Piece(Results[i], U, 4)) + U +
1188 Piece(Results[i], U, 5));
1189 end;
1190 end;
1191
1192 // Call form to get user's selection from expanded duplicate pt. list (resets DupDFN variable if applicable):
1193 DupDFN := DFN;
1194 frmPtDupSel:= TfrmDupPts.Create(Application);
1195 with frmPtDupSel do
1196 begin
1197 try
1198 ShowModal;
1199 finally
1200 frmPtDupSel.Release;
1201 end;
1202 end;
1203end;
1204
1205procedure TfrmPtSel.ShowFlagInfo;
1206begin
1207 if (Pos('*SENSITIVE*',frmPtSelDemog.lblPtSSN.Caption)>0) then
1208 begin
1209// pnlPrf.Visible := False;
1210 Exit;
1211 end;
1212 if (flastpt <> cboPatient.ItemID) then
1213 begin
1214 HasActiveFlg(FlagList, HasFlag, cboPatient.ItemID);
1215 flastpt := cboPatient.ItemID;
1216 end;
1217 if HasFlag then
1218 begin
1219// FastAssign(FlagList, lstFlags.Items);
1220// pnlPrf.Visible := True;
1221 end
1222 //else pnlPrf.Visible := False;
1223end;
1224
1225procedure TfrmPtSel.lstFlagsClick(Sender: TObject);
1226begin
1227{ if lstFlags.ItemIndex >= 0 then
1228 ShowFlags(lstFlags.ItemID); }
1229end;
1230
1231procedure TfrmPtSel.lstFlagsKeyDown(Sender: TObject; var Key: Word;
1232 Shift: TShiftState);
1233begin
1234 if Key = VK_RETURN then
1235 lstFlagsClick(Self);
1236end;
1237
1238procedure TfrmPtSel.lstvAlertsSelectItem(Sender: TObject; Item: TListItem;
1239 Selected: Boolean);
1240begin
1241 if ScreenReaderSystemActive then
1242 begin
1243 FAlertsNotReady := TRUE;
1244 PostMessage(Handle, UM_MISC, 0, 0);
1245 end
1246 else
1247 ReadyAlert;
1248end;
1249
1250procedure TfrmPtSel.ShowButts(ShowButts: Boolean);
1251begin
1252 cmdProcess.Enabled := ShowButts;
1253 cmdRemove.Enabled := ShowButts;
1254 cmdForward.Enabled := ShowButts;
1255 cmdComments.Enabled := ShowButts and (lstvAlerts.SelCount = 1) and (lstvAlerts.Selected.SubItems[8] <> '');
1256end;
1257
1258procedure TfrmPtSel.lstvAlertsInfoTip(Sender: TObject; Item: TListItem;
1259 var InfoTip: String);
1260begin
1261 InfoTip := Item.SubItems[8];
1262end;
1263
1264procedure TfrmPtSel.lstvAlertsKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
1265{
1266 //KW
1267 508: Allow non-sighted users to sort Notifications using Ctrl + <key>
1268 Numbers in case stmnt are ASCII values for character keys.
1269}
1270begin
1271 if FAlertsNotReady then exit;
1272 if lstvAlerts.Focused then
1273 begin
1274 case Key of
1275 VK_RETURN: cmdProcessClick(Sender); //Process all selected alerts
1276 73,105: if (ssCtrl in Shift) then lstvAlertsColumnClick(Sender, lstvAlerts.Columns[0]); //I,i
1277 80,113: if (ssCtrl in Shift) then lstvAlertsColumnClick(Sender, lstvAlerts.Columns[1]); //P,p
1278 76,108: if (ssCtrl in Shift) then lstvAlertsColumnClick(Sender, lstvAlerts.Columns[2]); //L,l
1279 85,117: if (ssCtrl in Shift) then lstvAlertsColumnClick(Sender, lstvAlerts.Columns[3]); //U,u
1280 68,100: if (ssCtrl in Shift) then lstvAlertsColumnClick(Sender, lstvAlerts.Columns[4]); //D,d
1281 77,109: if (ssCtrl in Shift) then lstvAlertsColumnClick(Sender, lstvAlerts.Columns[5]); //M,m
1282 70,102: if (ssCtrl in Shift) then lstvAlertsColumnClick(Sender, lstvAlerts.Columns[6]); //F,f
1283 end;
1284 end;
1285end;
1286
1287procedure TfrmPtSel.FormShow(Sender: TObject);
1288{
1289 //KW
1290 Sort Alerts by last-used method for current user
1291}
1292var
1293 sortResult: string;
1294 sortMethod: string;
1295begin
1296 sortResult := rCore.GetSortMethod;
1297 sortMethod := Piece(sortResult, U, 1);
1298 FsortDirection := Piece(sortResult, U, 2);
1299 if FsortDirection = 'F' then
1300 FsortAscending := true
1301 else
1302 FsortAscending := false;
1303
1304 case sortMethod[1] of
1305 'I','i': lstvAlertsColumnClick(Sender, lstvAlerts.Columns[0]);
1306 'P','p': lstvAlertsColumnClick(Sender, lstvAlerts.Columns[1]);
1307 'L','l': lstvAlertsColumnClick(Sender, lstvAlerts.Columns[2]);
1308 'U','u': lstvAlertsColumnClick(Sender, lstvAlerts.Columns[3]);
1309 'D','d': lstvAlertsColumnClick(Sender, lstvAlerts.Columns[4]);
1310 'M','m': lstvAlertsColumnClick(Sender, lstvAlerts.Columns[5]);
1311 'F','f': lstvAlertsColumnClick(Sender, lstvAlerts.Columns[6]);
1312 end;
1313
1314end;
1315
1316//hds7397- ge 2/6/6 sort and display date/time column correctly - as requested
1317procedure TfrmPtSel.ReadyAlert;
1318begin
1319 if lstvAlerts.SelCount <= 0 then ShowButts(False)
1320 else ShowButts(True);
1321 GetBAStatus(User.DUZ,Patient.DFN);
1322 FAlertsNotReady := FALSE;
1323end;
1324
1325procedure TfrmPtSel.ReformatAlertDateTime;
1326var
1327 I,J: Integer;
1328 inDateStr, holdDayTime,srtDate: String;
1329begin
1330 // convert date to yyyy/mm/dd prior to sort.
1331 for J := 0 to lstvAlerts.items.count -1 do
1332 begin
1333 inDateStr := '';
1334 srtDate := '';
1335 holdDayTime := '';
1336 inDateStr := lstvAlerts.Items[j].SubItems[3];
1337 srtDate := ( (Piece( Piece(inDateStr,'/',3), '@',1)) + '/' + Piece(inDateStr,'/',1) + '/' + Piece(inDateStr,'/',2) +'@'+ Piece(inDateStr, '@',2) );
1338 lstvAlerts.Items[j].SubItems[3] := srtDate;
1339 end;
1340 //sort the listview records by date
1341 lstvAlerts.AlphaSort;
1342 // loop thru lstvAlerts change date to yyyy/mm/dd
1343 // sort list
1344 // change alert date/time back to mm/dd/yyyy@time for display
1345 for I := 0 to lstvAlerts.items.Count -1 do
1346 begin
1347 inDateStr := '';
1348 srtDate := '';
1349 holdDayTime := '';
1350 inDateStr := lstvAlerts.Items[i].SubItems[3];
1351 holdDayTime := Piece(inDateStr,'/',3); // dd@time
1352 lstvAlerts.Items[i].SubItems[3] := (Piece(inDateStr, '/', 2) + '/' + Piece(holdDayTime, '@',1) +'/'
1353 + Piece(inDateStr,'/',1) + '@' + Piece(holdDayTime,'@',2) );
1354 end;
1355end;
1356
1357procedure TfrmPtSel.AdjustButtonSize(pButton:TButton);
1358var
1359thisButton: TButton;
1360const Gap = 5;
1361begin
1362 thisButton := pButton;
1363 if thisButton.Width < frmFrame.Canvas.TextWidth(thisButton.Caption) then //CQ2737 GE
1364 begin
1365 FNotificationBtnsAdjusted := (thisButton.Width < frmFrame.Canvas.TextWidth(thisButton.Caption));
1366 thisButton.Width := (frmFrame.Canvas.TextWidth(thisButton.Caption) + Gap+Gap); //CQ2737 GE
1367 end;
1368 if thisButton.Height < frmFrame.Canvas.TextHeight(thisButton.Caption) then //CQ2737 GE
1369 thisButton.Height := (frmFrame.Canvas.TextHeight(thisButton.Caption) + Gap); //CQ2737 GE
1370end;
1371
1372procedure TfrmPtSel.AdjustNotificationButtons;
1373const
1374 Gap = 10; BigGap = 40;
1375 // reposition buttons after resizing eliminate overlap.
1376begin
1377 if FNotificationBtnsAdjusted then
1378 begin
1379 cmdProcessAll.Left := (cmdProcessInfo.Left + cmdProcessInfo.Width + Gap);
1380 cmdProcess.Left := (cmdProcessAll.Left + cmdProcessAll.Width + Gap);
1381 cmdForward.Left := (cmdProcess.Left + cmdProcess.Width + Gap);
1382 cmdComments.Left := (cmdForward.Left + cmdForward.Width + Gap);
1383 cmdRemove.Left := (cmdComments.Left + cmdComments.Width + BigGap);
1384 end;
1385end;
1386
1387//vwpt enhanced //
1388procedure TfrmPtSel.onclick1(Sender: TObject); //click on RadioGroup1
1389var index :integer;
1390
1391begin
1392if RadioGroup1.ItemIndex >0 then
1393 begin
1394 itimson := 1 ;
1395 cboPatient.Text := '' ;
1396 if (frmPtSelOptns.radAll.Checked <> True)and (frmPtSelOptns.radDflt.Checked <> True) then
1397 begin
1398 radiogrp1index :=0 ;
1399 RadioGroup1.ItemIndex := 0;
1400 RadioGroup1.SetFocus;
1401 RadioGroup1.Refresh;
1402 end
1403 else
1404 begin
1405 index := RadioGroup1.ItemIndex;
1406 radiogrp1index := index;
1407 cboPatient.Hint := 'Enter ' + piece(RadioGroup1.Items[index],'&',2);
1408 end ;
1409 end
1410 else
1411 begin
1412 //itimson := 0;
1413 cboPatient.Hint := 'Enter name,Full SSN,Last4(x1234),''HRN'',DOB,or Phone#' ;
1414 radiogrp1index := 0;
1415 end;
1416
1417end;
1418 //end vwpt enhanced
1419
1420
1421end.
Note: See TracBrowser for help on using the repository browser.