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

Last change on this file since 756 was 456, checked in by Kevin Toppenberg, 16 years ago

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