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

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

Fixed crash on non-login
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
755 enableclose := true;
756 end
757 else
758 DeleteAlert(XQAID);
759 end
760 else //other alerts cannot be processed
761 InfoBox('This alert cannot be processed by the CPRS GUI.', Items[i].SubItems[0] + ': ' + Items[i].SubItems[4], MB_OK); end;
762 if enableclose = true then
763 Close
764 else
765 begin
766 ggeInfo.Visible := False;
767 // Update notification list:
768 lstvAlerts.Clear;
769 AlertList;
770 //display alerts sorted according to parameter settings:
771 FsortCol := -1; //CA - display alerts in correct sort
772 FormShow(Sender);
773 end;
774 if Items.Count = 0 then ShowButts(False);
775 if SelCount <= 0 then ShowButts(False);
776 end;
777 GetBAStatus(User.DUZ,Patient.DFN);
778end;
779
780procedure TfrmPtSel.cmdSaveListClick(Sender: TObject);
781begin
782 frmPtSelOptns.cmdSaveListClick(Sender);
783end;
784
785procedure TfrmPtSel.cmdProcessInfoClick(Sender: TObject);
786 // Select and process all items that are information only in the lstvAlerts list box.
787var
788 i: integer;
789begin
790 if lstvAlerts.Items.Count = 0 then Exit;
791 if InfoBox('You are about to process all your INFORMATION alerts.' + CRLF
792 + 'These alerts will not be presented to you for individual' + CRLF
793 + 'review and they will be permanently removed from your' + CRLF
794 + 'alert list. Do you wish to continue?',
795 'Warning', MB_YESNO or MB_ICONWARNING) = IDYES then
796 begin
797 for i := 0 to lstvAlerts.Items.Count-1 do
798 lstvAlerts.Items[i].Selected := False; //clear any selected alerts so they aren't processed
799 for i := 0 to lstvAlerts.Items.Count-1 do
800 if lstvAlerts.Items[i].Caption = 'I' then
801 lstvAlerts.Items[i].Selected := True;
802 cmdProcessClick(Self);
803 ShowButts(False);
804 end;
805end;
806
807procedure TfrmPtSel.cmdProcessAllClick(Sender: TObject);
808var
809 i: integer;
810begin
811 for i := 0 to lstvAlerts.Items.Count-1 do
812 lstvAlerts.Items[i].Selected := True;
813 cmdProcessClick(Self);
814 ShowButts(False);
815end;
816
817procedure TfrmPtSel.lstvAlertsDblClick(Sender: TObject);
818begin
819 cmdProcessClick(Self);
820end;
821
822procedure TfrmPtSel.cmdForwardClick(Sender: TObject);
823var
824 i: integer;
825 Alert: String;
826begin
827 try
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 try
834 Alert := Items[i].SubItems[6] + '^' + Items[i].Subitems[0] + ': ' +
835 Items[i].Subitems[4];
836 ForwardAlertTo(Alert);
837 finally
838 Items[i].Selected := False;
839 end;
840 end;
841 finally
842 if lstvAlerts.SelCount <= 0 then ShowButts(False);
843 end;
844end;
845
846procedure TfrmPtSel.cmdRemoveClick(Sender: TObject);
847var
848 i: integer;
849begin
850 with lstvAlerts do
851 begin
852 if SelCount <= 0 then Exit;
853 for i := 0 to Items.Count - 1 do
854 if Items[i].Selected then
855 begin
856 if Items[i].SubItems[7] = '1' then //remove flag enabled
857 DeleteAlertforUser(Items[i].SubItems[6])
858 else InfoBox('This alert cannot be removed.', Items[i].SubItems[0] + ': ' + Items[i].SubItems[4], MB_OK);
859 end;
860 end;
861 lstvAlerts.Clear;
862 AlertList;
863 FsortCol := -1; //CA - display alerts in correct sort
864 FormShow(Sender); //CA - display alerts in correct sort
865 if lstvAlerts.Items.Count = 0 then ShowButts(False);
866 if lstvAlerts.SelCount <= 0 then ShowButts(False);
867end;
868
869procedure TfrmPtSel.FormDestroy(Sender: TObject);
870begin
871 SaveUserBounds(Self);
872 frmFrame.EnduringPtSelSplitterPos := pnlPtSel.Height;
873 end;
874
875procedure TfrmPtSel.pnlPtSelResize(Sender: TObject);
876begin
877 frmPtSelDemog.Left := cboPatient.Left + cboPatient.Width + 9;
878 frmPtSelDemog.Width := pnlPtSel.Width - frmPtSelDemog.Left - 2;
879 frmPtSelOptns.Width := cboPatient.Left-8;
880 //kt ... didn't work.... frmPtSelOptns.Height := 184; //kt added to prevent resizing (anchor settings not effective)
881end;
882
883procedure TfrmPtSel.Loaded;
884begin
885 inherited;
886// This needs to be in Loaded rather than FormCreate or the TORAutoPanel resize logic breaks.
887 frmPtSelDemog := TfrmPtSelDemog.Create(Self); // Was application - kcm
888 with frmPtSelDemog do
889 begin
890 parent := pnlPtSel;
891 Top := 65;
892 Left := cboPatient.Left + cboPatient.Width + 9;
893 Width := pnlPtSel.Width - Left - 2;
894 TabOrder := cmdCancel.TabOrder + 1; //Place after cancel button
895 Show;
896 SendToBack; //kt added to keep from writing over other "In-Depth" component
897 end;
898
899 frmPtSelOptns := TfrmPtSelOptns.Create(Self); // Was application - kcm
900 with frmPtSelOptns do
901 begin
902 parent := pnlPtSel;
903 Top := 4;
904 Left := 4;
905 Width := cboPatient.Left-8;
906 SetCaptionTopProc := SetCaptionTop;
907 SetPtListTopProc := SetPtListTop;
908 if RPLProblem then
909 Exit;
910 TabOrder := cmdSaveList.TabOrder; //Put just before save default list button
911 Show;
912 end;
913 FLastPt := '';
914 //Begin at alert list, or patient listbox if no alerts
915 if lstvAlerts.Items.Count = 0 then
916 ActiveControl := cboPatient;
917end;
918
919procedure TfrmPtSel.RPLDisplay;
920begin
921
922// Make unneeded components invisible:
923cmdSaveList.visible := false;
924frmPtSelOptns.visible := false;
925
926end;
927
928procedure TfrmPtSel.FormClose(Sender: TObject; var Action: TCloseAction);
929begin
930
931if (IsRPL = '1') then // Deal with restricted patient list users.
932 KillRPLPtList(RPLJob); // Kills server global data each time.
933 // (Global created by MakeRPLPtList in rCore.)
934end;
935
936procedure TfrmPtSel.cboPatientKeyDown(Sender: TObject; var Key: Word;
937 Shift: TShiftState);
938begin
939 if (Key = Ord('D')) and (ssCtrl in Shift) then begin
940 Key := 0;
941 frmPtSelDemog.ToggleMemo;
942 end;
943end;
944
945function ConvertDate(var thisList: TStringList; listIndex: integer) : string;
946{
947 Convert date portion from yyyy/mm/dd to mm/dd/yyyy
948}
949var
950 //thisListItem: TListItem;
951 thisDateTime: string[16];
952 tempDt: string;
953 tempYr: string;
954 tempTime: string;
955 newDtTime: string;
956 k: byte;
957 piece1: string;
958 piece2: string;
959 piece3: string;
960 piece4: string;
961 piece5: string;
962 piece6: string;
963 piece7: string;
964 piece8: string;
965 piece9: string;
966 piece10: string;
967 piece11: string;
968begin
969 piece1 := '';
970 piece2 := '';
971 piece3 := '';
972 piece4 := '';
973 piece5 := '';
974 piece6 := '';
975 piece7 := '';
976 piece8 := '';
977 piece9 := '';
978 piece10 := '';
979 piece11 := '';
980
981 piece1 := Piece(thisList[listIndex],U,1);
982 piece2 := Piece(thisList[listIndex],U,2);
983 piece3 := Piece(thisList[listIndex],U,3);
984 piece4 := Piece(thisList[listIndex],U,4);
985 //piece5 := Piece(thisList[listIndex],U,5);
986 piece6 := Piece(thisList[listIndex],U,6);
987 piece7 := Piece(thisList[listIndex],U,7);
988 piece8 := Piece(thisList[listIndex],U,8);
989 piece9 := Piece(thisList[listIndex],U,9);
990 piece10 := Piece(thisList[listIndex],U,1);
991
992 thisDateTime := Piece(thisList[listIndex],U,5);
993
994 tempYr := '';
995 for k := 1 to 4 do
996 tempYr := tempYr + thisDateTime[k];
997
998 tempDt := '';
999 for k := 6 to 10 do
1000 tempDt := tempDt + thisDateTime[k];
1001
1002 tempTime := '';
1003 //Use 'Length' to prevent stuffing the control chars into the date when a trailing zero is missing
1004 for k := 11 to Length(thisDateTime) do //16 do
1005 tempTime := tempTime + thisDateTime[k];
1006
1007 newDtTime := '';
1008 newDtTime := newDtTime + tempDt + '/' + tempYr + tempTime;
1009 piece5 := newDtTime;
1010
1011 Result := piece1 +U+ piece2 +U+ piece3 +U+ piece4 +U+ piece5 +U+ piece6 +U+ piece7 +U+ piece8 +U+ piece9 +U+ piece10 +U+ piece11;
1012end;
1013
1014procedure TfrmPtSel.AlertList;
1015var
1016 List: TStringList;
1017 NewItem: TListItem;
1018 I,J: Integer;
1019 Comment: String;
1020begin
1021 // Load the items
1022 lstvAlerts.Items.Clear;
1023 List := TStringList.Create;
1024 NewItem := nil;
1025 try
1026 LoadNotifications(List);
1027 for I := 0 to List.Count - 1 do
1028 begin
1029 // List[i] := ConvertDate(List, i); //cla commented out 8/9/04 CQ #4749
1030
1031 if Piece(List[I], U, 1) <> 'Forwarded by: ' then
1032 begin
1033 NewItem := lstvAlerts.Items.Add;
1034 NewItem.Caption := Piece(List[I], U, 1);
1035 for J := 2 to DelimCount(List[I], U) + 1 do
1036 NewItem.SubItems.Add(Piece(List[I], U, J));
1037 end
1038 else //this list item is forwarding information
1039 begin
1040 NewItem.SubItems[5] := Piece(List[I], U, 2);
1041 Comment := Piece(List[I], U, 3);
1042 if Length(Comment) > 0 then NewItem.SubItems[8] := 'Fwd Comment: ' + Comment;
1043 end;
1044 end;
1045 finally
1046 List.Free;
1047 end;
1048 with lstvAlerts do
1049 begin
1050 Columns[0].Width := 30; //Info Caption
1051 Columns[1].Width := 120; //Patient SubItems[0]
1052 Columns[2].Width := 60; //Location SubItems[1]
1053 Columns[3].Width := 60; //Urgency SubItems[2]
1054 Columns[4].Width := 110; //Alert Date/Time SubItems[3]
1055 Columns[5].Width := 312; //Message Text SubItems[4]
1056 Columns[6].Width := 210; //Forwarded By/When SubItems[5]
1057 //Items not displayed in Columns: XQAID SubItems[6]
1058 // Remove w/o process SubItems[7]
1059 // Forwarding comments SubItems[8]
1060 end;
1061 //with lstvAlerts do ca comment out 12/24/03 to prevent default selection of first alert on list
1062 //if (ItemIndex = -1) and (Items.Count > 0) then
1063 //ItemIndex := 0;
1064end;
1065
1066procedure TfrmPtSel.lstvAlertsColumnClick(Sender: TObject; Column: TListColumn);
1067begin
1068
1069 if ((FsortCol = Column.Index) and (not SortViaKeyboard)) then
1070 FsortAscending := not FsortAscending;
1071
1072 if FsortAscending then
1073 FsortDirection := 'F'
1074 else
1075 FsortDirection := 'R';
1076
1077 FsortCol := Column.Index;
1078
1079 if FsortCol = 4 then
1080 ReformatAlertDateTime // hds7397- ge 2/6/6 sort and display date/time column correctly - as requested
1081 else
1082 lstvAlerts.AlphaSort;
1083 SortViaKeyboard := false;
1084
1085
1086 //Set the Notifications sort method to last-used sort-type
1087 //ie., user clicked on which column header last use of CPRS?
1088 case Column.Index of
1089 0: rCore.SetSortMethod('I', FsortDirection);
1090 1: rCore.SetSortMethod('P', FsortDirection);
1091 2: rCore.SetSortMethod('L', FsortDirection);
1092 3: rCore.SetSortMethod('U', FsortDirection);
1093 4: rCore.SetSortMethod('D', FsortDirection);
1094 5: rCore.SetSortMethod('M', FsortDirection);
1095 6: rCore.SetSortMethod('F', FsortDirection);
1096 end;
1097end;
1098
1099procedure TfrmPtSel.lstvAlertsCompare(Sender: TObject; Item1, Item2: TListItem; Data: Integer; var Compare: Integer);
1100begin
1101 if not(Sender is TListView) then Exit;
1102 if FsortAscending then
1103 begin
1104 if FsortCol = 0 then Compare := CompareStr(Item1.Caption, Item2.Caption)
1105 else Compare := CompareStr(Item1.SubItems[FsortCol - 1], Item2.SubItems[FsortCol - 1]);
1106 end
1107 else
1108 begin
1109 if FsortCol = 0 then Compare := CompareStr(Item2.Caption, Item1.Caption)
1110 else Compare := CompareStr(Item2.SubItems[FsortCol - 1], Item1.SubItems[FsortCol - 1]);
1111 end;
1112end;
1113
1114function TfrmPtSel.DupLastSSN(const DFN: string): Boolean;
1115var
1116 i: integer;
1117 frmPtDupSel: tForm;
1118begin
1119 Result := False;
1120
1121 // Check data on server for duplicates:
1122 CallV('DG CHK BS5 XREF ARRAY', [DFN]);
1123 if (RPCBrokerV.Results[0] <> '1') then // No duplicates found.
1124 Exit;
1125 Result := True;
1126 PtStrs := TStringList.Create;
1127 with RPCBrokerV do if Results.Count > 0 then
1128 begin
1129 for i := 1 to Results.Count - 1 do
1130 begin
1131 if Piece(Results[i], U, 1) = '1' then
1132 PtStrs.Add(Piece(Results[i], U, 2) + U + Piece(Results[i], U, 3) + U +
1133 FormatFMDateTimeStr('mmm dd,yyyy', Piece(Results[i], U, 4)) + U +
1134 Piece(Results[i], U, 5));
1135 end;
1136 end;
1137
1138 // Call form to get user's selection from expanded duplicate pt. list (resets DupDFN variable if applicable):
1139 DupDFN := DFN;
1140 frmPtDupSel:= TfrmDupPts.Create(Application);
1141 with frmPtDupSel do
1142 begin
1143 try
1144 ShowModal;
1145 finally
1146 frmPtDupSel.Release;
1147 end;
1148 end;
1149end;
1150
1151procedure TfrmPtSel.ShowFlagInfo;
1152begin
1153 if (Pos('*SENSITIVE*',frmPtSelDemog.lblPtSSN.Caption)>0) then
1154 begin
1155// pnlPrf.Visible := False;
1156 Exit;
1157 end;
1158 if (flastpt <> cboPatient.ItemID) then
1159 begin
1160 HasActiveFlg(FlagList, HasFlag, cboPatient.ItemID);
1161 flastpt := cboPatient.ItemID;
1162 end;
1163 if HasFlag then
1164 begin
1165// lstFlags.Items.Assign(FlagList);
1166// pnlPrf.Visible := True;
1167 end
1168 //else pnlPrf.Visible := False;
1169end;
1170
1171procedure TfrmPtSel.lstFlagsClick(Sender: TObject);
1172begin
1173{ if lstFlags.ItemIndex >= 0 then
1174 ShowFlags(lstFlags.ItemID); }
1175end;
1176
1177procedure TfrmPtSel.lstFlagsKeyDown(Sender: TObject; var Key: Word;
1178 Shift: TShiftState);
1179begin
1180 if Key = VK_RETURN then
1181 lstFlagsClick(Self);
1182end;
1183
1184procedure TfrmPtSel.lstvAlertsSelectItem(Sender: TObject; Item: TListItem;
1185 Selected: Boolean);
1186begin
1187 if lstvAlerts.SelCount <= 0 then ShowButts(False)
1188 else ShowButts(True);
1189 GetBAStatus(User.DUZ,Patient.DFN);
1190end;
1191
1192procedure TfrmPtSel.ShowButts(ShowButts: Boolean);
1193begin
1194 cmdProcess.Enabled := ShowButts;
1195 cmdRemove.Enabled := ShowButts;
1196 cmdForward.Enabled := ShowButts;
1197end;
1198
1199procedure TfrmPtSel.lstvAlertsInfoTip(Sender: TObject; Item: TListItem;
1200 var InfoTip: String);
1201begin
1202 InfoTip := Item.SubItems[8];
1203end;
1204
1205procedure TfrmPtSel.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
1206{
1207var
1208 keyValue: word;
1209}
1210begin{
1211 keyValue := MapVirtualKey(Key,2);
1212 if keyValue = VK_RETURN then
1213 cmdProcessClick(Sender);
1214}
1215end;
1216
1217procedure TfrmPtSel.lstvAlertsKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
1218{
1219 //KW
1220 508: Allow non-sighted users to sort Notifications using Ctrl + <key>
1221 Numbers in case stmnt are ASCII values for character keys.
1222}
1223begin
1224 if lstvAlerts.Focused then
1225 begin
1226 SortViaKeyboard := true;
1227 case Key of
1228 VK_RETURN: cmdProcessClick(Sender); //Process all selected alerts
1229 73,105: if (ssCtrl in Shift) then lstvAlertsColumnClick(Sender, lstvAlerts.Columns[0]); //I,i
1230 80,113: if (ssCtrl in Shift) then lstvAlertsColumnClick(Sender, lstvAlerts.Columns[1]); //P,p
1231 76,108: if (ssCtrl in Shift) then lstvAlertsColumnClick(Sender, lstvAlerts.Columns[2]); //L,l
1232 85,117: if (ssCtrl in Shift) then lstvAlertsColumnClick(Sender, lstvAlerts.Columns[3]); //U,u
1233 68,100: if (ssCtrl in Shift) then lstvAlertsColumnClick(Sender, lstvAlerts.Columns[4]); //D,d
1234 77,109: if (ssCtrl in Shift) then lstvAlertsColumnClick(Sender, lstvAlerts.Columns[5]); //M,m
1235 70,102: if (ssCtrl in Shift) then lstvAlertsColumnClick(Sender, lstvAlerts.Columns[6]); //F,f
1236 end;
1237 end;
1238end;
1239
1240procedure TfrmPtSel.FormShow(Sender: TObject);
1241{
1242 //KW
1243 Sort Alerts by last-used method for current user
1244}
1245var
1246 sortResult: string;
1247 sortMethod: string;
1248begin
1249 //kt TMGcmdAdd.Enabled := (frmPtAdd <> nil); //kt Disable button when first starting up...
1250 sortResult := rCore.GetSortMethod;
1251 sortMethod := Piece(sortResult, U, 1);
1252 FsortDirection := Piece(sortResult, U, 2);
1253 if FsortDirection = 'F' then
1254 FsortAscending := true
1255 else
1256 FsortAscending := false;
1257
1258 case sortMethod[1] of
1259 'I','i': lstvAlertsColumnClick(Sender, lstvAlerts.Columns[0]);
1260 'P','p': lstvAlertsColumnClick(Sender, lstvAlerts.Columns[1]);
1261 'L','l': lstvAlertsColumnClick(Sender, lstvAlerts.Columns[2]);
1262 'U','u': lstvAlertsColumnClick(Sender, lstvAlerts.Columns[3]);
1263 'D','d': lstvAlertsColumnClick(Sender, lstvAlerts.Columns[4]);
1264 'M','m': lstvAlertsColumnClick(Sender, lstvAlerts.Columns[5]);
1265 'F','f': lstvAlertsColumnClick(Sender, lstvAlerts.Columns[6]);
1266 end;
1267end;
1268
1269//hds7397- ge 2/6/6 sort and display date/time column correctly - as requested
1270procedure TfrmPtSel.ReformatAlertDateTime;
1271var
1272 I,J: Integer;
1273 inDateStr, holdDayTime,srtDate: String;
1274begin
1275 // convert date to yyyy/mm/dd prior to sort.
1276 for J := 0 to lstvAlerts.items.count -1 do
1277 begin
1278 inDateStr := '';
1279 srtDate := '';
1280 holdDayTime := '';
1281 inDateStr := lstvAlerts.Items[j].SubItems[3];
1282 srtDate := ( (Piece( Piece(inDateStr,'/',3), '@',1)) + '/' + Piece(inDateStr,'/',1) + '/' + Piece(inDateStr,'/',2) +'@'+ Piece(inDateStr, '@',2) );
1283 lstvAlerts.Items[j].SubItems[3] := srtDate;
1284 end;
1285 //sort the listview records by date
1286 lstvAlerts.AlphaSort;
1287 // loop thru lstvAlerts change date to yyyy/mm/dd
1288 // sort list
1289 // change alert date/time back to mm/dd/yyyy@time for display
1290 for I := 0 to lstvAlerts.items.Count -1 do
1291 begin
1292 inDateStr := '';
1293 srtDate := '';
1294 holdDayTime := '';
1295 inDateStr := lstvAlerts.Items[i].SubItems[3];
1296 holdDayTime := Piece(inDateStr,'/',3); // dd@time
1297 lstvAlerts.Items[i].SubItems[3] := (Piece(inDateStr, '/', 2) + '/' + Piece(holdDayTime, '@',1) +'/'
1298 + Piece(inDateStr,'/',1) + '@' + Piece(holdDayTime,'@',2) );
1299 end;
1300end;
1301
1302procedure TfrmPtSel.TMGcmdAddClick(Sender: TObject); //kt added function
1303begin
1304 if frmPtAdd <> nil then begin
1305 self.hide;
1306 frmPtAdd.Showmodal;
1307 self.show;
1308 if frmPtAdd.DFN > 0 then begin
1309 if cboPatient.SelectByIEN(frmPtAdd.DFN) = -1 then begin
1310 MessageDlg(DKLangConstW('fPtSel_Patient_successfully_addedx') +#10+#13+
1311 DKLangConstW('fPtSel_You_may_now_Type_in_Patient_name_to_Select_Itx')+#10+#13+
1312 #10+#13+
1313 DKLangConstW('fPtSel_Additional_demographics_may_be_entered_from_Demographics_page')+#10+#13+
1314 DKLangConstW('fPtSel_xxCover_Sheet_tab_xxx_ViewxDemographics_menu_xxx_Edit_Patient_buttonx'),
1315 mtInformation,[mbOK],0);
1316 end;
1317 end;
1318 end else begin
1319 MessageDlg(DKLangConstW('fPtSel_CPRS_has_not_completed_log_inx')+#10+#13+
1320 DKLangConstW('fPtSel_Adding_a_new_patient_not_allowed_nowx')+#10+#13+
1321 #10+#13+
1322 DKLangConstW('fPtSel_Please_choose_an_existing_patient_and_retry_laterx'),
1323 mtInformation, [mbOK],0);
1324 end;
1325end;
1326
1327procedure TfrmPtSel.FormCreate(Sender: TObject); //added by ELH 6/20/08
1328begin
1329 TMGcmdAdd.Visible := boolTMGPatchInstalled and not User.HasKey('TMG CPRS HIDE ADDPATIENT');
1330end;
1331
1332procedure TfrmPtSel.btnSearchPtClick(Sender: TObject);
1333var InfoStr : string;
1334 IEN : int64;
1335begin
1336 frmPtQuery.InitializeForm('PATIENT', 2);
1337 if frmPtQuery.ShowModal = mrOK then begin
1338 cboPatient.InitLongList(frmPtQuery.SelectedName);
1339 IEN := StrToInt64Def(frmPtQuery.SelectedIEN,0);
1340 if IEN < 1 then exit;
1341 cboPatient.SelectByIEN(IEN);
1342 if cboPatient.ItemID = frmPtQuery.SelectedIEN then begin
1343 InfoStr := cboPatient.Items[cboPatient.ItemIndex];
1344 end else begin
1345 InfoStr := '';
1346 end;
1347 OpenPatient(frmPtQuery.SelectedIEN, InfoStr);
1348 end;
1349end;
1350
1351Initialization
1352 SortViaKeyboard := false;
1353
1354end.
Note: See TracBrowser for help on using the repository browser.