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

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

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