source: cprs/branches/HealthSevak-CPRS/CPRS-Chart/fPtSel.pas@ 1797

Last change on this file since 1797 was 1693, checked in by healthsevak, 10 years ago

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