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, DKLang, Buttons; type TfrmPtSel = class(TForm) 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; DKLanguageController1: TDKLanguageController; RadioGroup1: TRadioGroup; TMGcmdAdd: TButton; btnSearchPt: TBitBtn; 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 FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure lstvAlertsKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure FormShow(Sender: TObject); procedure TMGcmdAddClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure btnSearchPtClick(Sender: TObject); private FsortCol: integer; FsortAscending: boolean; FLastPt: string; FsortDirection: string; FUserCancelled: boolean; 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 OpenPatient(NewSelectedPtIEN : string; InfoStr : string); //kt 6/3/10 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; SortViaKeyboard: boolean; implementation {$R *.DFM} uses rCore, uCore, fDupPts, fPtSens, fPtSelDemog, fPtSelOptns, fPatientFlagMulti, uOrPtf, fAlertForward, rMisc, fFrame, fPtAdd, fPtQuery; const TX_DGSR_ERR = 'Unable to perform sensitive record checks'; TC_DGSR_ERR = 'Error'; TC_DGSR_SHOW = 'Restricted Record'; TC_DGSR_DENY = 'Access Denied'; TX_DGSR_YESNO = CRLF + 'Do you want to continue processing this patient record?'; 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; // TheFormHeight: integer; SplitterTop, t1, t2, t3: integer; begin ResizeAnchoredFormToFont(self); // TheFormHeight := pnlPtSel.Height; // Make the form bigger (140%) to show notifications and show notification controls. if ShowNotif then begin // TheFormHeight := Round(TheFormHeight * 2.4); // pnlDivide.Height := lblNotifications.Height + 4; pnlDivide.Visible := True; lstvAlerts.Visible := True; pnlNotifications.Visible := True; pnlPtSel.BevelOuter := bvRaised; // ClientHeight := TheFormHeight; end else begin pnlDivide.Visible := False; lstvAlerts.Visible := False; pnlNotifications.Visible := False; // ClientHeight := TheFormHeight; // pnlPtSel.Anchors := [akLeft,akRight,akTop,akBottom]; end; // ClientHeight := TheFormHeight; // VertScrollBar.Range := TheFormHeight; //After all of this calcualtion, we still use the saved preferences when possible 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; 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.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 NoAlias := Piece(Items[Items.Count-1], U, 1) + U + NoAlias; 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: PatientList.Assign(ReadRPLPtList(RPLJob, NoAlias, Direction)) else begin PatientList.Assign(SubSetOfPatients(NoAlias, Direction)); 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; { Command Button events: } procedure TfrmPtSel.cmdOKClick(Sender: TObject); { Checks for restrictions on the selected patient and sets up the Patient object. } var InfoStr : string; begin if cboPatient.ItemIndex > -1 then begin InfoStr := cboPatient.Items[cboPatient.ItemIndex]; end else begin InfoStr := ''; end; with cboPatient do begin OpenPatient(ItemID, InfoStr); end; (* { Checks for restrictions on the selected patient and sets up the Patient object. } const DLG_CANCEL = False; DGSR_FAIL = -1; DGSR_NONE = 0; DGSR_SHOW = 1; DGSR_ASK = 2; DGSR_DENY = 3; var NewDFN, AMsg: string; //*DFN* AccessStatus: Integer; DateDied: TFMDateTime; 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; CheckSensitiveRecordAccess(NewDFN, AccessStatus, AMsg); case AccessStatus of DGSR_FAIL: begin InfoBox(TX_DGSR_ERR, TC_DGSR_ERR, MB_OK); Exit; end; DGSR_NONE: { Nothing - allow access to the patient. }; // DGSR_SHOW: InfoBox(AMsg, TC_DGSR_SHOW, MB_OK); DGSR_SHOW: InfoBox(DKLangConstW('ptSelWarning'), DKLangConstW('fPatSel_Restricted'), MB_OK); DGSR_ASK: if InfoBox(AMsg + TX_DGSR_YESNO, TC_DGSR_SHOW, MB_YESNO or MB_ICONWARNING or MB_DEFBUTTON2) = IDYES then LogSensitiveRecordAccess(NewDFN) else Exit; else begin InfoBox(AMsg, TC_DGSR_DENY, MB_OK); Exit; end; end; 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; *) end; procedure TfrmPtSel.OpenPatient(NewSelectedPtIEN, InfoStr : string); //kt This function used to be named cmdOKClick. I split into separate functions // so that it can be called by AddNewPatient, and SearchForPatient functionality. // However, after splitting the function, I see that many info pieces are needed // from the cboPatient list, so substituting that is problematic. It may be optional. // 6/3/10 { Checks for restrictions on the selected patient and sets up the Patient object. } const DLG_CANCEL = False; DGSR_FAIL = -1; DGSR_NONE = 0; DGSR_SHOW = 1; DGSR_ASK = 2; DGSR_DENY = 3; var NewDFN, AMsg: string; //*DFN* AccessStatus: Integer; DateDied: TFMDateTime; begin if (NewSelectedPtIEN='') then begin //*DFN* InfoBox('A patient has not been selected.', 'No Patient Selected', MB_OK); Exit; end; NewDFN := NewSelectedPtIEN; //*DFN* if FLastPt <> NewDFN then begin HasActiveFlg(FlagList, HasFlag, NewDFN); flastpt := NewDFN; end; If DupLastSSN(NewDFN) then begin // Check for, deal with duplicate patient data. if (DupDFN = 'Cancel') then begin Exit end else begin NewDFN := DupDFN; end; end; CheckSensitiveRecordAccess(NewDFN, AccessStatus, AMsg); case AccessStatus of DGSR_FAIL: begin InfoBox(TX_DGSR_ERR, TC_DGSR_ERR, MB_OK); Exit; end; DGSR_NONE: { Nothing - allow access to the patient. }; // DGSR_SHOW: InfoBox(AMsg, TC_DGSR_SHOW, MB_OK); DGSR_SHOW: InfoBox(DKLangConstW('ptSelWarning'), DKLangConstW('fPatSel_Restricted'), MB_OK); DGSR_ASK: if InfoBox(AMsg + TX_DGSR_YESNO, TC_DGSR_SHOW, MB_YESNO or MB_ICONWARNING or MB_DEFBUTTON2) = IDYES then LogSensitiveRecordAccess(NewDFN) else Exit; else begin InfoBox(AMsg, TC_DGSR_DENY, MB_OK); Exit; end; end; {case} DateDied := DateOfDeath(NewDFN); if (DateDied > 0) then begin if 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 begin Exit; end; end; // 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(InfoStr, U, 4)) then begin// Clinics, not by default. Encounter.Location := frmPtSelOptns.cboList.ItemIEN; Encounter.DateTime := MakeFMDateTime(Piece(InfoStr, U, 4)); end else if (frmPtSelOptns.SrcType = TAG_SRC_DFLT) and (DfltPtListSrc = 'C') and IsFMDateTime(Piece(InfoStr, U, 4)) then begin // "Default" is a clinic. Encounter.Location := StrToIntDef(Piece(InfoStr, U, 10), 0); // Piece 10 is ^SC( location IEN in this case. Encounter.DateTime := MakeFMDateTime(Piece(InfoStr, U, 4)); end else if ((frmPtSelOptns.SrcType = TAG_SRC_DFLT) and (FDfltSrc = 'Combination') and (copy(Piece(InfoStr, U, 3), 1, 2) = 'Cl')) and (IsFMDateTime(Piece(InfoStr, U, 8))) then begin// "Default" combination, clinic pt. Encounter.Location := StrToIntDef(Piece(InfoStr, U, 7), 0); // Piece 7 is ^SC( location IEN in this case. Encounter.DateTime := MakeFMDateTime(Piece(InfoStr, U, 8)); end else if Patient.Inpatient then begin// Everything else: 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.cmdProcessClick(Sender: TObject); var AFollowUp, i, infocount: Integer; enableclose: boolean; ADFN, x, RecordID, XQAID: string; //*DFN* begin 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); 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 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 for i := 0 to lstvAlerts.Items.Count-1 do lstvAlerts.Items[i].Selected := True; cmdProcessClick(Self); ShowButts(False); end; procedure TfrmPtSel.lstvAlertsDblClick(Sender: TObject); begin cmdProcessClick(Self); end; procedure TfrmPtSel.cmdForwardClick(Sender: TObject); var i: integer; Alert: String; begin 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 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); begin SaveUserBounds(Self); frmFrame.EnduringPtSelSplitterPos := pnlPtSel.Height; 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; //kt ... didn't work.... frmPtSelOptns.Height := 184; //kt added to prevent resizing (anchor settings not effective) end; procedure TfrmPtSel.Loaded; begin inherited; // 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 := 65; Left := cboPatient.Left + cboPatient.Width + 9; Width := pnlPtSel.Width - Left - 2; TabOrder := cmdCancel.TabOrder + 1; //Place after cancel button Show; SendToBack; //kt added to keep from writing over other "In-Depth" component end; 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.RPLDisplay; begin // Make unneeded components invisible: cmdSaveList.visible := false; frmPtSelOptns.visible := false; end; procedure TfrmPtSel.FormClose(Sender: TObject; var Action: TCloseAction); begin 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.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 := 30; //Info Caption Columns[1].Width := 120; //Patient SubItems[0] Columns[2].Width := 60; //Location SubItems[1] Columns[3].Width := 60; //Urgency SubItems[2] Columns[4].Width := 110; //Alert Date/Time SubItems[3] Columns[5].Width := 312; //Message Text SubItems[4] Columns[6].Width := 210; //Forwarded By/When SubItems[5] //Items not displayed in Columns: XQAID SubItems[6] // Remove w/o process SubItems[7] // Forwarding comments SubItems[8] end; //with lstvAlerts do ca comment out 12/24/03 to prevent default selection of first alert on list //if (ItemIndex = -1) and (Items.Count > 0) then //ItemIndex := 0; end; procedure TfrmPtSel.lstvAlertsColumnClick(Sender: TObject; Column: TListColumn); begin if ((FsortCol = Column.Index) and (not SortViaKeyboard)) 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; SortViaKeyboard := false; //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 // lstFlags.Items.Assign(FlagList); // 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 lstvAlerts.SelCount <= 0 then ShowButts(False) else ShowButts(True); GetBAStatus(User.DUZ,Patient.DFN); end; procedure TfrmPtSel.ShowButts(ShowButts: Boolean); begin cmdProcess.Enabled := ShowButts; cmdRemove.Enabled := ShowButts; cmdForward.Enabled := ShowButts; end; procedure TfrmPtSel.lstvAlertsInfoTip(Sender: TObject; Item: TListItem; var InfoTip: String); begin InfoTip := Item.SubItems[8]; end; procedure TfrmPtSel.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); { var keyValue: word; } begin{ keyValue := MapVirtualKey(Key,2); if keyValue = VK_RETURN then cmdProcessClick(Sender); } 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 lstvAlerts.Focused then begin SortViaKeyboard := true; 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.FormShow(Sender: TObject); { //KW Sort Alerts by last-used method for current user } var sortResult: string; sortMethod: string; begin //kt TMGcmdAdd.Enabled := (frmPtAdd <> nil); //kt Disable button when first starting up... sortResult := rCore.GetSortMethod; sortMethod := Piece(sortResult, U, 1); 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.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.TMGcmdAddClick(Sender: TObject); //kt added function begin if frmPtAdd <> nil then begin self.hide; frmPtAdd.Showmodal; self.show; if frmPtAdd.DFN > 0 then begin if cboPatient.SelectByIEN(frmPtAdd.DFN) = -1 then begin MessageDlg(DKLangConstW('fPtSel_Patient_successfully_addedx') +#10+#13+ DKLangConstW('fPtSel_You_may_now_Type_in_Patient_name_to_Select_Itx')+#10+#13+ #10+#13+ DKLangConstW('fPtSel_Additional_demographics_may_be_entered_from_Demographics_page')+#10+#13+ DKLangConstW('fPtSel_xxCover_Sheet_tab_xxx_ViewxDemographics_menu_xxx_Edit_Patient_buttonx'), mtInformation,[mbOK],0); end; end; end else begin MessageDlg(DKLangConstW('fPtSel_CPRS_has_not_completed_log_inx')+#10+#13+ DKLangConstW('fPtSel_Adding_a_new_patient_not_allowed_nowx')+#10+#13+ #10+#13+ DKLangConstW('fPtSel_Please_choose_an_existing_patient_and_retry_laterx'), mtInformation, [mbOK],0); end; end; procedure TfrmPtSel.FormCreate(Sender: TObject); //added by ELH 6/20/08 begin TMGcmdAdd.Visible := boolTMGPatchInstalled and not User.HasKey('TMG CPRS HIDE ADDPATIENT'); end; procedure TfrmPtSel.btnSearchPtClick(Sender: TObject); var InfoStr : string; IEN : int64; begin frmPtQuery.InitializeForm('PATIENT', 2); if frmPtQuery.ShowModal = mrOK then begin cboPatient.InitLongList(frmPtQuery.SelectedName); IEN := StrToInt64Def(frmPtQuery.SelectedIEN,0); if IEN < 1 then exit; cboPatient.SelectByIEN(IEN); if cboPatient.ItemID = frmPtQuery.SelectedIEN then begin InfoStr := cboPatient.Items[cboPatient.ItemIndex]; end else begin InfoStr := ''; end; OpenPatient(frmPtQuery.SelectedIEN, InfoStr); end; end; Initialization SortViaKeyboard := false; end.