Module

fPtSel

Path

C:\CPRS\CPRS30\fPtSel.pas

Last Modified

7/15/2014 3:26:38 PM

Comments

Allows patient selection using various pt lists.  Allows display & processing of alerts.

Units Used in Interface

Name Comments
fBase508Form -
UBACore -
UBAGlobals -
uConst -

Units Used in Implementation

Name Comments
fAlertForward -
fDupPts -
fFrame -
fPatientFlagMulti -
fPtSelDemog -
fPtSelOptns -
fPtSens -
fRptBox -
rCore -
rMisc -
uCore -
uOrPtf -

Classes

Name Comments
TfrmPtSel -

Procedures

Name Owner Declaration Scope Comments
AdjustButtonSize TfrmPtSel procedure AdjustButtonSize(pButton:TButton); Private -
AdjustFormSize TfrmPtSel procedure AdjustFormSize(ShowNotif: Boolean; FontSize: Integer); Private Adjusts the initial size of the form based on the font used & if notifications should show.
AdjustNotificationButtons TfrmPtSel procedure AdjustNotificationButtons; Private Reposition buttons after resizing eliminate overlap.
AlertList TfrmPtSel procedure AlertList; Private -
cboPatientChange TfrmPtSel procedure cboPatientChange(Sender: TObject); Public/Published -
cboPatientDblClick TfrmPtSel procedure cboPatientDblClick(Sender: TObject); Public/Published -
cboPatientEnter TfrmPtSel procedure cboPatientEnter(Sender: TObject); Public/Published Patient Select events:
cboPatientExit TfrmPtSel procedure cboPatientExit(Sender: TObject); Public/Published -
cboPatientKeyDown TfrmPtSel procedure cboPatientKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); Public/Published -
cboPatientKeyPause TfrmPtSel procedure cboPatientKeyPause(Sender: TObject); Public/Published -
cboPatientKeyUp TfrmPtSel procedure cboPatientKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); Public/Published -
cboPatientMouseClick TfrmPtSel procedure cboPatientMouseClick(Sender: TObject); Public/Published -
cboPatientNeedData TfrmPtSel procedure cboPatientNeedData(Sender: TObject; const StartFrom: string; Direction, InsertAt: Integer); Public/Published -
ClearIDInfo TfrmPtSel procedure ClearIDInfo; Private -
cmdCancelClick TfrmPtSel procedure cmdCancelClick(Sender: TObject); Public/Published -
cmdCommentsClick TfrmPtSel procedure cmdCommentsClick(Sender: TObject); Public/Published -
cmdForwardClick TfrmPtSel procedure cmdForwardClick(Sender: TObject); Public/Published -
cmdOKClick TfrmPtSel procedure cmdOKClick(Sender: TObject); Public/Published
Command Button events: 

 Checks for restrictions on the selected patient and sets up the Patient object.
cmdProcessAllClick TfrmPtSel procedure cmdProcessAllClick(Sender: TObject); Public/Published -
cmdProcessClick TfrmPtSel procedure cmdProcessClick(Sender: TObject); Public/Published -
cmdProcessInfoClick TfrmPtSel procedure cmdProcessInfoClick(Sender: TObject); Public/Published Select and process all items that are information only in the lstvAlerts list box.
cmdRemoveClick TfrmPtSel procedure cmdRemoveClick(Sender: TObject); Public/Published -
cmdSaveListClick TfrmPtSel procedure cmdSaveListClick(Sender: TObject); Public/Published -
FormClose TfrmPtSel procedure FormClose(Sender: TObject; var Action: TCloseAction); Public/Published -
FormCreate TfrmPtSel procedure FormCreate(Sender: TObject); Public/Published -
FormDestroy TfrmPtSel procedure FormDestroy(Sender: TObject); Public/Published -
FormResize TfrmPtSel procedure FormResize(Sender: TObject); Public/Published -
FormShow TfrmPtSel procedure FormShow(Sender: TObject); Public/Published
//KW
 Sort Alerts by last-used method for current user
Loaded TfrmPtSel procedure Loaded; override; Public -
lstFlagsClick TfrmPtSel procedure lstFlagsClick(Sender: TObject); Public/Published -
lstFlagsKeyDown TfrmPtSel procedure lstFlagsKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); Public/Published -
lstvAlertsColumnClick TfrmPtSel procedure lstvAlertsColumnClick(Sender: TObject; Column: TListColumn); Public/Published -
lstvAlertsCompare TfrmPtSel procedure lstvAlertsCompare(Sender: TObject; Item1, Item2: TListItem; Data: Integer; var Compare: Integer); Public/Published -
lstvAlertsDblClick TfrmPtSel procedure lstvAlertsDblClick(Sender: TObject); Public/Published -
lstvAlertsInfoTip TfrmPtSel procedure lstvAlertsInfoTip(Sender: TObject; Item: TListItem; var InfoTip: String); Public/Published -
lstvAlertsKeyDown TfrmPtSel procedure lstvAlertsKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); Public/Published
//KW
 508: Allow non-sighted users to sort Notifications using Ctrl + <key>
 Numbers in case stmnt are ASCII values for character keys.
lstvAlertsMouseUp TfrmPtSel procedure lstvAlertsMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); Public/Published -
lstvAlertsSelectItem TfrmPtSel procedure lstvAlertsSelectItem(Sender: TObject; Item: TListItem; Selected: Boolean); Public/Published -
pnlPtSelResize TfrmPtSel procedure pnlPtSelResize(Sender: TObject); Public/Published -
ReadyAlert TfrmPtSel procedure ReadyAlert; Private Hds7397- ge 2/6/6 sort and display date/time column correctly - as requested
ReformatAlertDateTime TfrmPtSel procedure ReformatAlertDateTime; Private -
RPLDisplay TfrmPtSel procedure RPLDisplay; Private -
SelectPatient - procedure SelectPatient(ShowNotif: Boolean; FontSize: Integer; var UserCancelled: boolean); Interfaced Displays patient selection dialog (with optional notifications), updates Patient object
SetCaptionTop TfrmPtSel procedure SetCaptionTop; Private Show patient list name, set top list to 'Select ...' if appropriate.
SetPtListTop TfrmPtSel procedure SetPtListTop(IEN: Int64); Private
List Source events: 

 Sets top items in patient list according to list source type and optional list source IEN.
SetupDemographicsForm TfrmPtSel procedure SetupDemographicsForm; Private -
ShowButts TfrmPtSel procedure ShowButts(ShowButts: Boolean); Public/Published -
ShowDisabledButtonTexts TfrmPtSel procedure ShowDisabledButtonTexts; Private -
ShowFlagInfo TfrmPtSel procedure ShowFlagInfo; Private -
ShowIDInfo TfrmPtSel procedure ShowIDInfo; Private -
ShowMatchingPatients - procedure ShowMatchingPatients; Local -
WMReadyAlert TfrmPtSel procedure WMReadyAlert(var Message: TMessage); message UM_MISC; Private -

Functions

Name Owner Declaration Scope Comments
ConvertDate - function ConvertDate(var thisList: TStringList; listIndex: integer) : string; Global -
DupLastSSN TfrmPtSel function DupLastSSN(const DFN: string): Boolean; Public/Published -

Global Variables

Name Type Declaration Comments
DupDFN UnicodeString IsRPL, RPLJob, DupDFN: string; RPLJob stores server $J job number of RPL pt. list.
FDfltSrc UnicodeString FDfltSrc, FDfltSrcType: string; -
FDfltSrcType UnicodeString FDfltSrc, FDfltSrcType: string; -
FDragging Boolean FDragging: Boolean = False; -
frmPtSel TfrmPtSel frmPtSel: TfrmPtSel; -
IsRPL UnicodeString IsRPL, RPLJob, DupDFN: string; RPLJob stores server $J job number of RPL pt. list.
PtStrs TStringList PtStrs: TStringList; -
RPLJob UnicodeString IsRPL, RPLJob, DupDFN: string; RPLJob stores server $J job number of RPL pt. list.
RPLProblem Boolean RPLProblem: boolean; Allows close of form if there's an RPL problem.

Constants

Name Declaration Scope Comments
AliasString ' -- ALIAS' Global -


Module Source

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

Module Calls (2 levels)


fPtSel
 ├UBAGlobals
 │ ├uConst
 │ ├rOrders
 │ ├fBALocalDiagnoses
 │ ├fOrdersSign
 │ ├fReview
 │ ├uCore
 │ ├rCore
 │ ├UBAConst
 │ └UBACore
 ├UBACore...
 ├fBase508Form
 │ ├uConst
 │ └uHelpManager
 ├uConst
 ├rCore...
 ├uCore...
 ├fDupPts
 │ ├fBase508Form...
 │ └fPtSel...
 ├fPtSelDemog
 │ ├fBase508Form...
 │ ├rCore...
 │ └uCombatVet
 ├fPtSelOptns
 │ ├fBase508Form...
 │ ├rCore...
 │ ├fPtSelOptSave
 │ └fPtSel...
 ├uOrPtf
 ├fAlertForward
 │ ├fBase508Form...
 │ └rCore...
 ├rMisc
 │ └fOrders
 ├fFrame
 │ ├fPage
 │ ├uConst
 │ ├VERGENCECONTEXTORLib_TLB
 │ ├fBase508Form...
 │ ├XuDsigS
 │ ├rCore...
 │ ├fPtSelMsg
 │ ├fPtSel...
 │ ├fCover
 │ ├fProbs
 │ ├fMeds
 │ ├fOrders...
 │ ├rOrders...
 │ ├fNotes
 │ ├fConsults
 │ ├fDCSumm
 │ ├rMisc...
 │ ├fLabs
 │ ├fReports
 │ ├rReports
 │ ├fPtDemo
 │ ├fEncnt
 │ ├fPtCWAD
 │ ├uCore...
 │ ├fAbout
 │ ├fReview...
 │ ├fxBroker
 │ ├fxLists
 │ ├fxServer
 │ ├fRptBox
 │ ├rODAllergy
 │ ├uInit
 │ ├fLabInfo
 │ ├uReminders
 │ ├fReminderTree
 │ ├fDeviceSelect
 │ ├fDrawers
 │ ├fReminderDialog
 │ ├fOptions
 │ ├fGraphs
 │ ├fGraphData
 │ ├rTemplates
 │ ├fSurgery
 │ ├rSurgery
 │ ├uEventHooks
 │ ├uSignItems
 │ ├rECS
 │ ├fIconLegend
 │ ├uOrders
 │ ├uSpell
 │ ├uOrPtf
 │ ├fPatientFlagMulti
 │ ├fAlertForward...
 │ ├UBAGlobals...
 │ ├UBACore...
 │ ├fOrdersSign...
 │ ├uVitals
 │ ├fMHTest
 │ ├uFormMonitor
 │ ├fOtherSchedule
 │ ├uVA508CPRSCompatibility
 │ ├fIVRoutes
 │ ├fPrintLocation
 │ ├fTemplateEditor
 │ └fCombatVet
 └fRptBox...

Module Called-By (2 levels)


                     fPtSel
                   fFrame┤ 
              CPRSChart┤ │ 
                  fPage┤ │ 
                uOrders┤ │ 
                fODBase┤ │ 
                UBACore┤ │ 
                fOrders┤ │ 
                   uPCE┤ │ 
      fBALocalDiagnoses┤ │ 
             fEncVitals┤ │ 
                fVitals┤ │ 
                 fCover┤ │ 
                 rCover┤ │ 
              fPtSelMsg┤ │ 
              fPtSel...┤ │ 
            fOrdersSign┤ │ 
         fPrintLocation┤ │ 
                  fMeds┤ │ 
                fRptBox┤ │ 
                 fNotes┤ │ 
               fReports┤ │ 
                 fEncnt┤ │ 
                 fProbs┤ │ 
          fReportsPrint┤ │ 
                fGraphs┤ │ 
              fConsults┤ │ 
                fDCSumm┤ │ 
        fReminderDialog┤ │ 
                  fLabs┤ │ 
              fLabPrint┤ │ 
                fReview┤ │ 
            fIconLegend┤ │ 
           fOrdersPrint┤ │ 
               fSurgery┤ │ 
uVA508CPRSCompatibility┤ │ 
           fOrdersRenew┤ │ 
             fODConsult┤ │ 
                fODProc┤ │ 
                 fODRad┤ │ 
                 fODLab┤ │ 
                fODMeds┤ │ 
               fODMedIV┤ │ 
              fODVitals┤ │ 
                fODAuto┤ │ 
                 fOMSet┤ │ 
         fOrdersRelease┤ │ 
              fODMedNVA┤ │ 
         fOrdersOnChart┤ │ 
             fOCSession┤ │ 
              fODActive┤ │ 
               fPCEEdit┘ │ 
              fPtSelOptns┤ 
              fPtSel...┤ │ 
          fPtSelOptSave┤ │ 
          fOptionsLists┘ │ 
                  fDupPts┘ 
              fPtSel...┘