unit fPtSel; { Allows patient selection using various pt lists. Allows display & processing of alerts. } {$OPTIMIZATION OFF} // REMOVE AFTER UNIT IS DEBUGGED {$define VAA} interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ORCtrls, ExtCtrls, ORFn, ORNet, ORDtTmRng, Gauges, Menus, ComCtrls, UBAGlobals, UBACore, fBase508Form, VA508AccessibilityManager, uConst; type TfrmPtSel = class(TfrmBase508Form) pnlPtSel: TORAutoPanel; cboPatient: TORComboBox; lblPatient: TLabel; cmdOK: TButton; cmdCancel: TButton; pnlNotifications: TORAutoPanel; cmdProcessInfo: TButton; cmdProcessAll: TButton; cmdProcess: TButton; cmdForward: TButton; sptVert: TSplitter; cmdSaveList: TButton; pnlDivide: TORAutoPanel; lblNotifications: TLabel; ggeInfo: TGauge; cmdRemove: TButton; popNotifications: TPopupMenu; mnuProcess: TMenuItem; mnuRemove: TMenuItem; mnuForward: TMenuItem; lstvAlerts: TCaptionListView; N1: TMenuItem; cmdComments: TButton; txtCmdComments: TVA508StaticText; txtCmdRemove: TVA508StaticText; txtCmdForward: TVA508StaticText; txtCmdProcess: TVA508StaticText; procedure cmdOKClick(Sender: TObject); procedure cmdCancelClick(Sender: TObject); procedure cboPatientChange(Sender: TObject); procedure cboPatientKeyPause(Sender: TObject); procedure cboPatientMouseClick(Sender: TObject); procedure cboPatientEnter(Sender: TObject); procedure cboPatientExit(Sender: TObject); procedure cboPatientNeedData(Sender: TObject; const StartFrom: string; Direction, InsertAt: Integer); procedure cboPatientDblClick(Sender: TObject); procedure cmdProcessClick(Sender: TObject); procedure cmdSaveListClick(Sender: TObject); procedure cmdProcessInfoClick(Sender: TObject); procedure cmdProcessAllClick(Sender: TObject); procedure lstvAlertsDblClick(Sender: TObject); procedure cmdForwardClick(Sender: TObject); procedure cmdRemoveClick(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure pnlPtSelResize(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure cboPatientKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure lstvAlertsColumnClick(Sender: TObject; Column: TListColumn); procedure lstvAlertsCompare(Sender: TObject; Item1, Item2: TListItem; Data: Integer; var Compare: Integer); function DupLastSSN(const DFN: string): Boolean; procedure lstFlagsClick(Sender: TObject); procedure lstFlagsKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure lstvAlertsSelectItem(Sender: TObject; Item: TListItem; Selected: Boolean); procedure ShowButts(ShowButts: Boolean); procedure lstvAlertsInfoTip(Sender: TObject; Item: TListItem; var InfoTip: String); procedure lstvAlertsKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure FormShow(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormResize(Sender: TObject); procedure cmdCommentsClick(Sender: TObject); procedure lstvAlertsMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure cboPatientKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); private FsortCol: integer; FsortAscending: boolean; FLastPt: string; FsortDirection: string; FUserCancelled: boolean; FNotificationBtnsAdjusted: Boolean; FAlertsNotReady: boolean; FMouseUpPos: TPoint; procedure WMReadyAlert(var Message: TMessage); message UM_MISC; procedure ReadyAlert; procedure AdjustFormSize(ShowNotif: Boolean; FontSize: Integer); procedure ClearIDInfo; procedure ShowIDInfo; procedure ShowFlagInfo; procedure SetCaptionTop; procedure SetPtListTop(IEN: Int64); procedure RPLDisplay; procedure AlertList; procedure ReformatAlertDateTime; procedure AdjustButtonSize(pButton:TButton); procedure AdjustNotificationButtons; procedure SetupDemographicsForm; procedure ShowDisabledButtonTexts; public procedure Loaded; override; end; procedure SelectPatient(ShowNotif: Boolean; FontSize: Integer; var UserCancelled: boolean); var frmPtSel: TfrmPtSel; FDfltSrc, FDfltSrcType: string; IsRPL, RPLJob, DupDFN: string; // RPLJob stores server $J job number of RPL pt. list. RPLProblem: boolean; // Allows close of form if there's an RPL problem. PtStrs: TStringList; implementation {$R *.DFM} uses rCore, uCore, fDupPts, fPtSens, fPtSelDemog, fPtSelOptns, fPatientFlagMulti, uOrPtf, fAlertForward, rMisc, fFrame, fRptBox, VA508AccessibilityRouter, VAUtils; var FDragging: Boolean = False; const AliasString = ' -- ALIAS'; procedure SelectPatient(ShowNotif: Boolean; FontSize: Integer; var UserCancelled: boolean); { displays patient selection dialog (with optional notifications), updates Patient object } var frmPtSel: TfrmPtSel; begin frmPtSel := TfrmPtSel.Create(Application); RPLProblem := false; try with frmPtSel do begin AdjustFormSize(ShowNotif, FontSize); // Set initial form size FDfltSrc := DfltPtList; FDfltSrcType := Piece(FDfltSrc, U, 2); FDfltSrc := Piece(FDfltSrc, U, 1); if (IsRPL = '1') then // Deal with restricted patient list users. FDfltSrc := ''; frmPtSelOptns.SetDefaultPtList(FDfltSrc); if RPLProblem then begin frmPtSel.Release; Exit; end; Notifications.Clear; FsortCol := -1; AlertList; ClearIDInfo; if (IsRPL = '1') then // Deal with restricted patient list users. RPLDisplay; // Removes unnecessary components from view. FUserCancelled := FALSE; ShowModal; UserCancelled := FUserCancelled; end; finally frmPtSel.Release; end; end; procedure TfrmPtSel.AdjustFormSize(ShowNotif: Boolean; FontSize: Integer); { Adjusts the initial size of the form based on the font used & if notifications should show. } var Rect: TRect; SplitterTop, t1, t2, t3: integer; begin SetFormPosition(self); ResizeAnchoredFormToFont(self); if ShowNotif then begin pnlDivide.Visible := True; lstvAlerts.Visible := True; pnlNotifications.Visible := True; pnlPtSel.BevelOuter := bvRaised; end else begin pnlDivide.Visible := False; lstvAlerts.Visible := False; pnlNotifications.Visible := False; end; //SetFormPosition(self); Rect := BoundsRect; ForceInsideWorkArea(Rect); BoundsRect := Rect; if frmFrame.EnduringPtSelSplitterPos <> 0 then SplitterTop := frmFrame.EnduringPtSelSplitterPos else SetUserBounds2(Name+'.'+sptVert.Name,SplitterTop, t1, t2, t3); if SplitterTop <> 0 then pnlPtSel.Height := SplitterTop; FNotificationBtnsAdjusted := False; AdjustButtonSize(cmdSaveList); AdjustButtonSize(cmdProcessInfo); AdjustButtonSize(cmdProcessAll); AdjustButtonSize(cmdProcess); AdjustButtonSize(cmdForward); AdjustButtonSize(cmdRemove); AdjustButtonSize(cmdComments); AdjustNotificationButtons; end; procedure TfrmPtSel.SetCaptionTop; { Show patient list name, set top list to 'Select ...' if appropriate. } var x: string; begin x := ''; lblPatient.Caption := 'Patients'; if (not User.IsReportsOnly) then begin case frmPtSelOptns.SrcType of TAG_SRC_DFLT: lblPatient.Caption := 'Patients (' + FDfltSrc + ')'; TAG_SRC_PROV: x := 'Provider'; TAG_SRC_TEAM: x := 'Team'; TAG_SRC_SPEC: x := 'Specialty'; TAG_SRC_CLIN: x := 'Clinic'; TAG_SRC_WARD: x := 'Ward'; TAG_SRC_ALL: { Nothing }; end; // case stmt end; // begin if Length(x) > 0 then with cboPatient do begin RedrawSuspend(Handle); ClearIDInfo; ClearTop; Text := ''; Items.Add('^Select a ' + x + '...'); Items.Add(LLS_LINE); Items.Add(LLS_SPACE); cboPatient.InitLongList(''); RedrawActivate(cboPatient.Handle); end; end; { List Source events: } procedure TfrmPtSel.SetPtListTop(IEN: Int64); { Sets top items in patient list according to list source type and optional list source IEN. } var NewTopList: string; FirstDate, LastDate: string; begin // NOTE: Some pieces in RPC returned arrays are rearranged by ListPtByDflt call in rCore! IsRPL := User.IsRPL; if (IsRPL = '') then // First piece in ^VA(200,.101) should always be set (to 1 or 0). begin InfoBox('Patient selection list flag not set.', 'Incomplete User Information', MB_OK); RPLProblem := true; Exit; end; // FirstDate := 0; LastDate := 0; // Not req'd, but eliminates hint. // Assign list box TabPosition, Pieces properties according to type of list to be displayed. // (Always use Piece "2" as the first in the list to assure display of patient's name.) cboPatient.pieces := '2,3'; // This line and next: defaults set - exceptions modifield next. cboPatient.tabPositions := '20,28'; if ((frmPtSelOptns.SrcType = TAG_SRC_DFLT) and (FDfltSrc = 'Combination')) then begin cboPatient.pieces := '2,3,4,5,9'; cboPatient.tabPositions := '20,28,35,45'; end; if ((frmPtSelOptns.SrcType = TAG_SRC_DFLT) and (FDfltSrcType = 'Ward')) or (frmPtSelOptns.SrcType = TAG_SRC_WARD) then cboPatient.tabPositions := '35'; if ((frmPtSelOptns.SrcType = TAG_SRC_DFLT) and (AnsiStrPos(pChar(FDfltSrcType), 'Clinic') <> nil)) or (frmPtSelOptns.SrcType = TAG_SRC_CLIN) then begin cboPatient.pieces := '2,3,9'; cboPatient.tabPositions := '24,45'; end; NewTopList := IntToStr(frmPtSelOptns.SrcType) + U + IntToStr(IEN); // Default setting. if (frmPtSelOptns.SrcType = TAG_SRC_CLIN) then with frmPtSelOptns.cboDateRange do begin if ItemID = '' then Exit; // Need both clinic & date range. FirstDate := Piece(ItemID, ';', 1); LastDate := Piece(ItemID, ';', 2); NewTopList := IntToStr(frmPtSelOptns.SrcType) + U + IntToStr(IEN) + U + ItemID; // Modified for clinics. end; if NewTopList = frmPtSelOptns.LastTopList then Exit; // Only continue if new top list. frmPtSelOptns.LastTopList := NewTopList; RedrawSuspend(cboPatient.Handle); ClearIDInfo; cboPatient.ClearTop; cboPatient.Text := ''; if (IsRPL = '1') then // Deal with restricted patient list users. begin RPLJob := MakeRPLPtList(User.RPLList); // MakeRPLPtList is in rCore, writes global "B" x-ref list. if (RPLJob = '') then begin InfoBox('Assignment of valid OE/RR Team List Needed.', 'Unable to build Patient List', MB_OK); RPLProblem := true; Exit; end; end else begin case frmPtSelOptns.SrcType of TAG_SRC_DFLT: ListPtByDflt(cboPatient.Items); TAG_SRC_PROV: ListPtByProvider(cboPatient.Items, IEN); TAG_SRC_TEAM: ListPtByTeam(cboPatient.Items, IEN); TAG_SRC_SPEC: ListPtBySpecialty(cboPatient.Items, IEN); TAG_SRC_CLIN: ListPtByClinic(cboPatient.Items, frmPtSelOptns.cboList.ItemIEN, FirstDate, LastDate); TAG_SRC_WARD: ListPtByWard(cboPatient.Items, IEN); TAG_SRC_ALL: ListPtTop(cboPatient.Items); end; end; if frmPtSelOptns.cboList.Visible then lblPatient.Caption := 'Patients (' + frmPtSelOptns.cboList.Text + ')'; if frmPtSelOptns.SrcType = TAG_SRC_ALL then lblPatient.Caption := 'Patients (All Patients)'; with cboPatient do if ShortCount > 0 then begin Items.Add(LLS_LINE); Items.Add(LLS_SPACE); end; cboPatient.Caption := lblPatient.Caption; cboPatient.InitLongList(''); RedrawActivate(cboPatient.Handle); end; { Patient Select events: } procedure TfrmPtSel.cboPatientEnter(Sender: TObject); begin cmdOK.Default := True; if cboPatient.ItemIndex >= 0 then begin ShowIDInfo; ShowFlagInfo; end; end; procedure TfrmPtSel.cboPatientExit(Sender: TObject); begin cmdOK.Default := False; end; procedure TfrmPtSel.cboPatientChange(Sender: TObject); procedure ShowMatchingPatients; begin with cboPatient do begin ClearIDInfo; if ShortCount > 0 then begin if ShortCount = 1 then begin ItemIndex := 0; ShowIDInfo; ShowFlagInfo; end; Items.Add(LLS_LINE); Items.Add(LLS_SPACE); end; InitLongList(''); end; end; begin with cboPatient do if frmPtSelOptns.IsLast5(Text) then begin if (IsRPL = '1') then ListPtByRPLLast5(Items, Text) else ListPtByLast5(Items, Text); ShowMatchingPatients; end else if frmPtSelOptns.IsFullSSN(Text) then begin if (IsRPL = '1') then ListPtByRPLFullSSN(Items, Text) else ListPtByFullSSN(Items, Text); ShowMatchingPatients; end; end; procedure TfrmPtSel.cboPatientKeyPause(Sender: TObject); begin if Length(cboPatient.ItemID) > 0 then //*DFN* begin ShowIDInfo; ShowFlagInfo; end else begin ClearIDInfo; end; end; procedure TfrmPtSel.cboPatientKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); begin inherited; if (Key = VK_BACK) and (cboPatient.Text = '') then cboPatient.ItemIndex := -1; end; procedure TfrmPtSel.cboPatientMouseClick(Sender: TObject); begin if Length(cboPatient.ItemID) > 0 then //*DFN* begin ShowIDInfo; ShowFlagInfo; end else begin ClearIDInfo; end; end; procedure TfrmPtSel.cboPatientDblClick(Sender: TObject); begin if Length(cboPatient.ItemID) > 0 then cmdOKClick(Self); //*DFN* end; procedure TfrmPtSel.cboPatientNeedData(Sender: TObject; const StartFrom: string; Direction, InsertAt: Integer); var i: Integer; NoAlias, Patient: String; PatientList: TStringList; begin NoAlias := StartFrom; with Sender as TORComboBox do if Items.Count > ShortCount then begin NoAlias := Piece(Items[Items.Count-1], U, 1) + U + NoAlias; if Direction < 0 then NoAlias := Copy(NoAlias, 1, Length(NoAlias) - 1); end; if pos(AliasString, NoAlias) > 0 then NoAlias := Copy(NoAlias, 1, pos(AliasString, NoAlias) - 1); PatientList := TStringList.Create; try begin if (IsRPL = '1') then // Restricted patient lists uses different feed for long list box: FastAssign(ReadRPLPtList(RPLJob, NoAlias, Direction), PatientList) else begin FastAssign(SubSetOfPatients(NoAlias, Direction), PatientList); for i := 0 to PatientList.Count - 1 do // Add " - Alias" to alias names: begin Patient := PatientList[i]; // Piece 6 avoids display problems when mixed with "RPL" lists: if (Uppercase(Piece(Patient, U, 2)) <> Uppercase(Piece(Patient, U, 6))) then begin SetPiece(Patient, U, 2, Piece(Patient, U, 2) + AliasString); PatientList[i] := Patient; end; end; end; cboPatient.ForDataUse(PatientList); end; finally PatientList.Free; end; end; procedure TfrmPtSel.ClearIDInfo; begin frmPtSelDemog.ClearIDInfo; end; procedure TfrmPtSel.ShowIDInfo; begin frmPtSelDemog.ShowDemog(cboPatient.ItemID); end; procedure TfrmPtSel.WMReadyAlert(var Message: TMessage); begin ReadyAlert; Message.Result := 0; end; { Command Button events: } procedure TfrmPtSel.cmdOKClick(Sender: TObject); { Checks for restrictions on the selected patient and sets up the Patient object. } const DLG_CANCEL = False; var NewDFN: string; //*DFN* DateDied: TFMDateTime; AccessStatus: integer; begin if not (Length(cboPatient.ItemID) > 0) then //*DFN* begin InfoBox('A patient has not been selected.', 'No Patient Selected', MB_OK); Exit; end; NewDFN := cboPatient.ItemID; //*DFN* if FLastPt <> cboPatient.ItemID then begin HasActiveFlg(FlagList, HasFlag, cboPatient.ItemID); flastpt := cboPatient.ItemID; end; If DupLastSSN(NewDFN) then // Check for, deal with duplicate patient data. if (DupDFN = 'Cancel') then Exit else NewDFN := DupDFN; if not AllowAccessToSensitivePatient(NewDFN, AccessStatus) then exit; DateDied := DateOfDeath(NewDFN); if (DateDied > 0) and (InfoBox('This patient died ' + FormatFMDateTime('mmm dd,yyyy hh:nn', DateDied) + CRLF + 'Do you wish to continue?', 'Deceased Patient', MB_YESNO or MB_DEFBUTTON2) = ID_NO) then Exit; // 9/23/2002: Code used to check for changed pt. DFN here, but since same patient could be // selected twice in diff. Encounter locations, check was removed and following code runs // no matter; in fFrame code then updates Encounter display if Encounter.Location has changed. // NOTE: Some pieces in RPC returned arrays are modified/rearranged by ListPtByDflt call in rCore! Patient.DFN := NewDFN; // The patient object in uCore must have been created already! Encounter.Clear; Changes.Clear; // An earlier call to ReviewChanges should have cleared this. if (frmPtSelOptns.SrcType = TAG_SRC_CLIN) and (frmPtSelOptns.cboList.ItemIEN > 0) and IsFMDateTime(Piece(cboPatient.Items[cboPatient.ItemIndex], U, 4)) then // Clinics, not by default. begin Encounter.Location := frmPtSelOptns.cboList.ItemIEN; with cboPatient do Encounter.DateTime := MakeFMDateTime(Piece(Items[ItemIndex], U, 4)); end else if (frmPtSelOptns.SrcType = TAG_SRC_DFLT) and (DfltPtListSrc = 'C') and IsFMDateTime(Piece(cboPatient.Items[cboPatient.ItemIndex], U, 4))then with cboPatient do // "Default" is a clinic. begin Encounter.Location := StrToIntDef(Piece(Items[ItemIndex], U, 10), 0); // Piece 10 is ^SC( location IEN in this case. Encounter.DateTime := MakeFMDateTime(Piece(Items[ItemIndex], U, 4)); end else if ((frmPtSelOptns.SrcType = TAG_SRC_DFLT) and (FDfltSrc = 'Combination') and (copy(Piece(cboPatient.Items[cboPatient.ItemIndex], U, 3), 1, 2) = 'Cl')) and (IsFMDateTime(Piece(cboPatient.Items[cboPatient.ItemIndex], U, 8))) then with cboPatient do // "Default" combination, clinic pt. begin Encounter.Location := StrToIntDef(Piece(Items[ItemIndex], U, 7), 0); // Piece 7 is ^SC( location IEN in this case. Encounter.DateTime := MakeFMDateTime(Piece(Items[ItemIndex], U, 8)); end else if Patient.Inpatient then // Everything else: begin Encounter.Inpatient := True; Encounter.Location := Patient.Location; Encounter.DateTime := Patient.AdmitTime; Encounter.VisitCategory := 'H'; end; if User.IsProvider then Encounter.Provider := User.DUZ; GetBAStatus(Encounter.Provider,Patient.DFN); //HDS00005025 if BILLING_AWARE then if Assigned(UBAGLOBALS.BAOrderList) then UBAGLOBALS.BAOrderList.Clear; FUserCancelled := FALSE; Close; end; procedure TfrmPtSel.cmdCancelClick(Sender: TObject); begin // Leave Patient object unchanged FUserCancelled := TRUE; Close; end; procedure TfrmPtSel.cmdCommentsClick(Sender: TObject); var tmpCmt: TStringList; begin if FAlertsNotReady then exit; inherited; tmpCmt := TStringList.Create; try tmpCmt.Text := lstvAlerts.Selected.SubItems[8]; LimitStringLength(tmpCmt, 74); tmpCmt.Insert(0, StringOfChar('-', 74)); tmpCmt.Insert(0, lstvAlerts.Selected.SubItems[4]); tmpCmt.Insert(0, lstvAlerts.Selected.SubItems[3]); tmpCmt.Insert(0, lstvAlerts.Selected.SubItems[0]); ReportBox(tmpCmt, 'Forwarded by: ' + lstvAlerts.Selected.SubItems[5], TRUE); lstvAlerts.SetFocus; finally tmpCmt.Free; end; end; procedure TfrmPtSel.cmdProcessClick(Sender: TObject); var AFollowUp, i, infocount: Integer; enableclose: boolean; ADFN, x, RecordID, XQAID: string; //*DFN* begin if FAlertsNotReady then exit; enableclose := false; with lstvAlerts do begin if SelCount <= 0 then Exit; // Count information-only selections for gauge infocount := 0; for i:= 0 to Items.Count - 1 do if Items[i].Selected then if (Items[i].SubItems[0] = 'I') then Inc(infocount); if infocount >= 1 then begin ggeInfo.Visible := true; (*BOB*) ggeInfo.MaxValue := infocount; end; for i := 0 to Items.Count - 1 do if Items[i].Selected then { Items[i].Selected = Boolean TRUE if item is selected " .Caption = Info flag ('I') " .SubItems[0] = Patient ('ABC,PATIE (A4321)') " . " [1] = Patient location ('[2B]') " . " [2] = Alert urgency level ('HIGH, Moderate, low') " . " [3] = Alert date/time ('2002/12/31@12:10') " . " [4] = Alert message ('New order(s) placed.') " . " [5] = Forwarded by/when " . " [6] = XQAID ('OR,66,50;1416;3021231.121024') 'TIU6028;1423;3021203.09') " . " [7] = Remove without processing flag ('YES') " . " [8] = Forwarding comments (if applicable) } begin XQAID := Items[i].SubItems[6]; RecordID := Items[i].SubItems[0] + ': ' + Items[i].SubItems[4] + '^' + XQAID; //RecordID := patient: alert message^XQAID ('ABC,PATIE (A4321): New order(s) placed.^OR,66,50;1416;3021231.121024') if Items[i].Caption = 'I' then // If Caption is 'I' delete the information only alert. begin ggeInfo.Progress := ggeInfo.Progress + 1; DeleteAlert(XQAID); end else if Piece(XQAID, ',', 1) = 'OR' then // OR,16,50;1311;2980626.100756 begin ADFN := Piece(XQAID, ',', 2); //*DFN* AFollowUp := StrToIntDef(Piece(Piece(XQAID, ';', 1), ',', 3), 0); Notifications.Add(ADFN, AFollowUp, RecordID, Items[i].SubItems[3]); //CB enableclose := true; end else if Copy(XQAID, 1, 6) = 'TIUERR' then InfoBox(Piece(RecordID, U, 1) + #13#10#13#10 + 'The CPRS GUI cannot yet process this type of alert. Please use List Manager.', 'Unable to Process Alert', MB_OK) else if Copy(XQAID, 1, 3) = 'TIU' then // TIU6028;1423;3021203.09 begin x := GetTIUAlertInfo(XQAID); if Piece(x, U, 2) <> '' then begin ADFN := Piece(x, U, 2); //*DFN* AFollowUp := StrToIntDef(Piece(Piece(x, U, 3), ';', 1), 0); Notifications.Add(ADFN, AFollowUp, RecordID + '^^' + Piece(x, U, 3)); enableclose := true; end else DeleteAlert(XQAID); end else //other alerts cannot be processed InfoBox('This alert cannot be processed by the CPRS GUI.', Items[i].SubItems[0] + ': ' + Items[i].SubItems[4], MB_OK); end; if enableclose = true then Close else begin ggeInfo.Visible := False; // Update notification list: lstvAlerts.Clear; AlertList; //display alerts sorted according to parameter settings: FsortCol := -1; //CA - display alerts in correct sort FormShow(Sender); end; if Items.Count = 0 then ShowButts(False); if SelCount <= 0 then ShowButts(False); end; GetBAStatus(User.DUZ,Patient.DFN); end; procedure TfrmPtSel.cmdSaveListClick(Sender: TObject); begin frmPtSelOptns.cmdSaveListClick(Sender); end; procedure TfrmPtSel.cmdProcessInfoClick(Sender: TObject); // Select and process all items that are information only in the lstvAlerts list box. var i: integer; begin if FAlertsNotReady then exit; if lstvAlerts.Items.Count = 0 then Exit; if InfoBox('You are about to process all your INFORMATION alerts.' + CRLF + 'These alerts will not be presented to you for individual' + CRLF + 'review and they will be permanently removed from your' + CRLF + 'alert list. Do you wish to continue?', 'Warning', MB_YESNO or MB_ICONWARNING) = IDYES then begin for i := 0 to lstvAlerts.Items.Count-1 do lstvAlerts.Items[i].Selected := False; //clear any selected alerts so they aren't processed for i := 0 to lstvAlerts.Items.Count-1 do if lstvAlerts.Items[i].Caption = 'I' then lstvAlerts.Items[i].Selected := True; cmdProcessClick(Self); ShowButts(False); end; end; procedure TfrmPtSel.cmdProcessAllClick(Sender: TObject); var i: integer; begin if FAlertsNotReady then exit; for i := 0 to lstvAlerts.Items.Count-1 do lstvAlerts.Items[i].Selected := True; cmdProcessClick(Self); ShowButts(False); end; procedure TfrmPtSel.lstvAlertsDblClick(Sender: TObject); var ScreenCurPos, ClientCurPos: TPoint; begin cmdProcessClick(Self); ScreenCurPos.X := 0; ScreenCurPos.Y := 0; ClientCurPos.X := 0; ClientCurPos.Y := 0; if GetCursorPos(ScreenCurPos) then ClientCurPos := lstvAlerts.ScreenToClient(ScreenCurPos); //convert screen coord. to client coord. //fixes CQ 18657: double clicking on notification, does not go to pt. chart until mouse is moved. [v28.4 - TC] if (FMouseUpPos.X = ClientCurPos.X) and (FMouseUpPos.Y = ClientCurPos.Y) then begin lstvAlerts.BeginDrag(False,0); FDragging := True; end; end; procedure TfrmPtSel.cmdForwardClick(Sender: TObject); var i: integer; Alert: String; begin if FAlertsNotReady then exit; try with lstvAlerts do begin if SelCount <= 0 then Exit; for i := 0 to Items.Count - 1 do if Items[i].Selected then try Alert := Items[i].SubItems[6] + '^' + Items[i].Subitems[0] + ': ' + Items[i].Subitems[4]; ForwardAlertTo(Alert); finally Items[i].Selected := False; end; end; finally if lstvAlerts.SelCount <= 0 then ShowButts(False); end; end; procedure TfrmPtSel.cmdRemoveClick(Sender: TObject); var i: integer; begin if FAlertsNotReady then exit; with lstvAlerts do begin if SelCount <= 0 then Exit; for i := 0 to Items.Count - 1 do if Items[i].Selected then begin if Items[i].SubItems[7] = '1' then //remove flag enabled DeleteAlertforUser(Items[i].SubItems[6]) else InfoBox('This alert cannot be removed.', Items[i].SubItems[0] + ': ' + Items[i].SubItems[4], MB_OK); end; end; lstvAlerts.Clear; AlertList; FsortCol := -1; //CA - display alerts in correct sort FormShow(Sender); //CA - display alerts in correct sort if lstvAlerts.Items.Count = 0 then ShowButts(False); if lstvAlerts.SelCount <= 0 then ShowButts(False); end; procedure TfrmPtSel.FormDestroy(Sender: TObject); var i: integer; AString: string; begin SaveUserBounds(Self); frmFrame.EnduringPtSelSplitterPos := pnlPtSel.Height; AString := ''; for i := 0 to 6 do begin AString := AString + IntToStr(lstvAlerts.Column[i].Width); if i < 6 then AString:= AString + ','; end; frmFrame.EnduringPtSelColumns := AString; end; procedure TfrmPtSel.FormResize(Sender: TObject); begin inherited; FNotificationBtnsAdjusted := False; AdjustButtonSize(cmdSaveList); AdjustButtonSize(cmdProcessInfo); AdjustButtonSize(cmdProcessAll); AdjustButtonSize(cmdProcess); AdjustButtonSize(cmdForward); AdjustButtonSize(cmdComments); AdjustButtonSize(cmdRemove); AdjustNotificationButtons; end; procedure TfrmPtSel.pnlPtSelResize(Sender: TObject); begin frmPtSelDemog.Left := cboPatient.Left + cboPatient.Width + 9; frmPtSelDemog.Width := pnlPtSel.Width - frmPtSelDemog.Left - 2; frmPtSelOptns.Width := cboPatient.Left-8; end; procedure TfrmPtSel.Loaded; begin inherited; SetupDemographicsForm; frmPtSelOptns := TfrmPtSelOptns.Create(Self); // Was application - kcm with frmPtSelOptns do begin parent := pnlPtSel; Top := 4; Left := 4; Width := cboPatient.Left-8; SetCaptionTopProc := SetCaptionTop; SetPtListTopProc := SetPtListTop; if RPLProblem then Exit; TabOrder := cmdSaveList.TabOrder; //Put just before save default list button Show; end; FLastPt := ''; //Begin at alert list, or patient listbox if no alerts if lstvAlerts.Items.Count = 0 then ActiveControl := cboPatient; end; procedure TfrmPtSel.ShowDisabledButtonTexts; begin if ScreenReaderActive then begin txtCmdProcess.Visible := not cmdProcess.Enabled; txtCmdRemove.Visible := not cmdRemove.Enabled; txtCmdForward.Visible := not cmdForward.Enabled; txtCmdComments.Visible := not cmdComments.Enabled; end; end; procedure TfrmPtSel.SetupDemographicsForm; begin // This needs to be in Loaded rather than FormCreate or the TORAutoPanel resize logic breaks. frmPtSelDemog := TfrmPtSelDemog.Create(Self); // Was application - kcm with frmPtSelDemog do begin parent := pnlPtSel; Top := cmdCancel.Top + cmdCancel.Height + 2; Left := cboPatient.Left + cboPatient.Width + 9; Width := pnlPtSel.Width - Left - 2; TabOrder := cmdCancel.TabOrder + 1; //Place after cancel button Show; end; if ScreenReaderActive then begin frmPtSelDemog.Memo.Show; frmPtSelDemog.Memo.BringToFront; end; end; procedure TfrmPtSel.RPLDisplay; begin // Make unneeded components invisible: cmdSaveList.visible := false; frmPtSelOptns.visible := false; end; procedure TfrmPtSel.FormClose(Sender: TObject; var Action: TCloseAction); begin if FDragging then begin lstvAlerts.EndDrag(True); //terminate fake dragging operation from lstvAlertsDblClick. FDragging := False; end; if (IsRPL = '1') then // Deal with restricted patient list users. KillRPLPtList(RPLJob); // Kills server global data each time. // (Global created by MakeRPLPtList in rCore.) end; procedure TfrmPtSel.FormCreate(Sender: TObject); begin inherited; DefaultButton := cmdOK; FAlertsNotReady := FALSE; ShowDisabledButtonTexts; end; procedure TfrmPtSel.cboPatientKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin if (Key = Ord('D')) and (ssCtrl in Shift) then begin Key := 0; frmPtSelDemog.ToggleMemo; end; end; function ConvertDate(var thisList: TStringList; listIndex: integer) : string; { Convert date portion from yyyy/mm/dd to mm/dd/yyyy } var //thisListItem: TListItem; thisDateTime: string[16]; tempDt: string; tempYr: string; tempTime: string; newDtTime: string; k: byte; piece1: string; piece2: string; piece3: string; piece4: string; piece5: string; piece6: string; piece7: string; piece8: string; piece9: string; piece10: string; piece11: string; begin piece1 := ''; piece2 := ''; piece3 := ''; piece4 := ''; piece5 := ''; piece6 := ''; piece7 := ''; piece8 := ''; piece9 := ''; piece10 := ''; piece11 := ''; piece1 := Piece(thisList[listIndex],U,1); piece2 := Piece(thisList[listIndex],U,2); piece3 := Piece(thisList[listIndex],U,3); piece4 := Piece(thisList[listIndex],U,4); //piece5 := Piece(thisList[listIndex],U,5); piece6 := Piece(thisList[listIndex],U,6); piece7 := Piece(thisList[listIndex],U,7); piece8 := Piece(thisList[listIndex],U,8); piece9 := Piece(thisList[listIndex],U,9); piece10 := Piece(thisList[listIndex],U,1); thisDateTime := Piece(thisList[listIndex],U,5); tempYr := ''; for k := 1 to 4 do tempYr := tempYr + thisDateTime[k]; tempDt := ''; for k := 6 to 10 do tempDt := tempDt + thisDateTime[k]; tempTime := ''; //Use 'Length' to prevent stuffing the control chars into the date when a trailing zero is missing for k := 11 to Length(thisDateTime) do //16 do tempTime := tempTime + thisDateTime[k]; newDtTime := ''; newDtTime := newDtTime + tempDt + '/' + tempYr + tempTime; piece5 := newDtTime; Result := piece1 +U+ piece2 +U+ piece3 +U+ piece4 +U+ piece5 +U+ piece6 +U+ piece7 +U+ piece8 +U+ piece9 +U+ piece10 +U+ piece11; end; procedure TfrmPtSel.AlertList; var List: TStringList; NewItem: TListItem; I,J: Integer; Comment: String; begin // Load the items lstvAlerts.Items.Clear; List := TStringList.Create; NewItem := nil; try LoadNotifications(List); for I := 0 to List.Count - 1 do begin // List[i] := ConvertDate(List, i); //cla commented out 8/9/04 CQ #4749 if Piece(List[I], U, 1) <> 'Forwarded by: ' then begin NewItem := lstvAlerts.Items.Add; NewItem.Caption := Piece(List[I], U, 1); for J := 2 to DelimCount(List[I], U) + 1 do NewItem.SubItems.Add(Piece(List[I], U, J)); end else //this list item is forwarding information begin NewItem.SubItems[5] := Piece(List[I], U, 2); Comment := Piece(List[I], U, 3); if Length(Comment) > 0 then NewItem.SubItems[8] := 'Fwd Comment: ' + Comment; end; end; finally List.Free; end; with lstvAlerts do begin Columns[0].Width := StrToIntDef(Piece(frmFrame.EnduringPtSelColumns, ',', 1), 40); //Info Caption Columns[1].Width := StrToIntDef(Piece(frmFrame.EnduringPtSelColumns, ',', 2), 195); //Patient SubItems[0] Columns[2].Width := StrToIntDef(Piece(frmFrame.EnduringPtSelColumns, ',', 3), 75); //Location SubItems[1] Columns[3].Width := StrToIntDef(Piece(frmFrame.EnduringPtSelColumns, ',', 4), 95); //Urgency SubItems[2] Columns[4].Width := StrToIntDef(Piece(frmFrame.EnduringPtSelColumns, ',', 5), 150); //Alert Date/Time SubItems[3] Columns[5].Width := StrToIntDef(Piece(frmFrame.EnduringPtSelColumns, ',', 6), 310); //Message Text SubItems[4] Columns[6].Width := StrToIntDef(Piece(frmFrame.EnduringPtSelColumns, ',', 7), 290); //Forwarded By/When SubItems[5] //Items not displayed in Columns: XQAID SubItems[6] // Remove w/o process SubItems[7] // Forwarding comments SubItems[8] end; end; procedure TfrmPtSel.lstvAlertsColumnClick(Sender: TObject; Column: TListColumn); begin if (FsortCol = Column.Index) then FsortAscending := not FsortAscending; if FsortAscending then FsortDirection := 'F' else FsortDirection := 'R'; FsortCol := Column.Index; if FsortCol = 4 then ReformatAlertDateTime // hds7397- ge 2/6/6 sort and display date/time column correctly - as requested else lstvAlerts.AlphaSort; //Set the Notifications sort method to last-used sort-type //ie., user clicked on which column header last use of CPRS? case Column.Index of 0: rCore.SetSortMethod('I', FsortDirection); 1: rCore.SetSortMethod('P', FsortDirection); 2: rCore.SetSortMethod('L', FsortDirection); 3: rCore.SetSortMethod('U', FsortDirection); 4: rCore.SetSortMethod('D', FsortDirection); 5: rCore.SetSortMethod('M', FsortDirection); 6: rCore.SetSortMethod('F', FsortDirection); end; end; procedure TfrmPtSel.lstvAlertsCompare(Sender: TObject; Item1, Item2: TListItem; Data: Integer; var Compare: Integer); begin if not(Sender is TListView) then Exit; if FsortAscending then begin if FsortCol = 0 then Compare := CompareStr(Item1.Caption, Item2.Caption) else Compare := CompareStr(Item1.SubItems[FsortCol - 1], Item2.SubItems[FsortCol - 1]); end else begin if FsortCol = 0 then Compare := CompareStr(Item2.Caption, Item1.Caption) else Compare := CompareStr(Item2.SubItems[FsortCol - 1], Item1.SubItems[FsortCol - 1]); end; end; function TfrmPtSel.DupLastSSN(const DFN: string): Boolean; var i: integer; frmPtDupSel: tForm; begin Result := False; // Check data on server for duplicates: CallV('DG CHK BS5 XREF ARRAY', [DFN]); if (RPCBrokerV.Results[0] <> '1') then // No duplicates found. Exit; Result := True; PtStrs := TStringList.Create; with RPCBrokerV do if Results.Count > 0 then begin for i := 1 to Results.Count - 1 do begin if Piece(Results[i], U, 1) = '1' then PtStrs.Add(Piece(Results[i], U, 2) + U + Piece(Results[i], U, 3) + U + FormatFMDateTimeStr('mmm dd,yyyy', Piece(Results[i], U, 4)) + U + Piece(Results[i], U, 5)); end; end; // Call form to get user's selection from expanded duplicate pt. list (resets DupDFN variable if applicable): DupDFN := DFN; frmPtDupSel:= TfrmDupPts.Create(Application); with frmPtDupSel do begin try ShowModal; finally frmPtDupSel.Release; end; end; end; procedure TfrmPtSel.ShowFlagInfo; begin if (Pos('*SENSITIVE*',frmPtSelDemog.lblPtSSN.Caption)>0) then begin // pnlPrf.Visible := False; Exit; end; if (flastpt <> cboPatient.ItemID) then begin HasActiveFlg(FlagList, HasFlag, cboPatient.ItemID); flastpt := cboPatient.ItemID; end; if HasFlag then begin // FastAssign(FlagList, lstFlags.Items); // pnlPrf.Visible := True; end //else pnlPrf.Visible := False; end; procedure TfrmPtSel.lstFlagsClick(Sender: TObject); begin { if lstFlags.ItemIndex >= 0 then ShowFlags(lstFlags.ItemID); } end; procedure TfrmPtSel.lstFlagsKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin if Key = VK_RETURN then lstFlagsClick(Self); end; procedure TfrmPtSel.lstvAlertsSelectItem(Sender: TObject; Item: TListItem; Selected: Boolean); begin if ScreenReaderSystemActive then begin FAlertsNotReady := TRUE; PostMessage(Handle, UM_MISC, 0, 0); end else ReadyAlert; end; procedure TfrmPtSel.ShowButts(ShowButts: Boolean); begin cmdProcess.Enabled := ShowButts; cmdRemove.Enabled := ShowButts; cmdForward.Enabled := ShowButts; cmdComments.Enabled := ShowButts and (lstvAlerts.SelCount = 1) and (lstvAlerts.Selected.SubItems[8] <> ''); ShowDisabledButtonTexts; end; procedure TfrmPtSel.lstvAlertsInfoTip(Sender: TObject; Item: TListItem; var InfoTip: String); begin InfoTip := Item.SubItems[8]; end; procedure TfrmPtSel.lstvAlertsKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); { //KW 508: Allow non-sighted users to sort Notifications using Ctrl + Numbers in case stmnt are ASCII values for character keys. } begin if FAlertsNotReady then exit; if lstvAlerts.Focused then begin case Key of VK_RETURN: cmdProcessClick(Sender); //Process all selected alerts 73,105: if (ssCtrl in Shift) then lstvAlertsColumnClick(Sender, lstvAlerts.Columns[0]); //I,i 80,113: if (ssCtrl in Shift) then lstvAlertsColumnClick(Sender, lstvAlerts.Columns[1]); //P,p 76,108: if (ssCtrl in Shift) then lstvAlertsColumnClick(Sender, lstvAlerts.Columns[2]); //L,l 85,117: if (ssCtrl in Shift) then lstvAlertsColumnClick(Sender, lstvAlerts.Columns[3]); //U,u 68,100: if (ssCtrl in Shift) then lstvAlertsColumnClick(Sender, lstvAlerts.Columns[4]); //D,d 77,109: if (ssCtrl in Shift) then lstvAlertsColumnClick(Sender, lstvAlerts.Columns[5]); //M,m 70,102: if (ssCtrl in Shift) then lstvAlertsColumnClick(Sender, lstvAlerts.Columns[6]); //F,f end; end; end; procedure TfrmPtSel.lstvAlertsMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin inherited; FMouseUpPos := Point(X,Y); end; procedure TfrmPtSel.FormShow(Sender: TObject); { //KW Sort Alerts by last-used method for current user } var sortResult: string; sortMethod: string; begin sortResult := rCore.GetSortMethod; sortMethod := Piece(sortResult, U, 1); if sortMethod = '' then sortMethod := 'D'; FsortDirection := Piece(sortResult, U, 2); if FsortDirection = 'F' then FsortAscending := true else FsortAscending := false; case sortMethod[1] of 'I','i': lstvAlertsColumnClick(Sender, lstvAlerts.Columns[0]); 'P','p': lstvAlertsColumnClick(Sender, lstvAlerts.Columns[1]); 'L','l': lstvAlertsColumnClick(Sender, lstvAlerts.Columns[2]); 'U','u': lstvAlertsColumnClick(Sender, lstvAlerts.Columns[3]); 'D','d': lstvAlertsColumnClick(Sender, lstvAlerts.Columns[4]); 'M','m': lstvAlertsColumnClick(Sender, lstvAlerts.Columns[5]); 'F','f': lstvAlertsColumnClick(Sender, lstvAlerts.Columns[6]); end; end; //hds7397- ge 2/6/6 sort and display date/time column correctly - as requested procedure TfrmPtSel.ReadyAlert; begin if lstvAlerts.SelCount <= 0 then ShowButts(False) else ShowButts(True); GetBAStatus(User.DUZ,Patient.DFN); FAlertsNotReady := FALSE; end; procedure TfrmPtSel.ReformatAlertDateTime; var I,J: Integer; inDateStr, holdDayTime,srtDate: String; begin // convert date to yyyy/mm/dd prior to sort. for J := 0 to lstvAlerts.items.count -1 do begin inDateStr := ''; srtDate := ''; holdDayTime := ''; inDateStr := lstvAlerts.Items[j].SubItems[3]; srtDate := ( (Piece( Piece(inDateStr,'/',3), '@',1)) + '/' + Piece(inDateStr,'/',1) + '/' + Piece(inDateStr,'/',2) +'@'+ Piece(inDateStr, '@',2) ); lstvAlerts.Items[j].SubItems[3] := srtDate; end; //sort the listview records by date lstvAlerts.AlphaSort; // loop thru lstvAlerts change date to yyyy/mm/dd // sort list // change alert date/time back to mm/dd/yyyy@time for display for I := 0 to lstvAlerts.items.Count -1 do begin inDateStr := ''; srtDate := ''; holdDayTime := ''; inDateStr := lstvAlerts.Items[i].SubItems[3]; holdDayTime := Piece(inDateStr,'/',3); // dd@time lstvAlerts.Items[i].SubItems[3] := (Piece(inDateStr, '/', 2) + '/' + Piece(holdDayTime, '@',1) +'/' + Piece(inDateStr,'/',1) + '@' + Piece(holdDayTime,'@',2) ); end; end; procedure TfrmPtSel.AdjustButtonSize(pButton:TButton); var thisButton: TButton; const Gap = 5; begin thisButton := pButton; if thisButton.Width < frmFrame.Canvas.TextWidth(thisButton.Caption) then //CQ2737 GE begin FNotificationBtnsAdjusted := (thisButton.Width < frmFrame.Canvas.TextWidth(thisButton.Caption)); thisButton.Width := (frmFrame.Canvas.TextWidth(thisButton.Caption) + Gap+Gap); //CQ2737 GE end; if thisButton.Height < frmFrame.Canvas.TextHeight(thisButton.Caption) then //CQ2737 GE thisButton.Height := (frmFrame.Canvas.TextHeight(thisButton.Caption) + Gap); //CQ2737 GE end; procedure TfrmPtSel.AdjustNotificationButtons; const Gap = 10; BigGap = 40; // reposition buttons after resizing eliminate overlap. begin if FNotificationBtnsAdjusted then begin cmdProcessAll.Left := (cmdProcessInfo.Left + cmdProcessInfo.Width + Gap); cmdProcess.Left := (cmdProcessAll.Left + cmdProcessAll.Width + Gap); cmdForward.Left := (cmdProcess.Left + cmdProcess.Width + Gap); cmdComments.Left := (cmdForward.Left + cmdForward.Width + Gap); cmdRemove.Left := (cmdComments.Left + cmdComments.Width + BigGap); end; end; end.