iSharkFly-Open
/
VistA-cprs
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
VistA-cprs/CPRS-Chart/fNoteProps.pas

928 lines
36 KiB
Plaintext
Raw Blame History

unit fNoteProps;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ORDtTm, ORCtrls, ExtCtrls, rTIU, uConst, uTIU, ORFn, ORNet,
ComCtrls, Buttons;
type
{This object holds a List of Actions as Returned VIA the RPCBroker}
TPRFActions = class(TObject)
private
FPRFActionList : TStringList;
public
//procedure to show the Action in a ListView, requires a listview parameter
procedure ShowActionsOnList(DisplayList : TCaptionListView);
//procedure to load the actions, this will call the RPC
procedure Load(TitleIEN : Int64; DFN : String);
//returns true if the Action at the Index passed is associated with a note
function SelActionHasNote(lstIndex : integer) : boolean;
//return the Action IEN at the Index passed
function GetActionIEN(lstIndex : integer) : String;
//return the PRF IEN at the Index passed
function GetPRF_IEN(lstIndex : integer) : integer;
constructor Create();
destructor Destroy(); override;
end;
TfrmNoteProperties = class(TForm)
lblNewTitle: TLabel;
cboNewTitle: TORComboBox;
lblDateTime: TLabel;
calNote: TORDateBox;
lblAuthor: TLabel;
cboAuthor: TORComboBox;
lblCosigner: TLabel;
cboCosigner: TORComboBox;
cmdOK: TButton;
cmdCancel: TButton;
pnlConsults: TORAutoPanel;
lblConsult1: TLabel;
lblConsult2: TLabel;
lblCsltDate: TLabel;
lblCsltServ: TLabel;
lblCsltProc: TLabel;
lblCsltStat: TLabel;
lblCsltNotes: TLabel;
lstRequests: TORListBox;
bvlConsult: TBevel;
pnlSurgery: TORAutoPanel;
lblSurgery1: TStaticText;
lblSurgery2: TStaticText;
lblSurgDate: TLabel;
lblSurgProc: TLabel;
lblSurgeon: TLabel;
lstSurgery: TORListBox;
bvlSurgery: TBevel;
cboProcSummCode: TORComboBox;
lblProcSummCode: TOROffsetLabel;
calProcDateTime: TORDateBox;
lblProcDateTime: TOROffsetLabel;
btnShowList: TButton;
pnlPRF: TORAutoPanel;
lblPRF: TLabel;
Bevel1: TBevel;
lvPRF: TCaptionListView;
btnDetails: TButton;
procedure FormShow(Sender: TObject);
procedure cboNewTitleNeedData(Sender: TObject; const StartFrom: String;
Direction, InsertAt: Integer);
procedure NewPersonNeedData(Sender: TObject; const StartFrom: String;
Direction, InsertAt: Integer);
procedure cmdOKClick(Sender: TObject);
procedure cmdCancelClick(Sender: TObject);
procedure cboNewTitleExit(Sender: TObject);
procedure cboNewTitleMouseClick(Sender: TObject);
procedure cboNewTitleEnter(Sender: TObject);
procedure cboCosignerExit(Sender: TObject);
procedure cboAuthorExit(Sender: TObject);
procedure cboAuthorMouseClick(Sender: TObject);
procedure cboAuthorEnter(Sender: TObject);
procedure cboNewTitleDropDownClose(Sender: TObject);
procedure cboNewTitleDblClick(Sender: TObject);
procedure cboCosignerNeedData(Sender: TObject; const StartFrom: String;
Direction, InsertAt: Integer);
procedure btnShowListClick(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure calNoteEnter(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure btnDetailsClick(Sender: TObject);
procedure lstRequestsChange(Sender: TObject);
private
FCosignIEN: Int64; // store cosigner that was passed in
FCosignName: string; // store cosigner that was passed in
FDocType: Integer; // store document type that was passed in
FAddend: Integer; // store IEN of note being addended (if make addendum)
FLastAuthor: Int64; // set by mouseclick to avoid redundant call on exit
FLastTitle: Integer; // set by mouseclick to avoid redundant call on exit
//FFixCursor: Boolean; // to fix the problem where the list box is an I-bar
FLastCosigner: Int64; // holds cosigner from previous note (for defaulting)
FLastCosignerName: string; // holds cosigner from previous note (for defaulting)
FCallingTab: integer;
FIDNoteTitlesOnly: boolean;
FToday: string;
FClassName: string;
FIsClinProcNote: boolean;
FProcSummCode: integer;
FProcDateTime: TFMDateTime;
FCPStatusFlag: integer;
FPRFActions : TPRFActions;
FStarting: boolean;
procedure SetCosignerRequired(DoSetup: boolean);
procedure FormatRequestList;
procedure ShowRequestList(ShouldShow: Boolean);
procedure ShowSurgCaseList(ShouldShow: Boolean);
procedure ShowPRFList(ShouldShow: Boolean);
procedure ShowClinProcFields(YesNo: boolean);
procedure SetGenericFormSize;
procedure UMDelayEvent(var Message: TMessage); message UM_DELAYEVENT;
public
{ Public declarations }
end;
function ExecuteNoteProperties(var ANote: TEditNoteRec; CallingTab: integer; IDNoteTitlesOnly,
IsNewIDEntry: boolean; AClassName: string; CPStatusFlag: integer): Boolean;
const
TX_USER_INACTIVE = 'This entry can be selected, however their system account has been' +CRLF +
' temporarily inactivated and that person should be contacted to resolve the issue.';
TC_INACTIVE_USER = 'Inactive User Alert';
PIXEL_SPACE = 6;
implementation
{$R *.DFM}
uses uCore, rCore, rConsults, uConsults, rSurgery, uAccessibleListBox, fRptBox;
{ Initial values in ANote
Title Type Author DateTime Cosigner Location Consult NeedCPT
New Note dflt 3 DUZ NOW dflt Encnt 0 ?
New DCSumm dflt 244 DUZ NOW dflt Encnt 0 ?
Edit Note ien 3 ien DtTm ien ien ien fld
Edit DCSumm ien 244 ien DtTm ien ien ien fld
Addend Note ien 81 DUZ NOW 0 N/A N/A? no
Addend DCSumm ien 81 DUZ NOW 0 N/A N/A? no
New Note - setup as much as possible, then call ExecuteNoteProperties if necessary.
}
const
TX_CP_CAPTION = 'Clinical Procedure Document Properties';
TX_CP_TITLE = 'Document Title:';
TX_SR_CAPTION = 'Surgical Report Properties';
TX_SR_TITLE = 'Report Title:';
TC_REQ_FIELDS = 'Required Information';
TX_REQ_TITLE = CRLF + 'A title must be selected.';
TX_REQ_AUTHOR = CRLF + 'The author of the note must be identified.';
TX_REQ_REFDATE = CRLF + 'A valid date/time for the note must be entered.';
TX_REQ_COSIGNER = CRLF + 'A cosigner must be identified.';
TX_REQ_REQUEST = CRLF + 'This title requires the selection of an associated consult request.';
TX_REQ_SURGCASE = CRLF + 'This title requires the selection of an associated surgery case.';
TX_REQ_PRF_ACTION = CRLF + 'Notes of this title require the selection of a patient record flag action.';
TX_REQ_PRF_NOTE = CRLF + 'This action has already been assigned to another note.';
TX_NO_FUTURE = CRLF + 'A reference date/time in the future is not allowed.';
TX_COS_SELF = CRLF + 'You cannot make yourself a cosigner.';
TX_COS_AUTH = CRLF + ' is not authorized to cosign this document.';
TX_REQ_PROCSUMMCODE = CRLF + 'A procedure summary code for this procedure must be entered.';
TX_REQ_PROCDATETIME = CRLF + 'A valid date/time for the procedure must be entered.';
TX_INVALID_PROCDATETIME = CRLF + 'If entered, the date/time for the procedure must be in a valid format.';
TX_NO_PROC_FUTURE = CRLF + 'A procedure date/time in the future is not allowed.';
TX_NO_TITLE_CHANGE = 'Interdisciplinary entries may not have their titles changed.';
TC_NO_TITLE_CHANGE = 'Title Change Not Allowed';
TX_NO_NEW_SURGERY = 'New surgery reports can only be entered via the Surgery package.';
TC_NO_NEW_SURGERY = 'Choose another title';
TX_UNRESOLVED_CONSULTS = 'You currently have consults awaiting resolution for this patient.' + CRLF +
'Would you like to see a list of these consults?';
TX_ONE_NOTE_PER_VISIT1 = 'There is already a ';
TX_ONE_NOTE_PER_VISIT2 = CRLF + 'Only ONE record of this type per Visit is allowed...'+
CRLF + CRLF + 'You can addend the existing record.';
ACTIVE_STATUS = 'ACTIVE,PENDING,SCHEDULED';
PRF_LABEL = 'Which Patient Record Flag Action should this Note be linked to?';
FLAG_NAME = 1;
PRF_IEN = 2;
ACTION_NAME = 3;
ACTION_IEN = 4;
ACTION_DATE_I = 5;
ACTION_DATE = 6;
NOTE_IEN = 7;
var
uConsultsList: TStringList;
uShowUnresolvedOnly: boolean;
function ExecuteNoteProperties(var ANote: TEditNoteRec; CallingTab: integer; IDNoteTitlesOnly,
IsNewIDEntry: boolean; AClassName: string; CPStatusFlag: integer): Boolean;
var
frmNoteProperties: TfrmNoteProperties;
begin
frmNoteProperties := TfrmNoteProperties.Create(Application);
uConsultsList := TStringList.Create;
try
ResizeAnchoredFormToFont(frmNoteProperties);
with frmNoteProperties do
begin
// setup common fields (title, reference date, author)
FToday := FloatToStr(FMToday);
FCallingTab := CallingTab;
FIDNoteTitlesOnly := IDNoteTitlesOnly;
FClassName := AClassName;
FIsClinProcNote := (AClassName = DCL_CLINPROC);
FCPStatusFlag := CPStatusFlag;
//uShowUnresolvedOnly := False; //v26.5 (RV)
uShowUnresolvedOnly := True; //v26.5 (RV)
if ANote.DocType <> TYP_ADDENDUM then
begin
case FCallingTab of
CT_CONSULTS: begin
Caption := 'Consult Note Properties';
cboNewTitle.InitLongList('');
if FIsClinProcNote then
begin
Caption := TX_CP_CAPTION;
lblNewTitle.Caption := TX_CP_TITLE;
ListClinProcTitlesShort(cboNewTitle.Items);
cboAuthor.InitLongList(User.Name);
cboAuthor.SelectByIEN(User.DUZ);
cboProcSummCode.SelectByIEN(ANote.ClinProcSummCode);
calProcDateTime.FMDateTime := ANote.ClinProcDateTime;
end
else // not CP note
begin
ListConsultTitlesShort(cboNewTitle.Items);
cboAuthor.InitLongList(ANote.AuthorName);
if ANote.Author > 0 then cboAuthor.SelectByIEN(ANote.Author);
end;
end ;
CT_SURGERY: begin
Caption := TX_SR_CAPTION;
lblNewTitle.Caption := TX_SR_TITLE;
cboNewTitle.InitLongList('');
cboAuthor.InitLongList(ANote.AuthorName);
if ANote.Author > 0 then cboAuthor.SelectByIEN(ANote.Author);
ListSurgeryTitlesShort(cboNewTitle.Items, FClassName);
end;
CT_NOTES: begin
Caption := 'Progress Note Properties';
if ANote.IsNewNote then
begin
GetUnresolvedConsultsInfo; // v26.5 (RV) removed nag screen
end;
cboNewTitle.InitLongList('');
cboAuthor.InitLongList(ANote.AuthorName);
if ANote.Author > 0 then cboAuthor.SelectByIEN(ANote.Author);
ListNoteTitlesShort(cboNewTitle.Items);
// HOW TO PREVENT TITLE CHANGE ON ID CHILD, BUT NOT ON INITIAL CREATE?????
cboNewTitle.Enabled := not ((ANote.IDParent > 0) and (ANote.Title > 0) and (not IsNewIDEntry));
if not cboNewTitle.Enabled then
begin
cboNewTitle.Color := clBtnFace;
InfoBox(TX_NO_TITLE_CHANGE, TC_NO_TITLE_CHANGE, MB_OK);
end;
end;
end;
end
else //if addendum
begin
Caption := 'Addendum Properties';
cboNewTitle.Items.Insert(0, IntToStr(ANote.Title) + U + ANote.TitleName);
cboAuthor.InitLongList(ANote.AuthorName);
if ANote.Author > 0 then cboAuthor.SelectByIEN(ANote.Author);
end;
ShowClinProcFields(FIsClinProcNote);
FStarting := True;
if ANote.Title > 0 then cboNewTitle.SelectByIEN(ANote.Title);
if (ANote.Title > 0) and (cboNewTitle.ItemIndex < 0)
then cboNewTitle.SetExactByIEN(ANote.Title, ANote.TitleName);
FStarting := False;
calNote.FMDateTime := ANote.DateTime;
// setup cosigner fields
FAddend := ANote.Addend;
FCosignIEN := ANote.Cosigner;
FCosignName := ANote.CosignerName;
FDocType := ANote.DocType;
FLastCosigner := ANote.LastCosigner;
FLastCosignerName := ANote.LastCosignerName;
SetCosignerRequired(True);
// setup package fields
SetGenericFormSize;
case FCallingTab of
CT_CONSULTS: begin
ShowRequestList(False);
ShowSurgCaseList(False);
ShowPRFList(False);
end;
CT_SURGERY : begin
ShowRequestList(False);
ShowSurgCaseList(False);
ShowPRFList(False);
end;
CT_NOTES : begin
with uUnresolvedConsults do // v26.5 (RV)
ShowRequestList(IsConsultTitle(ANote.Title) or
(UnresolvedConsultsExist and ShowNagScreen)); // v26.5 (RV)
ShowSurgCaseList(IsSurgeryTitle(ANote.Title));
ShowPRFList(IsPRFTitle(ANote.Title));
end;
end;
// restrict edit of title if addendum
if FDocType = TYP_ADDENDUM then
begin
lblNewTitle.Caption := 'Addendum to:';
cboNewTitle.Enabled := False;
cboNewTitle.Color := clBtnFace;
end;
cboNewTitle.Caption := lblNewTitle.Caption;
FStarting := True;
cboNewTitleExit(frmNoteProperties); // force display of request/case list
FStarting := False;
if uShowUnresolvedOnly then // override previous display if SHOW ME clicked on entrance
begin
//cboNewTitle.ItemIndex := -1; CQ#7587, v26.25 - RV
uShowUnresolvedOnly := not uShowUnresolvedOnly;
FormatRequestList;
end ;
TAccessibleListBox.WrapControl(cboNewTitle);
try
Result := ShowModal = idOK; // display the form
finally
TAccessibleListBox.UnwrapControl(cboNewTitle);
end;
if Result then with ANote do
begin
if FDocType <> TYP_ADDENDUM then
begin
Title := cboNewTitle.ItemIEN;
TitleName := PrintNameForTitle(Title);
end;
IsNewNote := False;
DateTime := calNote.FMDateTime;
Author := cboAuthor.ItemIEN;
AuthorName := Piece(cboAuthor.Items[cboAuthor.ItemIndex], U, 2);
if cboCosigner.Visible then
begin
Cosigner := cboCosigner.ItemIEN;
CosignerName := Piece(cboCosigner.Items[cboCosigner.ItemIndex], U, 2);
// The LastCosigner fields are used to default the cosigner in subsequent notes.
// These fields are not reset with new notes & not passed into TIU.
LastCosigner := Cosigner;
LastCosignerName := CosignerName;
end else
begin
Cosigner := 0;
CosignerName := '';
end;
if FIsClinProcNote then
begin
ClinProcSummCode := FProcSummCode;
ClinProcDateTime := FProcDateTime;
if Location <= 0 then
begin
Location := Encounter.Location;
LocationName := Encounter.LocationName;
end;
if VisitDate <= 0 then VisitDate := Encounter.DateTime;
end;
case FCallingTab of
CT_CONSULTS: ;// no action required
CT_SURGERY : ;// no action required
(*begin
PkgIEN := lstSurgery.ItemIEN;
PkgPtr := PKG_SURGERY;
PkgRef := IntToStr(PkgIEN) + ';' + PkgPtr;
end;*)
CT_NOTES : begin
if pnlConsults.Visible then
begin
PkgIEN := lstRequests.ItemIEN;
PkgPtr := PKG_CONSULTS;
PkgRef := IntToStr(PkgIEN) + ';' + PkgPtr;
end
else if pnlSurgery.Visible then
begin
PkgIEN := lstSurgery.ItemIEN;
PkgPtr := PKG_SURGERY;
PkgRef := IntToStr(PkgIEN) + ';' + PkgPtr;
end
else if pnlPRF.Visible then //PRF
begin
PRF_IEN := FPRFActions.GetPRF_IEN(lvPRF.ItemIndex);
ActionIEN := FPRFActions.GetActionIEN(lvPRF.ItemIndex);
end;
end;
end;
end;
end;
finally
if Assigned(uConsultsList) then uConsultsList.Free;
frmNoteProperties.Free;
end;
end;
{ Form events }
procedure TfrmNoteProperties.FormShow(Sender: TObject);
begin
//if cboNewTitle.Text = '' then PostMessage(Handle, UM_DELAYEVENT, 0, 0);
end;
procedure TfrmNoteProperties.UMDelayEvent(var Message: TMessage);
{ let the window finish displaying before dropping list box, otherwise listbox drop
in the design position rather then new windows position (ORCtrls bug?) }
begin
// Screen.Cursor := crArrow;
// FFixCursor := TRUE;
// cboNewTitle.DroppedDown := True;
// lblDateTime.Visible := False;
// lblAuthor.Visible := False;
// lblCosigner.Visible := False;
end;
{ General calls }
procedure TfrmNoteProperties.SetCosignerRequired(DoSetup: boolean);
{ called initially & whenever title or author changes }
begin
if FDocType = TYP_ADDENDUM then
begin
lblCosigner.Visible := AskCosignerForDocument(FAddend, cboAuthor.ItemIEN)
end else
begin
if cboNewTitle.ItemIEN = 0
then lblCosigner.Visible := AskCosignerForTitle(FDocType, cboAuthor.ItemIEN, calNote.FMDateTime)
else lblCosigner.Visible := AskCosignerForTitle(cboNewTitle.ItemIEN, cboAuthor.ItemIEN, calNote.FMDateTime);
end;
cboCosigner.Visible := lblCosigner.Visible;
if DoSetup then
begin
if lblCosigner.Visible then
begin
if FCosignIEN = 0 then
begin
FCosignIEN := FLastCosigner;
FCosignName := FLastCosignerName;
end;
if FCosignIEN = 0 then DefaultCosigner(FCosignIEN, FCosignName);
cboCosigner.InitLongList(FCosignName);
if FCosignIEN > 0 then cboCosigner.SelectByIEN(FCosignIEN);
end
else // if lblCosigner not visible, clear values {v19.10 - RV}
begin
FCosignIEN := 0;
FCosignName := '';
cboCosigner.ItemIndex := -1;
end;
end;
end;
procedure TfrmNoteProperties.ShowRequestList(ShouldShow: Boolean);
{ called initially & whenever title changes }
const
ALL_CONSULTS = 'The following consults are currently available for selection:';
UNRESOLVED_CONSULTS = 'The following consults are currently awaiting resolution:';
var
i: Integer;
SavedIEN: integer;
begin
ShouldShow := ShouldShow and (FCallingTab = CT_NOTES);
if FDocType = TYP_ADDENDUM then ShouldShow := False;
pnlConsults.Visible := ShouldShow;
if ShouldShow then
begin
SavedIEN := lstRequests.ItemIEN;
ClientHeight := cboCosigner.Top + cboCosigner.Height + PIXEL_SPACE + pnlConsults.Height;
lstRequests.Items.Clear;
if uConsultsList.Count = 0 then ListConsultRequests(uConsultsList);
if uShowUnresolvedOnly then
begin
for i := 0 to uConsultsList.Count - 1 do
if Pos(Piece(uConsultsList[i], U, 5), ACTIVE_STATUS) > 0 then
lstRequests.Items.Add(uConsultsList[i]);
lblConsult2.Caption := UNRESOLVED_CONSULTS;
end
else
begin
lblConsult2.Caption := ALL_CONSULTS;
lstRequests.Items.Assign(uConsultsList);
end;
lblConsult1.Visible := (cboNewTitle.ItemIndex > -1);
lstRequests.SelectByIEN(SavedIEN);
btnDetails.Enabled := (lstRequests.ItemIndex > -1);
end
end;
procedure TfrmNoteProperties.ShowSurgCaseList(ShouldShow: Boolean);
{ called initially & whenever title changes }
begin
pnlSurgery.Visible := ShouldShow;
if FDocType = TYP_ADDENDUM then ShouldShow := False;
if ShouldShow then
begin
ClientHeight := cboCosigner.Top + cboCosigner.Height + PIXEL_SPACE + pnlSurgery.Height;
if lstSurgery.Items.Count = 0 then ListSurgeryCases(lstSurgery.Items);
end
end;
{ cboNewTitle events }
procedure TfrmNoteProperties.cboNewTitleNeedData(Sender: TObject; const StartFrom: string;
Direction, InsertAt: Integer);
begin
case FCallingTab of
CT_CONSULTS: begin
if FIsClinProcNote then
cboNewTitle.ForDataUse(SubSetOfClinProcTitles(StartFrom, Direction, FIDNoteTitlesOnly))
else
cboNewTitle.ForDataUse(SubSetOfConsultTitles(StartFrom, Direction, FIDNoteTitlesOnly));
end;
CT_SURGERY: cboNewTitle.ForDataUse(SubSetOfSurgeryTitles(StartFrom, Direction, FClassName));
CT_NOTES: cboNewTitle.ForDataUse(SubSetOfNoteTitles(StartFrom, Direction, FIDNoteTitlesOnly));
end;
end;
procedure TfrmNoteProperties.cboNewTitleEnter(Sender: TObject);
begin
FLastTitle := 0;
end;
procedure TfrmNoteProperties.cboNewTitleMouseClick(Sender: TObject);
const
TX_NEED_CONSULT_TITLE = 'You currently have unresolved consults awaiting completion.' + CRLF +
'The selected title cannot be used to complete consults.' + CRLF +
'You must select a Consults title to complete a consult.' + CRLF + CRLF +
'Answer "YES" to continue with this title and not complete a consult.' + CRLF +
'Answer "NO" to select a different title.' + CRLF + CRLF +
'Do you want to use this title and continue?';
TC_NOT_CONSULT_TITLE = 'Not a consult title';
var
WantsToCompleteConsult: boolean;
ConsultTitle: boolean;
begin
with cboNewTitle do
if (ItemIEN > 0) and (ItemIEN = FLastTitle) then Exit
else if ItemIEN = 0 then
begin
if FLastTitle > 0 then SelectByIEN(FLastTitle)
else ItemIndex := -1;
//Exit;
end;
case FCallingTab of
CT_CONSULTS: ; // no action
CT_SURGERY : ; // no action
CT_NOTES : begin // v26.5 (RV) main changes here
WantsToCompleteConsult := False;
ConsultTitle := IsConsultTitle(cboNewTitle.ItemIEN);
if (pnlConsults.Visible) and
(lstRequests.Items.Count > 0) and
(not FStarting) and
(*(lstRequests.ItemID <> '') and*)
(not ConsultTitle) then
WantsToCompleteConsult := (InfoBox(TX_NEED_CONSULT_TITLE,
TC_NOT_CONSULT_TITLE,
MB_ICONWARNING or MB_YESNO or MB_DEFBUTTON2) = IDNO);
if WantsToCompleteConsult and (not ConsultTitle) then cboNewTitle.ItemIndex := -1;
SetGenericFormSize;
ShowRequestList(WantsToCompleteConsult or ConsultTitle);
ShowSurgCaseList(IsSurgeryTitle(cboNewTitle.ItemIEN));
ShowPRFList(IsPRFTitle(cboNewTitle.ItemIEN));
end;
end;
SetCosignerRequired(True);
FLastTitle := cboNewTitle.ItemIEN;
end;
procedure TfrmNoteProperties.cboNewTitleExit(Sender: TObject);
begin
if cboNewTitle.ItemIEN <> FLastTitle then cboNewTitleMouseClick(Self);
end;
procedure TfrmNoteProperties.cboNewTitleDblClick(Sender: TObject);
begin
cmdOKClick(Self);
end;
{ cboAuthor & cboCosigner events }
procedure TfrmNoteProperties.NewPersonNeedData(Sender: TObject; const StartFrom: String;
Direction, InsertAt: Integer);
begin
(Sender as TORComboBox).ForDataUse(SubSetOfPersons(StartFrom, Direction));
end;
procedure TfrmNoteProperties.cboAuthorEnter(Sender: TObject);
begin
FLastAuthor := 0;
end;
procedure TfrmNoteProperties.cboAuthorMouseClick(Sender: TObject);
begin
SetCosignerRequired(True);
FLastAuthor := cboAuthor.ItemIEN;
end;
procedure TfrmNoteProperties.cboAuthorExit(Sender: TObject);
begin
if cboAuthor.ItemIEN <> FLastAuthor then cboAuthorMouseClick(Self);
end;
procedure TfrmNoteProperties.cboCosignerExit(Sender: TObject);
{ make sure FCosign fields stay up to date in case SetCosigner gets called again }
//var x: string;
begin
with cboCosigner do if ((Text = '') or (ItemIEN = 0)) then
begin
ItemIndex := -1;
FCosignIEN := 0;
FCosignName := '';
exit;
end;
FCosignIEN := cboCosigner.ItemIEN;
FCosignName := Piece(cboCosigner.Items[cboCosigner.ItemIndex], U, 2);
end;
{ Command Button events }
procedure TfrmNoteProperties.cmdOKClick(Sender: TObject);
var
ErrMsg, WhyNot, AlertMsg: string;
begin
cmdOK.SetFocus; // make sure cbo exit events fire
Application.ProcessMessages;
(* case FCallingTab of
CT_CONSULTS: ; //no action
CT_SURGERY : ; //no action
CT_NOTES : if IsConsultTitle(cboNewTitle.ItemIEN) then
ShowRequestList(True)
else if IsSurgeryTitle(cboNewTitle.ItemIEN) then
{ TODO -oRich V. -cSurgery/TIU : Disallow new surgery notes here - MUST be business rule for "BE ENTERED": }
// New TIU RPC required, to check user and title against business rules.
// Must allow OK button click if surgery title on edit of surgery original.
// Can't pre-screen titles because need to allow change on edit.
// May need additional logic here to distinguish between NEW or EDITED document.
ShowSurgCaseList(True)
else
begin
ShowRequestList(False);
ShowSurgCaseList(False);
ShowPRFList(False);
end;
end;*)
SetCosignerRequired(False);
ErrMsg := '';
if cboNewTitle.ItemIEN = 0 then
ErrMsg := ErrMsg + TX_REQ_TITLE ;
if ErrMsg = '' then
begin
if FDocType = TYP_ADDENDUM then
begin
if OneNotePerVisit(TYP_ADDENDUM, Patient.DFN, Encounter.VisitStr)then
ErrMsg := ErrMsg + TX_ONE_NOTE_PER_VISIT1
+ 'Addendum to ' + Piece(cboNewTitle.Items[cboNewTitle.ItemIndex],U,2)
+ TX_ONE_NOTE_PER_VISIT2;
end
//code added 12/2002 check note parm - one per visit GRE
else if OneNotePerVisit(CboNewTitle.ItemIEN, Patient.DFN, Encounter.VisitStr)then
ErrMsg := ErrMsg + TX_ONE_NOTE_PER_VISIT1
+ Piece(cboNewTitle.Items[cboNewTitle.ItemIndex],U,2)
+ TX_ONE_NOTE_PER_VISIT2;
end;
if ErrMsg = '' then
begin
if FIDNoteTitlesOnly then
begin
if (not CanTitleBeIDChild(cboNewTitle.ItemIEN, WhyNot)) then
ErrMsg := ErrMsg + CRLF + WhyNot;
end
else
begin
if ((pnlConsults.Visible) and (lstRequests.ItemIndex < 0)) then
ErrMsg := ErrMsg + TX_REQ_REQUEST
else if ((pnlSurgery.Visible) and (lstSurgery.ItemIndex < 0)) then
ErrMsg := ErrMsg + TX_REQ_SURGCASE
else if (pnlPRF.Visible) then
begin
if (lvPRF.ItemIndex < 0) then
ErrMsg := ErrMsg + TX_REQ_PRF_ACTION
else if FPRFActions.SelActionHasNote(lvPRF.ItemIndex) then
ErrMsg := ErrMsg + TX_REQ_PRF_NOTE;
end;
end;
end;
if cboAuthor.ItemIEN = 0 then ErrMsg := ErrMsg + TX_REQ_AUTHOR;
if not calNote.IsValid then ErrMsg := ErrMsg + TX_REQ_REFDATE;
if calNote.IsValid and (calNote.FMDateTime > FMNow) then ErrMsg := ErrMsg + TX_NO_FUTURE;
if cboCosigner.Visible then
begin
if (cboCosigner.ItemIEN = 0) then ErrMsg := ErrMsg + TX_REQ_COSIGNER;
//if (cboCosigner.ItemIEN = User.DUZ) then ErrMsg := TX_COS_SELF; // (CanCosign will do this check)
if (cboCosigner.ItemIEN > 0) and not CanCosign(cboNewTitle.ItemIEN, FDocType, cboCosigner.ItemIEN, calNote.FMDateTime)
then ErrMsg := cboCosigner.Text + TX_COS_AUTH;
//code added 02/2003 check if User is Inactive GRE
if UserInactive(IntToStr(cboCosigner.ItemIEN)) then
if (InfoBox(fNoteProps.TX_USER_INACTIVE, TC_INACTIVE_USER, MB_OKCANCEL)= IDCANCEL) then exit;
end;
if FIsClinProcNote then
begin
if (FCPStatusFlag = CP_INSTR_INCOMPLETE) then
begin
if cboProcSummCode.ItemIEN = 0 then ErrMsg := ErrMsg + TX_REQ_PROCSUMMCODE
else FProcSummCode := cboProcSummCode.ItemIEN;
if not calProcDateTime.IsValid then ErrMsg := ErrMsg + TX_REQ_PROCDATETIME
else if calProcDateTime.IsValid and (calProcDateTime.FMDateTime > FMNow) then ErrMsg := ErrMsg + TX_NO_PROC_FUTURE
else FProcDateTime := calProcDateTime.FMDateTime;
end
else
begin
FProcSummCode := cboProcSummCode.ItemIEN;
if (calProcDateTime.FMDateTime > 0) then
begin
if (not calProcDateTime.IsValid) then ErrMsg := ErrMsg + TX_INVALID_PROCDATETIME
else if calProcDateTime.IsValid and (calProcDateTime.FMDateTime > FMNow) then ErrMsg := ErrMsg + TX_NO_PROC_FUTURE
else FProcDateTime := calProcDateTime.FMDateTime;
end;
end;
end;
if ShowMsgOn(Length(ErrMsg) > 0, ErrMsg, TC_REQ_FIELDS)
then Exit
else ModalResult := mrOK;
//Code added to handle inactive users. 2/26/03
if ShowMsgOn(Length(AlertMsg) > 0, AlertMsg, TC_INACTIVE_USER ) then
ModalResult := mrOK;
end;
procedure TfrmNoteProperties.cmdCancelClick(Sender: TObject);
begin
ModalResult := mrCancel;
//Close;
end;
procedure TfrmNoteProperties.cboNewTitleDropDownClose(Sender: TObject);
begin
// if FFixCursor then
// begin
// Screen.Cursor := crDefault;
// FFixCursor := FALSE;
// end;
// lblDateTime.Visible := True;
// lblAuthor.Visible := True;
// lblCosigner.Visible := True;
end;
procedure TfrmNoteProperties.cboCosignerNeedData(Sender: TObject;
const StartFrom: String; Direction, InsertAt: Integer);
begin
(Sender as TORComboBox).ForDataUse(SubSetOfUsersWithClass(StartFrom, Direction, FToday));
end;
procedure TfrmNoteProperties.ShowClinProcFields(YesNo: boolean);
begin
lblProcSummCode.Visible := YesNo;
cboProcSummCode.Visible := YesNo;
lblProcDateTime.Visible := YesNo;
calProcDateTime.Visible := YesNo;
end;
procedure TfrmNoteProperties.btnShowListClick(Sender: TObject);
begin
FormatRequestList;
end;
procedure TfrmNoteProperties.FormatRequestList;
const
SHOW_UNRESOLVED = 'Show Unresolved';
SHOW_ALL = 'Show All';
begin
uShowUnresolvedOnly := not uShowUnresolvedOnly;
with btnShowList do
if uShowUnresolvedOnly then
Caption := SHOW_ALL
else
Caption := SHOW_UNRESOLVED;
with uUnresolvedConsults do if (UnresolvedConsultsExist and ShowNagScreen) then pnlConsults.Visible := TRUE; //v26.27 (RV)
ShowRequestList(pnlConsults.Visible); //v26.5 (RV)
//ShowRequestList(True); //v26.5 (RV)
end;
procedure TfrmNoteProperties.FormResize(Sender: TObject);
const
SPACE: integer = 10;
begin
cboNewTitle.Width := Self.ClientWidth - cboNewTitle.Left - cmdOK.Width - SPACE * 2;
cmdOK.Left := Self.ClientWidth - cmdOK.Width - SPACE;
cmdCancel.Left := Self.ClientWidth - cmdCancel.Width - SPACE;
if (cboAuthor.Width + cboAuthor.Left) > Self.ClientWidth then
cboAuthor.Width := Self.ClientWidth - cboAuthor.Left - SPACE;
end;
procedure TfrmNoteProperties.calNoteEnter(Sender: TObject);
begin
if Sender is TORDateBox then
(Sender as TORDateBox).SelectAll;
end;
procedure TfrmNoteProperties.ShowPRFList(ShouldShow: Boolean);
begin
pnlPRF.Visible := ShouldShow and not (FDocType = TYP_ADDENDUM);
if pnlPRF.Visible then
begin
ClientHeight := cboCosigner.Top + cboCosigner.Height + PIXEL_SPACE + pnlPRF.Height;
if FPRFActions = nil then
FPRFActions := TPRFActions.Create;
FPRFActions.Load(cboNewTitle.ItemIEN,Patient.DFN);
if RPCBrokerV.Results.Count <> 0 then
lblPRF.Caption := PRF_LABEL
else
lblPRF.Caption := 'No Linkable Actions for this Patient and/or Title.';
FPRFActions.ShowActionsOnList(lvPRF);
//Fix for CQ: 6926
lvPRF.Columns.BeginUpdate;
lvPRF.Columns.EndUpdate;
//End Fix for CQ: 6926
end
end;
procedure TfrmNoteProperties.SetGenericFormSize;
begin
ClientHeight := cboCosigner.Top + cboCosigner.Height + PIXEL_SPACE;
end;
{ TPRFActions }
constructor TPRFActions.Create;
begin
inherited;
FPRFActionList := TStringList.Create;
end;
destructor TPRFActions.Destroy;
begin
FPRFActionList.Free;
inherited;
end;
function TPRFActions.GetActionIEN(lstIndex: integer): String;
begin
Result := Piece(FPRFActionList[lstIndex],U,ACTION_IEN);
end;
function TPRFActions.GetPRF_IEN(lstIndex: integer): integer;
begin
Result := StrToInt(Piece(FPRFActionList[lstIndex],U,PRF_IEN));
end;
procedure TPRFActions.Load(TitleIEN : Int64; DFN : String);
begin
CallV('TIU GET PRF ACTIONS', [TitleIEN,DFN]);
FPRFActionList.Assign(RPCBrokerV.Results);
end;
function TPRFActions.SelActionHasNote(lstIndex: integer): boolean;
begin
Result := false;
if Piece(FPRFActionList[lstIndex],U,NOTE_IEN) <> '' then
Result := true;
end;
procedure TPRFActions.ShowActionsOnList(DisplayList: TCaptionListView);
var
i : integer;
ListItem: TListItem;
begin
DisplayList.Clear;
for i := 0 to FPRFActionList.Count-1 do
begin
//Caption="Text for Screen Reader" SubItem1=Flag SubItem2=Date SubItem3=Action SubItem4=Note
ListItem := DisplayList.Items.Add;
ListItem.Caption := PRF_LABEL; //Screen readers don't read the first column title on a listview.
ListItem.SubItems.Add(Piece(FPRFActionList[i],U,FLAG_NAME));
ListItem.SubItems.Add(Piece(FPRFActionList[i],U,ACTION_DATE));
ListItem.SubItems.Add(Piece(FPRFActionList[i],U,ACTION_NAME));
if SelActionHasNote(i) then
ListItem.SubItems.Add('Yes')
else
ListItem.SubItems.Add('No');
end;
end;
procedure TfrmNoteProperties.FormDestroy(Sender: TObject);
begin
FPRFActions.Free;
end;
procedure TfrmNoteProperties.btnDetailsClick(Sender: TObject);
var
ConsultDetail: TStringList;
begin
if lstRequests.ItemIEN <= 0 then exit;
ConsultDetail := TStringList.Create;
try
LoadConsultDetail(ConsultDetail, lstRequests.ItemIEN) ;
ReportBox(ConsultDetail, 'Consult Details: #' + lstRequests.ItemID + ' - ' +
Piece(lstRequests.Items[lstRequests.ItemIndex], U, 3), TRUE);
finally
ConsultDetail.Free;
end;
end;
procedure TfrmNoteProperties.lstRequestsChange(Sender: TObject);
begin
btnDetails.Enabled := (lstRequests.ItemIEN > 0);
end;
end.
Reference in New Issue View Git Blame Copy Permalink