source: cprs/branches/foia-cprs/CPRS-Chart/fPtSel.pas@ 834

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

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