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

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

Initial upload of TMG-CPRS 1.0.26.69
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;
1211end;
1212
1213Initialization
1214 SortViaKeyboard := false;
1215
1216end.
Note: See TracBrowser for help on using the repository browser.