source: cprs/branches/tmg-cprs/CPRS-Chart/fPtSel.pas@ 799

Last change on this file since 799 was 793, checked in by Kevin Toppenberg, 15 years ago

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