Module

fConsults

Path

C:\CPRS\CPRS30\Consults\fConsults.pas

Last Modified

7/15/2014 3:26:34 PM

Comments

Notes of Intent:
  Tab Order:
    The tab order has been custom coded to place the pnlRight in the Tab order
    right after the tvConsults.

Initialization Code

initialization
  SpecifyFormIsNotADialog(TfrmConsults);
  uPCEEdit := TPCEData.Create;
  uPCEShow := TPCEData.Create;

Finalization Code

finalization
  uPCEEdit.Free;
  uPCEShow.Free;

end.

Units Used in Interface

Name Comments
fBase508Form -
fDrawers -
fHSplit -
fPrintList -
rOrders -
rTIU -
uConst -
uConsults -
uDocTree -
uPCE -
uTIU -

Units Used in Implementation

Name Comments
dShared -
fAddlSigners -
fConsMedRslt -
fConsult513Prt -
fConsultAct -
fConsultBD -
fConsultBS -
fConsultBSt -
fConsultsView -
fCsltNote -
fEditConsult -
fEditProc -
fEncnt -
fEncounterFrame -
fFrame -
fIconLegend -
fNoteCPFields -
fNoteDR -
fNoteIDParents -
fNoteProps -
fNotePrt -
fNotes -
fNotesBP -
fODConsult -
fODProc -
fOrders -
fReminderDialog -
fReminderTree -
fRptBox -
fSignItem -
fTemplateDialog -
fTemplateEditor -
fTemplateFieldEditor -
fVisit -
rConsults -
rCore -
rODBase -
rPCE -
rReports -
rTemplates -
rVitals -
uCore -
uOrders -
uReminders -
uSpell -
uTemplates -
uVA508CPRSCompatibility -

Classes

Name Comments
TfrmConsults -

Procedures

Name Owner Declaration Scope Comments
AssignBoilerText - procedure AssignBoilerText; Local -
AssignRemForm TfrmConsults procedure AssignRemForm; Public -
ClearEditControls TfrmConsults procedure ClearEditControls; Private
Function MakeTitleText(IsAddendum: Boolean = False): string;
General procedures -----------------------------------------------------------------------
ClearPtData TfrmConsults procedure ClearPtData; override; Public Clear all controls that contain patient specific information
cmdChangeClick TfrmConsults procedure cmdChangeClick(Sender: TObject); Public/Published -
cmdEditResubmitClick TfrmConsults procedure cmdEditResubmitClick(Sender: TObject); Public/Published -
cmdEditResubmitExit TfrmConsults procedure cmdEditResubmitExit(Sender: TObject); Public/Published -
cmdNewConsultClick TfrmConsults procedure cmdNewConsultClick(Sender: TObject); Public/Published Maps 'New Consult' button to the New Consult menu item
cmdNewConsultExit TfrmConsults procedure cmdNewConsultExit(Sender: TObject); Public/Published -
cmdNewProcClick TfrmConsults procedure cmdNewProcClick(Sender: TObject); Public/Published -
cmdPCEClick TfrmConsults procedure cmdPCEClick(Sender: TObject); Public/Published -
CompleteConsult TfrmConsults procedure CompleteConsult(IsIDChild: boolean; AnIDParent: integer; UseClinProcTitles: boolean); Private Creates the editing context for a new progress note & inserts stub into top of view list
DisplayPage TfrmConsults procedure DisplayPage; override; Public Causes page to be visible and conditionally executes initialization code
DisplayPCE TfrmConsults procedure DisplayPCE; Private Displays PCE information if appropriate & enables/disables editing of PCE data
dlgFindTextFind TfrmConsults procedure dlgFindTextFind(Sender: TObject); Public/Published -
dlgReplaceTextFind TfrmConsults procedure dlgReplaceTextFind(Sender: TObject); Public/Published -
dlgReplaceTextReplace TfrmConsults procedure dlgReplaceTextReplace(Sender: TObject); Public/Published -
DoAttachIDChild TfrmConsults procedure DoAttachIDChild(AChild, AParent: TORTreeNode); Private -
DoAutoSave TfrmConsults procedure DoAutoSave(Suppress: integer = 1); Private -
DoLeftPanelCustomShiftTab TfrmConsults procedure DoLeftPanelCustomShiftTab; Private FMousing: TDateTime;
EnableDisableIDNotes TfrmConsults procedure EnableDisableIDNotes; Private -
EnableDisableOrdering TfrmConsults procedure EnableDisableOrdering; Public/Published -
FormClose TfrmConsults procedure FormClose(Sender: TObject; var Action: TCloseAction); Public/Published -
FormCreate TfrmConsults procedure FormCreate(Sender: TObject); Public/Published -
FormDestroy TfrmConsults procedure FormDestroy(Sender: TObject); Public/Published
Procedure TfrmConsults.lstNotesDrawItem(Control: TWinControl;
  Index: Integer; Rect: TRect; State: TOwnerDrawState);
var
  x: string;
const
  STD_DATE = 'MMM DD,YY';
begin
  inherited;
   with (Control as TORListBox).Canvas do  {draw on control canvas, not on the form }
    begin
      FImageFlag.LoadFromResourceName(hInstance, 'BMP_IMAGEFLAG_1');
      x := (Control as TORListBox).Items[Index];
      (Control as TORListBox).ItemHeight := HigherOf(TextHeight(x), FImageFlag.Height);
      FillRect(Rect);       {clear the rectangle }
      if StrToIntDef(Piece(x, U, 7), 0) > 0 then
        begin
          if StrToIntDef(Piece(x, U, 7), 0) = 1 then
            FImageFlag.LoadFromResourceName(hInstance, 'BMP_IMAGEFLAG_1')
          else if StrToIntDef(Piece(x, U, 7), 0) = 2 then
            FImageFlag.LoadFromResourceName(hInstance, 'BMP_IMAGEFLAG_2')
          else if StrToIntDef(Piece(x, U, 7), 0) > 2 then
            FImageFlag.LoadFromResourceName(hInstance, 'BMP_IMAGEFLAG_3');
          BrushCopy(Bounds(Rect.Left, Rect.Top, FImageFlag.Width, FImageFlag.Height),
            FImageFlag, Bounds(0, 0, FImageFlag.Width, FImageFlag.Height), clRed); {render ImageFlag}
        end;
      TextOut(Rect.Left + FImageFlag.Width, Rect.Top, Piece(x, U, 2));
      TextOut(Rect.Left + FImageFlag.Width + TextWidth(STD_DATE), Rect.Top, Piece(x, U, 3));
    end;
end;
FormHide TfrmConsults procedure FormHide(Sender: TObject); Public/Published -
FormShow TfrmConsults procedure FormShow(Sender: TObject); Public/Published -
frmFramePnlPatientExit TfrmConsults procedure frmFramePnlPatientExit(Sender: TObject); Private -
InsertAddendum TfrmConsults procedure InsertAddendum; Private Sets up fields of pnlWrite to write an addendum for the selected note
LoadConsults TfrmConsults procedure LoadConsults; Private =========================== Consults Treeview Code ==================================
LoadForEdit TfrmConsults procedure LoadForEdit ; Private Retrieves an existing note and places the data in the fields of pnlWrite
lstConsultsClick TfrmConsults procedure lstConsultsClick(Sender: TObject); Public/Published
Left panel (selector) events ------------------------------------------------------------- 

 loads the text for the selected Consult
LstConsultsToPrint TfrmConsults procedure LstConsultsToPrint; Public -
lstNotesClick TfrmConsults procedure lstNotesClick(Sender: TObject); Public/Published Loads the text for the selected note or displays the editing panel for the selected note
memResultChange TfrmConsults procedure memResultChange(Sender: TObject); Public/Published Sets FChanged to record that the note has really been edited
memResultsKeyDown TfrmConsults procedure memResultsKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); Public/Published -
mnuActAddIDEntryClick TfrmConsults procedure mnuActAddIDEntryClick(Sender: TObject); Public/Published
AConsultID: string;
 switches to current new note or creates a new note if none is being edited already
mnuActAttachMedClick TfrmConsults procedure mnuActAttachMedClick(Sender: TObject); Public/Published -
mnuActAttachtoIDParentClick TfrmConsults procedure mnuActAttachtoIDParentClick(Sender: TObject); Public/Published -
mnuActChangeClick TfrmConsults procedure mnuActChangeClick(Sender: TObject); Public/Published -
mnuActCompleteClick TfrmConsults procedure mnuActCompleteClick(Sender: TObject); Public/Published Action menu events -----------------------------------------------------------------------
mnuActConsultClick TfrmConsults procedure mnuActConsultClick(Sender: TObject); Public/Published I:integer ;
mnuActDetachFromIDParentClick TfrmConsults procedure mnuActDetachFromIDParentClick(Sender: TObject); Public/Published -
mnuActDisplayDetailsClick TfrmConsults procedure mnuActDisplayDetailsClick(Sender: TObject); Public/Published -
mnuActDisplayResultsClick TfrmConsults procedure mnuActDisplayResultsClick(Sender: TObject); Public/Published -
mnuActDisplaySF513Click TfrmConsults procedure mnuActDisplaySF513Click(Sender: TObject); Public/Published -
mnuActEditResubmitClick TfrmConsults procedure mnuActEditResubmitClick(Sender: TObject); Public/Published -
mnuActIdentifyAddlSignersClick TfrmConsults procedure mnuActIdentifyAddlSignersClick(Sender: TObject); Public/Published -
mnuActLoadBoilerClick TfrmConsults procedure mnuActLoadBoilerClick(Sender: TObject); Public/Published -
mnuActMakeAddendumClick TfrmConsults procedure mnuActMakeAddendumClick(Sender: TObject); Public/Published ANoteID, AConsultID: string;
mnuActNewConsultRequestClick TfrmConsults procedure mnuActNewConsultRequestClick(Sender: TObject); Public/Published -
mnuActNewProcedureClick TfrmConsults procedure mnuActNewProcedureClick(Sender: TObject); Public/Published -
mnuActNoteDeleteClick TfrmConsults procedure mnuActNoteDeleteClick(Sender: TObject); Public/Published Delete the selected progress note & remove from the Encounter object if necessary
mnuActNoteEditClick TfrmConsults procedure mnuActNoteEditClick(Sender: TObject); Public/Published
Load the selected progress note for editing 
AConsultID, ANoteID: string;
mnuActNotePrintClick TfrmConsults procedure mnuActNotePrintClick(Sender: TObject); Public/Published -
mnuActPrintSF513Click TfrmConsults procedure mnuActPrintSF513Click(Sender: TObject); Public/Published -
mnuActRemoveMedClick TfrmConsults procedure mnuActRemoveMedClick(Sender: TObject); Public/Published -
mnuActSignatureListClick TfrmConsults procedure mnuActSignatureListClick(Sender: TObject); Public/Published Add the note to the Encounter object, see mnuActSignatureSignClick - copied
mnuActSignatureSaveClick TfrmConsults procedure mnuActSignatureSaveClick(Sender: TObject); Public/Published
Saves the Consult that is currently being edited 
  i: integer;
mnuActSignatureSignClick TfrmConsults procedure mnuActSignatureSignClick(Sender: TObject); Public/Published Sign the currently selected note, save first if necessary
mnuChartTabClick TfrmConsults procedure mnuChartTabClick(Sender: TObject); Public/Published Reroute to Chart Tab menu of the parent form: frmFrame
mnuEditDialgFieldsClick TfrmConsults procedure mnuEditDialgFieldsClick(Sender: TObject); Public/Published -
mnuEditSharedTemplatesClick TfrmConsults procedure mnuEditSharedTemplatesClick(Sender: TObject); Public/Published -
mnuEditTemplatesClick TfrmConsults procedure mnuEditTemplatesClick(Sender: TObject); Public/Published -
mnuIconLegendClick TfrmConsults procedure mnuIconLegendClick(Sender: TObject); Public/Published -
mnuNewSharedTemplateClick TfrmConsults procedure mnuNewSharedTemplateClick(Sender: TObject); Public/Published -
mnuNewTemplateClick TfrmConsults procedure mnuNewTemplateClick(Sender: TObject); Public/Published -
mnuOptionsClick TfrmConsults procedure mnuOptionsClick(Sender: TObject); Public/Published -
mnuViewClick TfrmConsults procedure mnuViewClick(Sender: TObject); Public/Published
View menu events ------------------------------------------------------------------------- 

 changes the list of Consults available for viewing 
tmpNode: TTreeNode;
mnuViewInformationClick TfrmConsults procedure mnuViewInformationClick(Sender: TObject); Public/Published -
mnuViewReturntoDefaultClick TfrmConsults procedure mnuViewReturntoDefaultClick(Sender: TObject); Public/Published -
mnuViewSaveAsDefaultClick TfrmConsults procedure mnuViewSaveAsDefaultClick(Sender: TObject); Public/Published -
NewPersonNeedData TfrmConsults procedure NewPersonNeedData(Sender: TObject; const StartFrom: string; Direction, InsertAt: Integer); Public/Published Right panel (editor) events --------------------------------------------------------------
NotifyOrder TfrmConsults procedure NotifyOrder(OrderAction: Integer; AnOrder: TOrder); override; Public -
pnlFieldsResize TfrmConsults procedure pnlFieldsResize(Sender: TObject); Public/Published Center the reference date on the panel
pnlLeftExit TfrmConsults procedure pnlLeftExit(Sender: TObject); Public/Published -
pnlLeftResize TfrmConsults procedure pnlLeftResize(Sender: TObject); Public/Published -
pnlResultsResize TfrmConsults procedure pnlResultsResize(Sender: TObject); Public/Published -
pnlRightExit TfrmConsults procedure pnlRightExit(Sender: TObject); Public/Published Form events -----------------------------------------------------------------
pnlRightResize TfrmConsults procedure pnlRightResize(Sender: TObject); Public/Published TRichEdit doesn't repaint appropriately unless its parent panel is refreshed
popNoteListCollapseAllClick TfrmConsults procedure popNoteListCollapseAllClick(Sender: TObject); Public/Published -
popNoteListCollapseSelectedClick TfrmConsults procedure popNoteListCollapseSelectedClick(Sender: TObject); Public/Published -
popNoteListExpandAllClick TfrmConsults procedure popNoteListExpandAllClick(Sender: TObject); Public/Published -
popNoteListExpandSelectedClick TfrmConsults procedure popNoteListExpandSelectedClick(Sender: TObject); Public/Published -
popNoteListPopup TfrmConsults procedure popNoteListPopup(Sender: TObject); Public/Published -
popNoteMemoAddlSignClick TfrmConsults procedure popNoteMemoAddlSignClick(Sender: TObject); Public/Published -
popNoteMemoCopyClick TfrmConsults procedure popNoteMemoCopyClick(Sender: TObject); Public/Published -
popNoteMemoCutClick TfrmConsults procedure popNoteMemoCutClick(Sender: TObject); Public/Published -
popNoteMemoFindClick TfrmConsults procedure popNoteMemoFindClick(Sender: TObject); Public/Published -
popNoteMemoGrammarClick TfrmConsults procedure popNoteMemoGrammarClick(Sender: TObject); Public/Published -
popNoteMemoInsTemplateClick TfrmConsults procedure popNoteMemoInsTemplateClick(Sender: TObject); Public/Published -
popNoteMemoPasteClick TfrmConsults procedure popNoteMemoPasteClick(Sender: TObject); Public/Published -
popNoteMemoPopup TfrmConsults procedure popNoteMemoPopup(Sender: TObject); Public/Published -
popNoteMemoPreviewClick TfrmConsults procedure popNoteMemoPreviewClick(Sender: TObject); Public/Published -
popNoteMemoPrintClick TfrmConsults procedure popNoteMemoPrintClick(Sender: TObject); Public/Published -
popNoteMemoReformatClick TfrmConsults procedure popNoteMemoReformatClick(Sender: TObject); Public/Published -
popNoteMemoReplaceClick TfrmConsults procedure popNoteMemoReplaceClick(Sender: TObject); Public/Published -
popNoteMemoSaveContinueClick TfrmConsults procedure popNoteMemoSaveContinueClick(Sender: TObject); Public/Published -
popNoteMemoSpellClick TfrmConsults procedure popNoteMemoSpellClick(Sender: TObject); Public/Published -
popNoteMemoTemplateClick TfrmConsults procedure popNoteMemoTemplateClick(Sender: TObject); Public/Published -
popNoteMemoViewCsltClick TfrmConsults procedure popNoteMemoViewCsltClick(Sender: TObject); Public/Published
Wat cq 17586
wat cq 17586
ProcessMedResults TfrmConsults procedure ProcessMedResults(ActionType: string); Public/Published -
ProcessNotifications TfrmConsults procedure ProcessNotifications; Private -
RemovePCEFromChanges TfrmConsults procedure RemovePCEFromChanges(IEN: Integer; AVisitStr: string = ''); Private -
RequestMultiplePrint TfrmConsults procedure RequestMultiplePrint(AForm: TfrmPrintList); Public -
RequestPrint TfrmConsults procedure RequestPrint; override; Public -
SaveCurrentNote TfrmConsults procedure SaveCurrentNote(var Saved: Boolean); Private -
SaveEditedConsult TfrmConsults procedure SaveEditedConsult(var Saved: Boolean); Private
Validates fields and sends the updated consult result to the server 
 this block executes for Clinical Procedures documents ONLY!!
SaveOrAbort - procedure SaveOrAbort(var AllowSave: boolean); Local This block executes for Clinical Procedures documents ONLY!!
SaveSignItem TfrmConsults procedure SaveSignItem(const ItemID, ESCode: string); Public Saves and optionally signs a progress note or addendum
SetActionMenus TfrmConsults procedure SetActionMenus ; Private Set available menu actions based on consult status and user access to consult's service
SetEditingIndex TfrmConsults procedure SetEditingIndex(const Value: Integer); Private -
SetFontSize TfrmConsults procedure SetFontSize(NewFontSize: Integer); override; Public Adjusts the font size of any controls that don't have ParentFont = True
SetResultMenus TfrmConsults procedure SetResultMenus ; Private -
SetSubjectVisible TfrmConsults procedure SetSubjectVisible(ShouldShow: Boolean); Private Hide/show subject & resize panel accordingly - leave 6 pixel margin above memNewNote
SetViewContext TfrmConsults procedure SetViewContext(AContext: TSelectContext); Private -
ShowPCEControls TfrmConsults procedure ShowPCEControls(ShouldShow: Boolean); Private -
sptHorzCanResize TfrmConsults procedure sptHorzCanResize(Sender: TObject; var NewSize: Integer; var Accept: Boolean); Public/Published -
timAutoSaveTimer TfrmConsults procedure timAutoSaveTimer(Sender: TObject); Public/Published -
tvConsultsChange TfrmConsults procedure tvConsultsChange(Sender: TObject; Node: TTreeNode); Public/Published -
tvConsultsClick TfrmConsults procedure tvConsultsClick(Sender: TObject); Public/Published -
tvConsultsCollapsed TfrmConsults procedure tvConsultsCollapsed(Sender: TObject; Node: TTreeNode); Public/Published -
tvConsultsExit TfrmConsults procedure tvConsultsExit(Sender: TObject); Public/Published -
tvConsultsExpanded TfrmConsults procedure tvConsultsExpanded(Sender: TObject; Node: TTreeNode); Public/Published -
tvConsultsKeyUp TfrmConsults procedure tvConsultsKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); Public/Published -
tvCsltNotesChange TfrmConsults procedure tvCsltNotesChange(Sender: TObject; Node: TTreeNode); Public/Published -
tvCsltNotesClick TfrmConsults procedure tvCsltNotesClick(Sender: TObject); Public/Published -
tvCsltNotesCollapsed TfrmConsults procedure tvCsltNotesCollapsed(Sender: TObject; Node: TTreeNode); Public/Published -
tvCsltNotesDragDrop TfrmConsults procedure tvCsltNotesDragDrop(Sender, Source: TObject; X, Y: Integer); Public/Published -
tvCsltNotesDragOver TfrmConsults procedure tvCsltNotesDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); Public/Published -
tvCsltNotesExpanded TfrmConsults procedure tvCsltNotesExpanded(Sender: TObject; Node: TTreeNode); Public/Published -
tvCsltNotesStartDrag TfrmConsults procedure tvCsltNotesStartDrag(Sender: TObject; var DragObject: TDragObject); Public/Published -
UMNewOrder TfrmConsults procedure UMNewOrder(var Message: TMessage); message UM_NEWORDER; Private Update consults list if progress note completes consult
UnlockConsultRequest TfrmConsults procedure UnlockConsultRequest(ANote: Int64; AConsult: Integer = 0); Private
Var
  x: string;
UpdateConsultsTreeView TfrmConsults procedure UpdateConsultsTreeView(DocList: TStringList; Tree: TORTreeView); Private -
UpdateList TfrmConsults procedure UpdateList; Private -
UpdateNoteTreeView TfrmConsults procedure UpdateNoteTreeView(DocList: TStringList; Tree: TORTreeView; AContext: integer); Private -
ViewInfo TfrmConsults procedure ViewInfo(Sender: TObject); Public/Published -

Functions

Name Owner Declaration Scope Comments
ActiveEditOf TfrmConsults function ActiveEditOf(AnIEN: Int64): Boolean; Public -
AllowContextChange TfrmConsults function AllowContextChange(var WhyNot: string): Boolean; override; Public TPage common methods ---------------------------------------------------------------------
AuthorizedUser TfrmConsults function AuthorizedUser: Boolean; Public -
CanFinishReminder TfrmConsults function CanFinishReminder: boolean; Private -
CustomCanFocus TfrmConsults function CustomCanFocus(Control: TWinControl): Boolean; Public
CB
*****************************************************************
                  Delphi's Can Focus has a bug.
     Source: http://qc.embarcadero.com/wc/qcmain.aspx?d=11229
 *****************************************************************
GetDrawers TfrmConsults function GetDrawers: TfrmDrawers; Private -
GetTitleText TfrmConsults function GetTitleText(AnIndex: Integer): string; Private Returns non-tabbed text for the title of a note given the ItemIndex in lstNotes
LacksClinProcFields TfrmConsults function LacksClinProcFields(AnEditRec: TEditNoteRec; AMenuAccessRec: TMenuAccessRec; var ErrMsg: string): boolean; Private -
LacksClinProcFieldsForSignature TfrmConsults function LacksClinProcFieldsForSignature(NoteIEN: int64; var ErrMsg: string): boolean; Private -
LacksRequiredForCreate TfrmConsults function LacksRequiredForCreate: Boolean; Private Determines if the fields required to create the note are present
LinesVisible TfrmConsults function LinesVisible(richedit: Trichedit): integer; Public CB
LockConsultRequest TfrmConsults function LockConsultRequest(AConsult: Integer): Boolean; Private Returns true if consult successfully locked
LockConsultRequestAndNote TfrmConsults function LockConsultRequestAndNote(AnIEN: Int64): Boolean; Private Returns true if note and associated request successfully locked
SortByDate - function SortByDate(Node1, Node2: TTreeNode; Data: Longint): Integer; stdcall; Local -
SortByTitle - function SortByTitle(Node1, Node2: TTreeNode; Data: Longint): Integer; stdcall; Local -
StartNewEdit TfrmConsults function StartNewEdit(NewNoteType: integer): Boolean; Private If currently editing a note, returns TRUE if the user wants to start a new one
UserIsSigner TfrmConsults function UserIsSigner(NoteIEN: integer): boolean; Private -
VerifyNoteTitle TfrmConsults function VerifyNoteTitle: Boolean; Private
Function TfrmConsults.MakeTitleText(IsAddendum: Boolean = False): string;
{returns display text for list box based on FEditNote }
begin
  Result := FormatFMDateTime('mmm dd,yy', FEditNote.DateTime) + U;
  if IsAddendum and (CompareText(Copy(FEditNote.TitleName, 1, 8), 'Addendum') <> 0)
    then Result := Result + 'Addendum to ';
  Result := Result + FEditNote.TitleName + ', ' + FEditNote.LocationName + ', ' +
            FEditNote.AuthorName;
end;

Global Variables

Name Type Declaration Comments
CurrNotifIEN Integer ViewContext, CurrNotifIEN: integer ; -
DateRange DateRange: TConsultDateRange; -
frmConsults TfrmConsults frmConsults: TfrmConsults; -
frmDrawers TfrmDrawers frmDrawers: TfrmDrawers; -
MedResult MedResult: TMedResultRec; -
MenuAccessRec MenuAccessRec: TMenuAccessRec; -
StsCtxt StsCtxt: TStatusContext ; -
SvcCtxt SvcCtxt: TServiceContext; -
uChanging Boolean uChanging: Boolean; -
uIDNotesActive Boolean uIDNotesActive: boolean; -
uPCEEdit TPCEData uPCEShow, uPCEEdit: TPCEData; -
uPCEShow TPCEData uPCEShow, uPCEEdit: TPCEData; -
uSelectContext uSelectContext: TSelectContext ; -
ViewContext Integer ViewContext, CurrNotifIEN: integer ; -

Constants

Name Declaration Scope Comments
ActionType array[1..11] of string = ('Receive Consult','Cancel (Deny) Consult', Interfaced -
CA_CREATE 0 Global Create new consult result
CA_EDIT 3 Global Save current note, then edit an existing note
CA_SAVECREATE 2 Global Save current then create
CA_SAVEEDIT 4 Global -
CA_SHOW 1 Global Show current note
CN_ACT_ADD_CMT 5 Interfaced -
CN_ACT_ADDENDUM 7 Interfaced -
CN_ACT_ADMIN_COMPLETE 9 Interfaced -
CN_ACT_COMPLETE 6 Interfaced -
CN_ACT_CP_COMPLETE 11 Interfaced -
CN_ACT_DENY 2 Interfaced -
CN_ACT_DISCONTINUE 3 Interfaced -
CN_ACT_FORWARD 4 Interfaced -
CN_ACT_RECEIVE 1 Interfaced -
CN_ACT_SCHEDULE 10 Interfaced -
CN_ACT_SIGFIND 8 Interfaced -
CN_ADDENDUM -40 Global Holder IEN for a new addendum
CN_NEW_RESULT -30 Global Holder IEN for a new Consult Result
CT_ORDERS 4 Global ID for orders tab used by frmFrame
DLG_CONSULT 'C' Global -
DLG_PROC 'P' Global -
EF_DIAGNOSES 20 Global -
EF_ORDERS 100 Global -
EF_PROCEDURES 30 Global -
EF_VISIT_TYPE 10 Global -
EF_VITALS 200 Global -
NT_ACT_ADDENDUM 3 Global -
NT_ACT_EDIT_NOTE 4 Global -
NT_ACT_ID_ENTRY 5 Global -
NT_ACT_NEW_NOTE 2 Global -
ST_ACTIVE 6 Global -
ST_CANCELLED 13 Global -
ST_CHANGED 12 Global -
ST_COMPLETE 2 Global -
ST_DELAYED 10 Global -
ST_DISCONTINUED 1 Global -
ST_EXPIRED 7 Global -
ST_FLAGGED 4 Global -
ST_HOLD 3 Global -
ST_LAPSED 14 Global -
ST_NO_STATUS 99 Global -
ST_PARTIAL_RESULTS 9 Global -
ST_PENDING 5 Global -
ST_RENEWED 15 Global -
ST_SCHEDULED 8 Global -
ST_UNRELEASED 11 Global -
TC_ABSAVE 'Possible Missing Text' Global -
TC_BADKEYS 'Multiple Keys' Global -
TC_BLR_CLEAR 'Clear Previous Boilerplate Text' Global -
TC_CLIN_PROC 'Missing Information for Clinical Procedures Document' Global -
TC_CP_NO_RESULTS 'No Results Available' Global -
TC_EMPTY_NOTE 'Empty Note' Global -
TC_NEW_SAVE2 'Create New Note' Global -
TC_NEW_SAVE3 'Create New Addendum' Global -
TC_NEW_SAVE4 'Edit Different Note' Global -
TC_NEW_SAVE5 'Create New Interdisciplinary Entry' Global -
TC_NO_BOIL 'Load Boilerplate Text' Global -
TC_NO_LOCK 'Unable to Lock Note' Global -
TC_NO_ORD_CHG 'Locked Consult Request' Global -
TC_NO_RESUBMIT 'Unable to resubmit' Global -
TC_NOKEY 'Insufficient Authority' Global -
TC_ORDER_LOCKED 'Unable to access record' Global -
TC_PROV_KEY 'PROVIDER Key Required' Global -
TC_PROV_LOC 'Incomplete Information' Global -
TX_ABSAVE 'It appears the session terminated abnormally when this' + CRLF + Global -
TX_ADDEND_NO 'Cannot make an addendum to a note that is being edited' Global -
TX_AUTH_SIGNED 'Author has not signed, are you SURE you want to sign.' +CRLF Global -
TX_BADKEYS 'You have mutually exclusive order entry keys (ORES, ORELSE, or OREMAS).' + Global -
TX_BLR_CLEAR 'Do you want to clear the previously loaded boilerplate text?' Global -
TX_BOILERPLT 'You have modified the text of this note. Changing the title will' + Global -
TX_CLIN_PROC 'A procedure summary code and valid date/time for the procedure must be entered.' Global -
TX_COSIGN 'Cosign Note' Global -
TX_CP_NO_RESULTS 'This Clinical Procedure cannot be completed yet.' + CRLF + Global -
TX_CREATE_ERR 'Error Creating Note' Global -
TX_DEL_ERR 'Unable to Delete note' Global -
TX_DEL_OK CRLF + CRLF + 'Delete this note?' Global -
TX_DETACH_CNF 'Confirm Detachment' Global -
TX_DETACH_FAILURE 'Detach failed' Global -
TX_EMPTY_NOTE CRLF + CRLF + 'This note contains no text and will not be saved.' + CRLF + Global -
TX_EMPTY_NOTE1 'This note contains no text and can not be signed.' Global -
TX_INVALID_CONSULT_CAP 'Invalid consult record' Global -
TX_INVALID_CONSULT_TEXT 'Unable to retrieve the information for this consult.' Global -
TX_NEED_VISIT 'A visit is required before creating a new consult result.' Global -
TX_NEW_SAVE1 'You are currently editing:' + CRLF + CRLF Global -
TX_NEW_SAVE2 CRLF + CRLF + 'Do you wish to save this note and begin a new one?' Global -
TX_NEW_SAVE3 CRLF + CRLF + 'Do you wish to save this note and begin a new addendum?' Global -
TX_NEW_SAVE4 CRLF + CRLF + 'Do you wish to save this note and edit the one selected?' Global -
TX_NEW_SAVE5 CRLF + CRLF + 'Do you wish to save this note and begin a new Interdisciplinary entry?' Global -
TX_NEWTITLE 'Change Consult Title' Global -
TX_NO_AUTHOR 'An author must be entered for the note.' Global -
TX_NO_BOIL 'There is no boilerplate text associated with this title.' Global -
TX_NO_CONSULT 'No note is currently being edited' Global -
TX_NO_FUTURE_DT 'A Reference Date/Time in the future is not allowed.' Global -
TX_NO_ORD_CHG 'The note is still associated with the previously selected request.' + CRLF + Global -
TX_NO_ORDER 'Ordering has been disabled.' Global -
TX_NO_ORDER_CAP 'Unable to place order' Global -
TX_NO_VISIT 'Insufficient Visit Information' Global -
TX_NOCONSULT 'No consult is currently selected.' Global -
TX_NOCSLT_CAP 'No Consult Selected' Global -
TX_NOKEY 'You do not have the keys required to take this action.' Global -
TX_NONOTE 'No note is currently selected.' Global -
TX_NONOTE_CAP 'No Note Selected' Global -
TX_NOPRT_NEW 'This consult may not be printed until the current note is saved' Global -
TX_NOPRT_NEW_CAP 'Save Consult Result' Global -
TX_ORDER_LOCKED 'This record is locked by an action underway on the Notes tab' Global -
TX_PROV_KEY 'The provider selected for this encounter must' + CRLF + Global -
TX_PROV_LOC 'A provider and location must be selected before entering orders.' Global -
TX_REQ_COSIGNER 'A cosigner must be identified.' Global -
TX_REQ2 CRLF + CRLF + Global -
TX_REQD_ADDM 'The following information is required to save an addendum - ' + CRLF Global -
TX_REQD_CONSULT 'The following information is required to save a Consult Result - ' + CRLF Global -
TX_REQD_COSIG CRLF + 'Expected Cosigner' Global -
TX_RETRACT 'This document will now be RETRACTED. As Such, it has been removed' +CRLF + Global -
TX_RETRACT_CAP 'Retraction Notice' Global -
TX_SAVE_CONSULT 'Save Note' Global -
TX_SCREQD 'This progress note title requires the service connected questions to be '+ Global -
TX_SCREQD_T 'Response required for SC questions.' Global -
TX_SIGN 'Sign Note' Global -
TX_SIGN_ERR 'Unable to Sign Note' Global -
TX_UPDATE_ERR 'Error Updating Note' Global -
TYP_ADDENDUM 81 Global -
TYP_PROGRESS_NOTE 3 Global -


Module Source

1     unit fConsults;
2     {Notes of Intent:
3       Tab Order:
4         The tab order has been custom coded to place the pnlRight in the Tab order
5         right after the tvConsults.  
6     }
7     
8     interface
9     
10    uses
11      Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ORDtTm,
12      fHSplit, stdCtrls, ExtCtrls, Menus, ComCtrls, ORCtrls, ORFn, uConsults, rOrders, uPCE,
13      ORClasses, uConst, fDrawers, rTIU, uTIU, uDocTree, RichEdit, fPrintList,
14      VA508AccessibilityManager, fBase508Form, VA508ImageListLabeler;
15    
16    type
17      TfrmConsults = class(TfrmHSplit)
18        mnuConsults: TMainMenu;
19        mnuView: TMenuItem;
20        mnuViewChart: TMenuItem;
21        mnuChartReports: TMenuItem;
22        mnuChartLabs: TMenuItem;
23        mnuChartDCSumm: TMenuItem;
24        mnuChartCslts: TMenuItem;
25        mnuChartNotes: TMenuItem;
26        mnuChartOrders: TMenuItem;
27        mnuChartMeds: TMenuItem;
28        mnuChartProbs: TMenuItem;
29        mnuChartCover: TMenuItem;
30        mnuAct: TMenuItem;
31        Z2: TMenuItem;
32        pnlRead: TPanel;
33        lblTitle: TOROffsetLabel;
34        memConsult: TRichEdit;
35        pnlAction: TPanel;
36        cmdNewConsult: TORAlignButton;
37        Z3: TMenuItem;
38        mnuViewAll: TMenuItem;
39        mnuViewByService: TMenuItem;
40        mnuViewByDate: TMenuItem;
41        mnuViewByStatus: TMenuItem;
42        cmdNewProc: TORAlignButton;
43        N1: TMenuItem;
44        mnuActConsultRequest: TMenuItem;
45        mnuActReceive: TMenuItem;
46        mnuActDeny: TMenuItem;
47        mnuActForward: TMenuItem;
48        mnuActDiscontinue: TMenuItem;
49        mnuActAddComment: TMenuItem;
50        mnuActComplete: TMenuItem;
51        mnuActNew: TMenuItem;
52        mnuActNewConsultRequest: TMenuItem;
53        mnuActNewProcedure: TMenuItem;
54        mnuActSignatureList: TMenuItem;
55        mnuActSignatureSave: TMenuItem;
56        mnuActSignatureSign: TMenuItem;
57        mnuActMakeAddendum: TMenuItem;
58        mnuViewCustom: TMenuItem;
59        pnlResults: TPanel;
60        memResults: TRichEdit;
61        mnuActNoteEdit: TMenuItem;
62        mnuActNoteDelete: TMenuItem;
63        sptVert: TSplitter;
64        memPCEShow: TRichEdit;
65        cmdEditResubmit: TORAlignButton;
66        cmdPCE: TORAlignButton;
67        mnuActConsultResults: TMenuItem;
68        N2: TMenuItem;
69        lstNotes: TORListBox;
70        popNoteMemo: TPopupMenu;
71        popNoteMemoCut: TMenuItem;
72        popNoteMemoCopy: TMenuItem;
73        popNoteMemoPaste: TMenuItem;
74        Z10: TMenuItem;
75        popNoteMemoSignList: TMenuItem;
76        popNoteMemoDelete: TMenuItem;
77        popNoteMemoEdit: TMenuItem;
78        popNoteMemoSave: TMenuItem;
79        popNoteMemoSign: TMenuItem;
80        popConsultList: TPopupMenu;
81        popConsultAll: TMenuItem;
82        popConsultStatus: TMenuItem;
83        popConsultService: TMenuItem;
84        popConsultDates: TMenuItem;
85        popConsultCustom: TMenuItem;
86        mnuActPrintSF513: TMenuItem;
87        N3: TMenuItem;
88        mnuActDisplayDetails: TMenuItem;
89        mnuActDisplayResults: TMenuItem;
90        mnuActDisplaySF513: TMenuItem;
91        mnuActSigFindings: TMenuItem;
92        mnuActAdminComplete: TMenuItem;
93        mnuActIdentifyAddlSigners: TMenuItem;
94        popNoteMemoAddlSign: TMenuItem;
95        Z11: TMenuItem;
96        popNoteMemoSpell: TMenuItem;
97        popNoteMemoGrammar: TMenuItem;
98        mnuActEditResubmit: TMenuItem;
99        N4: TMenuItem;
100       mnuViewSaveAsDefault: TMenuItem;
101       mnuViewReturntoDefault: TMenuItem;
102       splDrawers: TSplitter;
103       N5: TMenuItem;
104       popNoteMemoTemplate: TMenuItem;
105       mnuOptions: TMenuItem;
106       mnuEditTemplates: TMenuItem;
107       mnuNewTemplate: TMenuItem;
108       splConsults: TSplitter;
109       pnlConsultList: TPanel;
110       lblConsults: TOROffsetLabel;
111       lstConsults: TORListBox;
112       N6: TMenuItem;
113       mnuEditSharedTemplates: TMenuItem;
114       mnuNewSharedTemplate: TMenuItem;
115       popNoteMemoPrint: TMenuItem;
116       N7: TMenuItem;
117       N8: TMenuItem;
118       mnuActNotePrint: TMenuItem;
119       timAutoSave: TTimer;
120       pnlFields: TPanel;
121       lblNewTitle: TStaticText;
122       lblRefDate: TStaticText;
123       lblAuthor: TStaticText;
124       lblVisit: TStaticText;
125       lblCosigner: TStaticText;
126       lblSubject: TStaticText;
127       cmdChange: TButton;
128       txtSubject: TCaptionEdit;
129       mnuActSchedule: TMenuItem;
130       popNoteMemoPaste2: TMenuItem;
131       popNoteMemoReformat: TMenuItem;
132       N9: TMenuItem;
133       mnuActChange: TMenuItem;
134       mnuActLoadBoiler: TMenuItem;
135       bvlNewTitle: TBevel;
136       popNoteMemoSaveContinue: TMenuItem;
137       mnuActAttachMed: TMenuItem;
138       mnuActRemoveMed: TMenuItem;
139       N10: TMenuItem;
140       mnuEditDialgFields: TMenuItem;
141       tvCsltNotes: TORTreeView;
142       popNoteList: TPopupMenu;
143       popNoteListExpandSelected: TMenuItem;
144       popNoteListExpandAll: TMenuItem;
145       popNoteListCollapseSelected: TMenuItem;
146       popNoteListCollapseAll: TMenuItem;
147       N11: TMenuItem;
148       popNoteListDetachFromIDParent: TMenuItem;
149       N12: TMenuItem;
150       mnuActDetachFromIDParent: TMenuItem;
151       mnuActAddIDEntry: TMenuItem;
152       tvConsults: TORTreeView;
153       popNoteListAddIDEntry: TMenuItem;
154       N13: TMenuItem;
155       mnuIconLegend: TMenuItem;
156       dlgFindText: TFindDialog;
157       popNoteMemoFind: TMenuItem;
158       dlgReplaceText: TReplaceDialog;
159       N14: TMenuItem;
160       popNoteMemoReplace: TMenuItem;
161       mnuChartSurgery: TMenuItem;
162       mnuActAttachtoIDParent: TMenuItem;
163       popNoteListAttachtoIDParent: TMenuItem;
164       popNoteMemoAddend: TMenuItem;
165       N15: TMenuItem;
166       popNoteMemoPreview: TMenuItem;
167       popNoteMemoInsTemplate: TMenuItem;
168       popNoteMemoEncounter: TMenuItem;
169       mnuViewInformation: TMenuItem;
170       mnuViewDemo: TMenuItem;
171       mnuViewVisits: TMenuItem;
172       mnuViewPrimaryCare: TMenuItem;
173       mnuViewMyHealtheVet: TMenuItem;
174       mnuInsurance: TMenuItem;
175       mnuViewFlags: TMenuItem;
176       mnuViewReminders: TMenuItem;
177       mnuViewRemoteData: TMenuItem;
178       mnuViewPostings: TMenuItem;
179       imgLblNotes: TVA508ImageListLabeler;
180       imgLblImages: TVA508ImageListLabeler;
181       imgLblConsults: TVA508ImageListLabeler;
182       popNoteMemoViewCslt: TMenuItem;   //wat cq 17586
183       procedure mnuChartTabClick(Sender: TObject);
184       procedure lstConsultsClick(Sender: TObject);
185       procedure pnlRightResize(Sender: TObject);
186       procedure cmdNewConsultClick(Sender: TObject);
187       procedure memResultChange(Sender: TObject);
188       procedure mnuActCompleteClick(Sender: TObject);
189       procedure mnuActAddIDEntryClick(Sender: TObject);
190       procedure mnuActSignatureSaveClick(Sender: TObject);
191       procedure mnuViewClick(Sender: TObject);
192       procedure mnuActSignatureListClick(Sender: TObject);
193       procedure mnuActSignatureSignClick(Sender: TObject);
194       procedure mnuActMakeAddendumClick(Sender: TObject);
195       procedure mnuActDetachFromIDParentClick(Sender: TObject);
196       procedure mnuActAttachtoIDParentClick(Sender: TObject);
197       procedure cmdPCEClick(Sender: TObject);
198       procedure mnuActConsultClick(Sender: TObject);
199       procedure mnuActNewConsultRequestClick(Sender: TObject);
200       procedure mnuActNoteEditClick(Sender: TObject);
201       procedure mnuActNoteDeleteClick(Sender: TObject);
202       procedure lstNotesClick(Sender: TObject);
203       procedure popNoteMemoCutClick(Sender: TObject);
204       procedure popNoteMemoCopyClick(Sender: TObject);
205       procedure popNoteMemoPasteClick(Sender: TObject);
206       procedure popNoteMemoPopup(Sender: TObject);
207       procedure NewPersonNeedData(Sender: TObject; const StartFrom: string;
208          Direction, InsertAt: Integer);
209       procedure cmdNewProcClick(Sender: TObject);
210       procedure mnuActNewProcedureClick(Sender: TObject);
211       procedure mnuActDisplayResultsClick(Sender: TObject);
212       procedure mnuActDisplaySF513Click(Sender: TObject);
213       procedure pnlResultsResize(Sender: TObject);
214       procedure mnuActPrintSF513Click(Sender: TObject);
215       procedure FormCreate(Sender: TObject);
216       procedure mnuActDisplayDetailsClick(Sender: TObject);
217       procedure FormClose(Sender: TObject; var Action: TCloseAction);
218       procedure mnuActIdentifyAddlSignersClick(Sender: TObject);
219       procedure popNoteMemoAddlSignClick(Sender: TObject);
220       procedure mnuActEditResubmitClick(Sender: TObject);
221       procedure EnableDisableOrdering;
222       procedure cmdEditResubmitClick(Sender: TObject);
223       procedure popNoteMemoSpellClick(Sender: TObject);
224       procedure popNoteMemoGrammarClick(Sender: TObject);
225       procedure mnuViewSaveAsDefaultClick(Sender: TObject);
226       procedure mnuViewReturntoDefaultClick(Sender: TObject);
227       procedure popNoteMemoTemplateClick(Sender: TObject);
228       procedure mnuEditTemplatesClick(Sender: TObject);
229       procedure mnuNewTemplateClick(Sender: TObject);
230       procedure pnlLeftResize(Sender: TObject);
231       procedure mnuOptionsClick(Sender: TObject);
232       procedure mnuEditSharedTemplatesClick(Sender: TObject);
233       procedure mnuNewSharedTemplateClick(Sender: TObject);
234       procedure popNoteMemoPrintClick(Sender: TObject);
235       procedure mnuActNotePrintClick(Sender: TObject);
236       procedure FormDestroy(Sender: TObject);
237       procedure timAutoSaveTimer(Sender: TObject);
238       procedure cmdChangeClick(Sender: TObject);
239       procedure pnlFieldsResize(Sender: TObject);
240       procedure popNoteMemoReformatClick(Sender: TObject);
241       procedure mnuActChangeClick(Sender: TObject);
242       procedure mnuActLoadBoilerClick(Sender: TObject);
243       procedure popNoteMemoSaveContinueClick(Sender: TObject);
244       procedure ProcessMedResults(ActionType: string);
245       procedure mnuActAttachMedClick(Sender: TObject);
246       procedure mnuActRemoveMedClick(Sender: TObject);
247       procedure mnuEditDialgFieldsClick(Sender: TObject);
248       procedure tvCsltNotesChange(Sender: TObject; Node: TTreeNode);
249       procedure tvCsltNotesCollapsed(Sender: TObject; Node: TTreeNode);
250       procedure tvCsltNotesExpanded(Sender: TObject; Node: TTreeNode);
251       procedure tvCsltNotesStartDrag(Sender: TObject;
252         var DragObject: TDragObject);
253       procedure tvCsltNotesDragDrop(Sender, Source: TObject; X, Y: Integer);
254       procedure tvCsltNotesDragOver(Sender, Source: TObject; X, Y: Integer;
255         State: TDragState; var Accept: Boolean);
256       procedure popNoteListExpandSelectedClick(Sender: TObject);
257       procedure popNoteListExpandAllClick(Sender: TObject);
258       procedure popNoteListCollapseSelectedClick(Sender: TObject);
259       procedure popNoteListCollapseAllClick(Sender: TObject);
260       procedure tvCsltNotesClick(Sender: TObject);
261       procedure tvConsultsExpanded(Sender: TObject; Node: TTreeNode);
262       procedure tvConsultsCollapsed(Sender: TObject; Node: TTreeNode);
263       procedure tvConsultsClick(Sender: TObject);
264       procedure tvConsultsChange(Sender: TObject; Node: TTreeNode);
265       procedure popNoteListPopup(Sender: TObject);
266       procedure mnuIconLegendClick(Sender: TObject);
267       procedure popNoteMemoFindClick(Sender: TObject);
268       procedure dlgFindTextFind(Sender: TObject);
269       procedure dlgReplaceTextFind(Sender: TObject);
270       procedure dlgReplaceTextReplace(Sender: TObject);
271       procedure popNoteMemoReplaceClick(Sender: TObject);
272       procedure tvConsultsKeyUp(Sender: TObject; var Key: Word;
273         Shift: TShiftState);
274       procedure memResultsKeyDown(Sender: TObject; var Key: Word;
275         Shift: TShiftState);
276       procedure sptHorzCanResize(Sender: TObject; var NewSize: Integer; var Accept: Boolean);
277       procedure popNoteMemoPreviewClick(Sender: TObject);
278       procedure popNoteMemoInsTemplateClick(Sender: TObject);
279       procedure tvConsultsExit(Sender: TObject);
280       procedure FormHide(Sender: TObject);
281       procedure FormShow(Sender: TObject);
282       procedure ViewInfo(Sender: TObject);
283       procedure mnuViewInformationClick(Sender: TObject);
284       procedure pnlLeftExit(Sender: TObject);
285       procedure pnlRightExit(Sender: TObject);
286       procedure cmdEditResubmitExit(Sender: TObject);
287       procedure cmdNewConsultExit(Sender: TObject);
288       procedure popNoteMemoViewCsltClick(Sender: TObject);   //wat cq 17586
289     private
290       FocusToRightPanel : Boolean;
291       FEditingIndex: Integer;      // TIU index of document being currently edited
292       FChanged: Boolean;
293       FActionType: integer ;
294       FEditCtrl: TCustomEdit;
295       FSilent: Boolean;
296       FCurrentContext: TSelectContext;
297       FDefaultContext: TSelectContext;
298       FCurrentNoteContext: TTIUContext;
299       FOrderID: string;
300       FImageFlag: TBitmap;
301       FEditNote: TEditNoteRec;
302       FVerifyNoteTitle: Integer;
303       FDocList: TStringList;
304       FConfirmed: boolean;
305       FCsltList: TStringList;
306       FDeleted: boolean;
307       FLastNoteID: string;
308       FcmdChangeOKPressed: boolean;
309       FNotifPending: boolean;
310       FOldFramePnlPatientExit: TNotifyEvent;
311       //FMousing: TDateTime;
312       procedure DoLeftPanelCustomShiftTab;
313       procedure frmFramePnlPatientExit(Sender: TObject);
314       procedure DoAutoSave(Suppress: integer = 1);
315       function GetTitleText(AnIndex: Integer): string;
316       //function MakeTitleText(IsAddendum: Boolean = False): string;
317       procedure ClearEditControls;
318       procedure LoadForEdit ;
319       function LacksRequiredForCreate: Boolean;
320       function LacksClinProcFields(AnEditRec: TEditNoteRec; AMenuAccessRec: TMenuAccessRec; var ErrMsg: string): boolean;
321       function LacksClinProcFieldsForSignature(NoteIEN: int64; var ErrMsg: string): boolean;
322       procedure UpdateList;
323       procedure DisplayPCE;
324       procedure CompleteConsult(IsIDChild: boolean; AnIDParent: integer; UseClinProcTitles: boolean);
325       procedure InsertAddendum;
326       procedure SetSubjectVisible(ShouldShow: Boolean);
327       procedure SaveCurrentNote(var Saved: Boolean);
328       procedure SaveEditedConsult(var Saved: Boolean);
329       procedure SetEditingIndex(const Value: Integer);
330       procedure ShowPCEControls(ShouldShow: Boolean);
331       procedure SetActionMenus ;
332       procedure SetResultMenus ;
333       procedure RemovePCEFromChanges(IEN: Integer; AVisitStr: string = '');
334       procedure ProcessNotifications;
335       procedure UMNewOrder(var Message: TMessage);   message UM_NEWORDER;
336       procedure SetViewContext(AContext: TSelectContext);
337       function GetDrawers: TfrmDrawers;
338       function LockConsultRequest(AConsult: Integer): Boolean;
339       function LockConsultRequestAndNote(AnIEN: Int64): Boolean;
340       function StartNewEdit(NewNoteType: integer): Boolean;
341       procedure UnlockConsultRequest(ANote: Int64; AConsult: Integer = 0);
342       function CanFinishReminder: boolean;
343       property EditingIndex: Integer read FEditingIndex write SetEditingIndex;
344       function VerifyNoteTitle: Boolean;
345       procedure UpdateNoteTreeView(DocList: TStringList; Tree: TORTreeView; AContext: integer);
346       procedure EnableDisableIDNotes;
347       procedure LoadConsults;
348       procedure UpdateConsultsTreeView(DocList: TStringList; Tree: TORTreeView);
349       procedure DoAttachIDChild(AChild, AParent: TORTreeNode);
350       function UserIsSigner(NoteIEN: integer): boolean;
351     public
352       function CustomCanFocus(Control: TWinControl): Boolean; //CB
353       function LinesVisible(richedit: Trichedit): integer; //CB
354       function ActiveEditOf(AnIEN: Int64): Boolean;
355       function  AllowContextChange(var WhyNot: string): Boolean; override;
356       procedure ClearPtData; override;
357       procedure DisplayPage; override;
358       procedure SetFontSize(NewFontSize: Integer); override;
359       procedure SaveSignItem(const ItemID, ESCode: string);
360       procedure RequestPrint; override;
361       procedure RequestMultiplePrint(AForm: TfrmPrintList);
362       procedure NotifyOrder(OrderAction: Integer; AnOrder: TOrder); override;
363       function AuthorizedUser: Boolean;
364       procedure AssignRemForm;
365       property OrderID: string read FOrderID;
366       procedure LstConsultsToPrint;
367     published
368       property Drawers: TfrmDrawers read GetDrawers; // Keep Drawers published
369     end;
370   
371   
372   var
373     frmConsults: TfrmConsults;
374   
375   const
376     CN_ACT_RECEIVE     =   1 ;
377     CN_ACT_DENY        =   2 ;
378     CN_ACT_DISCONTINUE =   3 ;
379     CN_ACT_FORWARD     =   4 ;
380     CN_ACT_ADD_CMT     =   5 ;
381     CN_ACT_COMPLETE    =   6 ;
382     CN_ACT_ADDENDUM    =   7 ;
383     CN_ACT_SIGFIND     =   8 ;
384     CN_ACT_ADMIN_COMPLETE = 9 ;
385     CN_ACT_SCHEDULE       = 10;
386     CN_ACT_CP_COMPLETE    = 11;
387   
388     ActionType: array[1..11] of string = ('Receive Consult','Cancel (Deny) Consult',
389                   'Discontinue Consult','Forward Consult','Add Comment to Consult',
390                   'Complete Consult', 'Make Addendum to Consult', 'Update Significant Findings',
391                   'Administratively Complete', 'Schedule Consult', 'Complete Clinical Procedure') ;
392   
393   implementation
394   
395   {$R *.DFM}
396   
397   uses fVisit, rCore, uCore, rConsults, fConsultBS, fConsultBD, fSignItem,
398        fConsultBSt, fConsultsView, fConsultAct, fEncnt, rPCE, fEncounterFrame,
399        Clipbrd, rReports, fRptBox, fConsult513Prt, fODConsult, fODProc, fCsltNote, fAddlSigners,
400        fOrders, rVitals, fFrame, fNoteDR, fEditProc, fEditConsult, uOrders, rODBase, uSpell, {*KCM*}
401        fTemplateEditor, fNotePrt, fNotes, fNoteProps, fNotesBP, fReminderTree,
402        fReminderDialog, uReminders, fConsMedRslt, fTemplateFieldEditor,
403        dShared, rTemplates, fIconLegend, fNoteIDParents, fNoteCPFields,
404        uTemplates, fTemplateDialog, DateUtils, uVA508CPRSCompatibility, VA508AccessibilityRouter;
405   
406   const
407     CT_ORDERS =   4;                               // ID for orders tab used by frmFrame
408     EF_VISIT_TYPE = 10;
409     EF_VITALS     = 200;
410     EF_DIAGNOSES  = 20;
411     EF_PROCEDURES = 30;
412     EF_ORDERS     = 100;
413   
414     CA_CREATE     = 0;                             // create new consult result
415     CA_SHOW       = 1;                             // show current note
416     CA_SAVECREATE = 2;                             // save current then create
417     CA_EDIT       = 3;                             // save current note, then edit an existing note
418     CA_SAVEEDIT   = 4;
419   
420     CN_NEW_RESULT = -30;                           // Holder IEN for a new Consult Result
421     CN_ADDENDUM   = -40;                           // Holder IEN for a new addendum
422   
423     NT_ACT_NEW_NOTE  = 2;
424     NT_ACT_ADDENDUM  = 3;
425     NT_ACT_EDIT_NOTE = 4;
426     NT_ACT_ID_ENTRY  = 5;
427   
428     ST_DISCONTINUED    = 1  ;
429     ST_COMPLETE        = 2  ;
430     ST_HOLD            = 3  ;
431     ST_FLAGGED         = 4  ;
432     ST_PENDING         = 5  ;
433     ST_ACTIVE          = 6  ;
434     ST_EXPIRED         = 7  ;
435     ST_SCHEDULED       = 8  ;
436     ST_PARTIAL_RESULTS = 9  ;
437     ST_DELAYED         = 10 ;
438     ST_UNRELEASED      = 11 ;
439     ST_CHANGED         = 12 ;
440     ST_CANCELLED       = 13 ;
441     ST_LAPSED          = 14 ;
442     ST_RENEWED         = 15 ;
443     ST_NO_STATUS       = 99 ;
444   
445     TYP_PROGRESS_NOTE = 3;
446     TYP_ADDENDUM      = 81;
447     TX_PROV_LOC   = 'A provider and location must be selected before entering orders.';
448     TC_PROV_LOC   = 'Incomplete Information';
449   
450     TX_NEED_VISIT = 'A visit is required before creating a new consult result.';
451     TX_NO_VISIT   = 'Insufficient Visit Information';
452     TX_BOILERPLT  = 'You have modified the text of this note.  Changing the title will' +
453                     ' discard the note text.' + CRLF + 'Do you wish to continue?';
454     TX_NEWTITLE   = 'Change Consult Title';
455     TX_REQD_CONSULT  = 'The following information is required to save a Consult Result - ' + CRLF;
456     TX_REQD_ADDM  = 'The following information is required to save an addendum - ' + CRLF;
457     TX_REQ2       = CRLF + CRLF +
458                     'It is recommended that these fields be entered before continuing' + CRLF +
459                     'to prevent losing the note should the application time out.';
460     TX_CREATE_ERR = 'Error Creating Note';
461     TX_UPDATE_ERR = 'Error Updating Note';
462     TX_NO_CONSULT    = 'No note is currently being edited';
463     TX_SAVE_CONSULT  = 'Save Note';
464     TX_ADDEND_NO  = 'Cannot make an addendum to a note that is being edited';
465     TX_DEL_OK     = CRLF + CRLF + 'Delete this note?';
466     TX_DEL_ERR    = 'Unable to Delete note';
467     TX_SIGN       = 'Sign Note';
468     TX_COSIGN     = 'Cosign Note';
469     TX_REQD_COSIG = CRLF + 'Expected Cosigner';
470     TX_REQ_COSIGNER = 'A cosigner must be identified.';
471     TX_SIGN_ERR   = 'Unable to Sign Note';
472     TX_INVALID_CONSULT_CAP = 'Invalid consult record' ;
473     TX_INVALID_CONSULT_TEXT = 'Unable to retrieve the information for this consult.' ;
474     TX_SCREQD     = 'This progress note title requires the service connected questions to be '+
475                     'answered.  The Encounter form will now be opened.  Please answer all '+
476                     'service connected questions.';
477     TX_SCREQD_T   = 'Response required for SC questions.';
478     TX_NOPRT_NEW  = 'This consult may not be printed until the current note is saved';
479     TX_NOPRT_NEW_CAP = 'Save Consult Result';
480     TX_NOCONSULT     = 'No consult is currently selected.';
481     TX_NOCSLT_CAP = 'No Consult Selected';
482     TX_NONOTE     = 'No note is currently selected.';
483     TX_NONOTE_CAP = 'No Note Selected';
484     TX_NO_ORDER   = 'Ordering has been disabled.';
485     TX_NO_ORDER_CAP = 'Unable to place order';
486     TX_PROV_KEY   = 'The provider selected for this encounter must' + CRLF +
487                     'hold the PROVIDER key to enter orders.';
488     TC_PROV_KEY   = 'PROVIDER Key Required';
489     TX_NOKEY   = 'You do not have the keys required to take this action.';
490     TC_NOKEY   = 'Insufficient Authority';
491     TX_BADKEYS = 'You have mutually exclusive order entry keys (ORES, ORELSE, or OREMAS).' +
492                  CRLF + 'This must be resolved before you can enter orders.';
493     TC_BADKEYS = 'Multiple Keys';
494     TX_NO_FUTURE_DT = 'A Reference Date/Time in the future is not allowed.';
495     TX_ORDER_LOCKED = 'This record is locked by an action underway on the Notes tab';
496     TC_ORDER_LOCKED = 'Unable to access record';
497     TC_NO_RESUBMIT  = 'Unable to resubmit';
498     TX_NO_ORD_CHG   = 'The note is still associated with the previously selected request.' + CRLF +
499                       'Finish the pending action, then try again.';
500     TC_NO_ORD_CHG   = 'Locked Consult Request';
501     TX_NEW_SAVE1    = 'You are currently editing:' + CRLF + CRLF;
502     TX_NEW_SAVE2    = CRLF + CRLF + 'Do you wish to save this note and begin a new one?';
503     TX_NEW_SAVE3    = CRLF + CRLF + 'Do you wish to save this note and begin a new addendum?';
504     TX_NEW_SAVE4    = CRLF + CRLF + 'Do you wish to save this note and edit the one selected?';
505     TX_NEW_SAVE5    = CRLF + CRLF + 'Do you wish to save this note and begin a new Interdisciplinary entry?';
506     TC_NEW_SAVE2    = 'Create New Note';
507     TC_NEW_SAVE3    = 'Create New Addendum';
508     TC_NEW_SAVE4    = 'Edit Different Note';
509     TC_NEW_SAVE5    = 'Create New Interdisciplinary Entry';
510     TX_EMPTY_NOTE   = CRLF + CRLF + 'This note contains no text and will not be saved.' + CRLF +
511                       'Do you wish to delete this note?';
512     TC_EMPTY_NOTE   = 'Empty Note';
513     TX_EMPTY_NOTE1   = 'This note contains no text and can not be signed.';
514     TC_NO_LOCK      = 'Unable to Lock Note';
515     TX_ABSAVE       = 'It appears the session terminated abnormally when this' + CRLF +
516                       'note was last edited. Some text may not have been saved.' + CRLF + CRLF +
517                       'Do you wish to continue and sign the note?';
518     TC_ABSAVE       = 'Possible Missing Text';
519     TX_NO_BOIL      = 'There is no boilerplate text associated with this title.';
520     TC_NO_BOIL      = 'Load Boilerplate Text';
521     TX_BLR_CLEAR    = 'Do you want to clear the previously loaded boilerplate text?';
522     TC_BLR_CLEAR    = 'Clear Previous Boilerplate Text';
523     TX_CP_NO_RESULTS = 'This Clinical Procedure cannot be completed yet.' + CRLF +
524                        'No results are available for interpretation.';
525     TC_CP_NO_RESULTS = 'No Results Available';
526     TX_CLIN_PROC     = 'A procedure summary code and valid date/time for the procedure must be entered.';
527     TX_NO_AUTHOR     = 'An author must be entered for the note.';
528     TC_CLIN_PROC     = 'Missing Information for Clinical Procedures Document';
529     TX_DETACH_CNF     = 'Confirm Detachment';
530     TX_DETACH_FAILURE = 'Detach failed';
531   
532     DLG_CONSULT = 'C';
533     DLG_PROC    = 'P';
534     TX_RETRACT_CAP    = 'Retraction Notice';
535     TX_RETRACT        = 'This document will now be RETRACTED.  As Such, it has been removed' +CRLF +
536                         ' from public view, and from typical Releases of Information,' +CRLF +
537                         ' but will remain indefinitely discoverable to HIMS.' +CRLF +CRLF;
538     TX_AUTH_SIGNED    = 'Author has not signed, are you SURE you want to sign.' +CRLF;
539   
540   var
541     ViewContext, CurrNotifIEN: integer ;
542     SvcCtxt: TServiceContext;
543     StsCtxt: TStatusContext ;
544     DateRange: TConsultDateRange;
545     uSelectContext: TSelectContext  ;
546     uPCEShow, uPCEEdit:  TPCEData;
547     frmDrawers: TfrmDrawers;
548     MenuAccessRec: TMenuAccessRec;
549     MedResult: TMedResultRec;
550     uChanging: Boolean;
551     uIDNotesActive: boolean;
552   
553   { TPage common methods --------------------------------------------------------------------- }
554   
555   function TfrmConsults.AllowContextChange(var WhyNot: string): Boolean;
556   begin
557     dlgFindText.CloseDialog;
558     Result := inherited AllowContextChange(WhyNot);  // sets result = true
559     if Assigned(frmTemplateDialog) then
560       if Screen.ActiveForm = frmTemplateDialog then
561       //if (fsModal in frmTemplateDialog.FormState) then
562       case BOOLCHAR[frmFrame.CCOWContextChanging] of
563         '1': begin
564                WhyNot := 'A template in progress will be aborted.  ';
565                Result := False;
566              end;
567         '0': begin
568                if WhyNot = 'COMMIT' then
569                  begin
570                    FSilent := True;
571                    frmTemplateDialog.Silent := True;
572                    frmTemplateDialog.ModalResult := mrCancel;
573                  end;
574              end;
575       end;
576     if EditingIndex <> -1 then
577       case BOOLCHAR[frmFrame.CCOWContextChanging] of
578       '1': begin
579                if memResults.GetTextLen > 0 then
580                  WhyNot := WhyNot + 'A note in progress will be saved as unsigned.  '
581                else
582                  WhyNot := WhyNot + 'An empty note in progress will be deleted.  ';
583              Result := False;
584            end;
585       '0': begin
586              if WhyNot = 'COMMIT' then FSilent := True;
587              SaveCurrentNote(Result);
588            end;
589     end;
590     if Assigned(frmEncounterFrame) then
591       if Screen.ActiveForm = frmEncounterFrame then
592       //if (fsModal in frmEncounterFrame.FormState) then
593       case BOOLCHAR[frmFrame.CCOWContextChanging] of
594         '1': begin
595                WhyNot := WhyNot + 'Encounter information being edited will not be saved';
596                Result := False;
597              end;
598         '0': begin
599                if WhyNot = 'COMMIT' then
600                  begin
601                    FSilent := True;
602                    frmEncounterFrame.Abort := False;
603                    frmEncounterFrame.Cancel := True;
604                  end;
605              end;
606       end;
607   end;
608   
609   procedure TfrmConsults.ClearPtData;
610   { clear all controls that contain patient specific information }
611   begin
612     inherited ClearPtData;
613     ClearEditControls;
614     lstConsults.Clear;
615     memConsult.Clear;
616     memResults.Clear;
617     uChanging := True;
618     tvCsltNotes.Items.BeginUpdate;
619     KillDocTreeObjects(tvCsltNotes);
620     tvCsltNotes.Items.Clear;
621     tvCsltNotes.Items.EndUpdate;
622     tvConsults.Items.BeginUpdate;
623     tvConsults.Items.Clear;
624     tvConsults.Items.EndUpdate;
625     uChanging := False;
626     lstNotes.Clear ;
627     memPCEShow.Clear;
628     uPCEShow.Clear;
629     frmDrawers.ResetTemplates;
630     FOrderID := '';
631   end;
632   
633   procedure TfrmConsults.SetViewContext(AContext: TSelectContext);
634   var
635     Saved: boolean;
636   begin
637     if EditingIndex <> -1 then
638     begin
639       SaveCurrentNote(Saved);
640       if not Saved then Exit;
641     end;
642     FCurrentContext := AContext;
643     CurrNotifIEN := 0;
644     EditingIndex := -1;
645     pnlConsultList.Enabled := True; //CQ#15785
646   //  tvConsults.Enabled := True;
647   //  lstConsults.Enabled := True ;
648     lstNotes.Enabled := True ;
649     pnlRead.BringToFront ;
650     memConsult.TabStop := True;
651     with uSelectContext do
652       begin
653         BeginDate := FCurrentContext.BeginDate;
654         EndDate   := FCurrentContext.EndDate;
655         Status    := FCurrentContext.Status;
656         Service   := FCurrentContext.Service;
657         Ascending := FCurrentContext.Ascending;
658         GroupBy   := FCurrentContext.GroupBy;
659         Changed   := True;
660         mnuViewClick(Self);
661       end;
662   end;
663   
664   procedure TfrmConsults.DisplayPage;
665   { causes page to be visible and conditionally executes initialization code }
666   begin
667     inherited DisplayPage;
668     frmFrame.ShowHideChartTabMenus(mnuViewChart);
669     frmFrame.mnuFilePrint.Tag := CT_CONSULTS;
670     frmFrame.mnuFilePrint.Enabled := True;
671     frmFrame.mnuFilePrintSetup.Enabled := True;
672     frmFrame.mnuFilePrintSelectedItems.Enabled := True;
673     FNotifPending := False;
674     if InitPage then
675     begin
676       FDefaultContext := GetCurrentContext;
677       FCurrentContext := FDefaultContext;
678       popNoteMemoSpell.Visible   := SpellCheckAvailable;
679       popNoteMemoGrammar.Visible := popNoteMemoSpell.Visible;
680       Z11.Visible                := popNoteMemoSpell.Visible;
681       timAutoSave.Interval := User.AutoSave * 1000;  // convert seconds to milliseconds
682       SetEqualTabStops(memResults);
683     end;
684     cmdEditResubmit.Visible := False;
685     EnableDisableIDNotes;
686     EnableDisableOrdering;
687     if InitPage then SendMessage(memConsult.Handle, EM_SETMARGINS, EC_LEFTMARGIN, 4);
688     if InitPatient and not (CallingContext = CC_NOTIFICATION) then
689       begin
690         SetViewContext(FDefaultContext);
691       end;
692     case CallingContext of
693       CC_INIT_PATIENT: if not InitPatient then
694                          begin
695                            SetViewContext(FDefaultContext);
696                          end;
697       CC_NOTIFICATION:  ProcessNotifications;
698     end;
699     //with tvConsults do if Selected <> nil then tvConsultsChange(Self, Selected);   
700   end;
701   
702   procedure TfrmConsults.SetFontSize(NewFontSize: Integer);
703   { adjusts the font size of any controls that don't have ParentFont = True }
704   begin
705     inherited SetFontSize(NewFontSize);
706     memConsult.Font.Size  := NewFontSize;
707     memResults.Font.Size  := NewFontSize;
708     lblTitle.Font.Size    := NewFontSize;
709     frmDrawers.Font.Size  := NewFontSize;
710     SetEqualTabStops(memResults);
711     // adjust heights of pnlAction, pnlFields, and memPCEShow
712   end;
713   
714   procedure TfrmConsults.mnuChartTabClick(Sender: TObject);
715   { reroute to Chart Tab menu of the parent form: frmFrame }
716   begin
717     inherited;
718     frmFrame.mnuChartTabClick(Sender);
719   end;
720   
721   { General procedures ----------------------------------------------------------------------- }
722   
723   procedure TfrmConsults.ClearEditControls;
724   begin
725     // clear FEditNote (should FEditNote be an object with a clear method?)
726     with FEditNote do
727     begin
728       DocType      := 0;
729       Title        := 0;
730       TitleName    := '';
731       DateTime     := 0;
732       Author       := 0;
733       AuthorName   := '';
734       Cosigner     := 0;
735       CosignerName := '';
736       Subject      := '';
737       Location     := 0;
738       LocationName := '';
739       //Consult      := 0;
740       PkgRef       := '';
741       PkgIEN       := 0;
742       PkgPtr       := '';
743       NeedCPT      := False;
744       Addend       := 0;
745       Lines        := nil;
746     end;
747     // clear the editing controls (also clear the new labels?)
748     txtSubject.Text := '';
749     memResults.Clear;
750     timAutoSave.Enabled := False;
751     // clear the PCE object for editing
752     uPCEEdit.Clear;
753     // set the tracking variables to initial state
754     EditingIndex := -1;
755     frmConsults.ActiveControl := nil;
756     ShowPCEControls(FALSE);
757     FChanged := False;
758   end;
759   
760   procedure TfrmConsults.CompleteConsult(IsIDChild: boolean; AnIDParent: integer; UseClinProcTitles: boolean);
761   { creates the editing context for a new progress note & inserts stub into top of view list }
762   const
763     USE_CURRENT_VISITSTR = -2;
764   var
765     EnableAutosave, HaveRequired: Boolean;
766     CreatedNote: TCreatedDoc;
767     TmpBoilerPlate: TStringList;
768     x, WhyNot: string;
769     tmpNode: TTreeNode;
770     AClassName: string;
771     DocInfo: string;
772   begin
773     EnableAutosave := FALSE;
774     TmpBoilerPlate := nil;
775     try
776       ClearEditControls;
777       pnlConsultList.Enabled := False; //CQ#15785
778   //    tvConsults.Enabled := False;
779   //    lstConsults.Enabled := False ;
780       FillChar(FEditNote, SizeOf(FEditNote), 0);  //v15.7
781       with FEditNote do
782       begin
783         if UseClinProcTitles then
784           begin
785             DocType      := IdentifyClinProcClass;
786             Title        := DfltClinProcTitle;
787             TitleName    := DfltClinProcTitleName;
788             AClassName   := DCL_CLINPROC;
789           end
790         else
791           begin
792             DocType      := TYP_PROGRESS_NOTE;
793             Title        := DfltConsultTitle;
794             TitleName    := DfltConsultTitleName;
795             AClassName   := DCL_CONSULTS
796           end;
797         if IsIDChild and (not CanTitleBeIDChild(Title, WhyNot)) then
798           begin
799             Title := 0;
800             TitleName := '';
801           end;
802         DateTime     := FMNow;
803         Author       := User.DUZ;
804         AuthorName   := User.Name;
805         Location     := Encounter.Location;
806         LocationName := Encounter.LocationName;                                           
807         VisitDate    := Encounter.DateTime;
808         if IsIDChild then
809           IDParent   := AnIDParent
810         else
811           IDParent   := 0;
812         PkgRef       := lstConsults.ItemID + ';' + PKG_CONSULTS;
813         PkgIEN       := lstConsults.ItemIEN;
814         PkgPtr       := PKG_CONSULTS;
815         // Cosigner, if needed, will be set by fNoteProps
816       end;
817       // check to see if interaction necessary to get required fields
818       if LacksRequiredForCreate or VerifyNoteTitle
819         then HaveRequired := ExecuteNoteProperties(FEditNote, CT_CONSULTS, IsIDChild, False, AClassName,
820                                 MenuAccessRec.ClinProcFlag)
821         else HaveRequired := True;
822       // lock the consult request if there is a consult
823       if FEditNote.PkgIEN > 0 then HaveRequired := HaveRequired and LockConsultRequest(FEditNote.PkgIEN);
824       if HaveRequired then
825         begin
826           // set up uPCEEdit for entry of new note
827           uPCEEdit.UseEncounter := True;
828           uPCEEdit.NoteDateTime := FEditNote.DateTime;
829           uPCEEdit.PCEForNote(USE_CURRENT_VISITSTR, uPCEShow);
830           FEditNote.NeedCPT  := uPCEEdit.CPTRequired;
831            // create the note
832           PutNewNote(CreatedNote, FEditNote);
833           uPCEEdit.NoteIEN := CreatedNote.IEN;
834           if CreatedNote.IEN > 0 then LockDocument(CreatedNote.IEN, CreatedNote.ErrorText);
835           if CreatedNote.ErrorText = '' then
836             begin
837               if lstNotes.DisplayText[0] = 'None' then
838                 begin
839                   uChanging := True;
840                   tvCsltNotes.Items.BeginUpdate;
841                   lstNotes.Items.Clear;
842                   KillDocTreeObjects(tvCsltNotes);
843                   tvCsltNotes.Items.Clear;
844                   tvCsltNotes.Items.EndUpdate;
845                   uChanging := False;
846                 end;
847               with FEditNote do
848                 begin
849                   x := IntToStr(CreatedNote.IEN) + U + TitleName + U + FloatToStr(DateTime) + U +
850                        Patient.Name + U + IntToStr(Author) + ';' + AuthorName + U + LocationName + U + 'new' + U +
851                        'Adm: ' + FormatFMDateTime('mmm dd,yyyy', VisitDate) + ';' + FloatToStr(VisitDate) + U + U +
852                        U + U + U + U + U + U;
853                 end;
854               lstNotes.Items.Insert(0, x);
855               uChanging := True;
856               tvCsltNotes.Items.BeginUpdate;
857               if IsIDChild then
858                 begin
859                   tmpNode := tvCsltNotes.FindPieceNode(IntToStr(AnIDParent), 1, U, tvCsltNotes.Items.GetFirstNode);
860                   tmpNode.ImageIndex := IMG_IDNOTE_OPEN;
861                   tmpNode.SelectedIndex := IMG_IDNOTE_OPEN;
862                   tmpNode := tvCsltNotes.Items.AddChildObjectFirst(tmpNode, MakeConsultNoteDisplayText(x), MakeNoteTreeObject(x));
863                   tmpNode.ImageIndex := IMG_ID_CHILD;
864                   tmpNode.SelectedIndex := IMG_ID_CHILD;
865                 end
866               else
867                 begin
868                   tmpNode := tvCsltNotes.Items.AddObjectFirst(tvCsltNotes.Items.GetFirstNode, 'New Note in Progress',
869                                                           MakeNoteTreeObject('NEW^New Note in Progress^^^^^^^^^^^%^0'));
870                   TORTreeNode(tmpNode).StringData := 'NEW^New Note in Progress^^^^^^^^^^^%^0';
871                   tmpNode.ImageIndex := IMG_TOP_LEVEL;
872                   tmpNode := tvCsltNotes.Items.AddChildObjectFirst(tmpNode, MakeConsultNoteDisplayText(x), MakeNoteTreeObject(x));
873                   tmpNode.ImageIndex := IMG_SINGLE;
874                   tmpNode.SelectedIndex := IMG_SINGLE;
875                 end;
876               tmpNode.StateIndex := IMG_NO_IMAGES;
877               TORTreeNode(tmpNode).StringData := x;
878               tvCsltNotes.Selected := tmpNode;
879               tvCsltNotes.Items.EndUpdate;
880               uChanging := False;
881   
882               Changes.Add(CH_CON, IntToStr(CreatedNote.IEN), GetTitleText(0), '', CH_SIGN_YES);
883               lstNotes.ItemIndex := 0;
884               EditingIndex := 0;
885               SetSubjectVisible(AskSubjectForNotes);
886               if not assigned(TmpBoilerPlate) then
887                 TmpBoilerPlate := TStringList.Create;
888               LoadBoilerPlate(TmpBoilerPlate, FEditNote.Title);
889               FChanged := False;
890               cmdChangeClick(Self); // will set captions, sign state for Changes
891               lstNotesClick(Self);  // will make pnlWrite visible
892               if timAutoSave.Interval <> 0 then EnableAutosave := TRUE;
893               if txtSubject.Visible then txtSubject.SetFocus else memResults.SetFocus;
894             end
895           else  //  CreatedNote.ErrorText <> ''
896             begin
897               // if note creation failed or failed to get note lock (both unlikely), unlock consult
898               if FEditNote.PkgIEN > 0 then UnlockConsultRequest(0, FEditNote.PkgIEN);
899               //if FEditNote.Consult > 0 then UnlockConsultRequest(0, FEditNote.Consult);
900               if CreatedNote.ErrorText <> '' then
901                 InfoBox(CreatedNote.ErrorText, TX_CREATE_ERR, MB_OK);
902               HaveRequired := False;
903             end; {if CreatedNote.IEN}
904         end; {if HaveRequired}
905       if not HaveRequired then
906         begin
907           ClearEditControls;
908           pnlConsultList.Enabled := True; //CQ#15785
909   //        lstConsults.Enabled := True;
910   //        tvConsults.Enabled := True;
911         end;
912       SetResultMenus ;
913     finally
914       if assigned(TmpBoilerPlate) then
915       begin
916         DocInfo := MakeXMLParamTIU(IntToStr(CreatedNote.IEN), FEditNote);
917         ExecuteTemplateOrBoilerPlate(TmpBoilerPlate, FEditNote.Title, ltTitle, Self, 'Title: ' + FEditNote.TitleName, DocInfo);
918         QuickCopyWith508Msg(TmpBoilerPlate, memResults);
919         TmpBoilerPlate.Free;
920       end;
921       if EnableAutosave then // Don't enable autosave until after dialog fields have been resolved
922         timAutoSave.Enabled := True;
923     end;
924   end;
925   
926   procedure TfrmConsults.InsertAddendum;
927   { sets up fields of pnlWrite to write an addendum for the selected note }
928   const
929     AS_ADDENDUM = True;
930     IS_ID_CHILD = False;
931   var
932     HaveRequired: Boolean;
933     CreatedNote: TCreatedDoc;
934     x: string;
935     tmpNode: TTreeNode;
936     AClassName: string;
937   begin
938     AClassName := DCL_CONSULTS;
939     ClearEditControls;
940     pnlConsultList.Enabled := False; //CQ#15785
941   //  lstConsults.Enabled := False ;
942   //  tvConsults.Enabled := False;
943     with FEditNote do
944     begin
945       DocType      := TYP_ADDENDUM;
946       Title        := TitleForNote(lstNotes.ItemIEN);
947       TitleName    := Piece(lstNotes.Items[lstNotes.ItemIndex], U, 2);
948       DateTime     := FMNow;
949       Author       := User.DUZ;
950       AuthorName   := User.Name;
951       x            := GetPackageRefForNote(lstNotes.ItemIEN);
952       if Piece(x, U, 1) <> '-1' then
953         begin
954           PkgRef       := GetPackageRefForNote(lstNotes.ItemIEN);
955           PkgIEN       := StrToIntDef(Piece(PkgRef, ';', 1), 0);
956           PkgPtr       := Piece(PkgRef, ';', 2);
957         end;
958       Addend       := lstNotes.ItemIEN;
959       // Cosigner, if needed, will be set by fNoteProps
960       // Location info will be set after the encounter is loaded
961     end;
962     // check to see if interaction necessary to get required fields
963     if LacksRequiredForCreate
964       then HaveRequired := ExecuteNoteProperties(FEditNote, CT_CONSULTS, IS_ID_CHILD,
965                              False, AClassName, MenuAccessRec.ClinProcFlag)
966       else HaveRequired := True;
967     // lock the consult request if there is a consult
968     if HaveRequired and (FEditNote.PkgIEN > 0) then
969       HaveRequired := LockConsultRequest(FEditNote.PkgIEN);
970     if HaveRequired then
971     begin
972       uPCEEdit.NoteDateTime := FEditNote.DateTime;
973       uPCEEdit.PCEForNote(FEditNote.Addend, uPCEShow);
974       FEditNote.Location     := uPCEEdit.Location;
975       FEditNote.LocationName := ExternalName(uPCEEdit.Location, 44);
976       FEditNote.VisitDate    := uPCEEdit.DateTime;
977       PutAddendum(CreatedNote, FEditNote, FEditNote.Addend);
978       uPCEEdit.NoteIEN := CreatedNote.IEN;
979       if CreatedNote.IEN > 0 then LockDocument(CreatedNote.IEN, CreatedNote.ErrorText);
980       if CreatedNote.ErrorText = '' then
981       begin
982         with FEditNote do
983           begin
984             x := IntToStr(CreatedNote.IEN) + U + 'Addendum to ' + TitleName + U + FloatToStr(DateTime) + U +
985                  Patient.Name + U + IntToStr(Author) + ';' + AuthorName + U + LocationName + U + 'new' + U +
986                  U + U + U + U + U + U + U + U;
987           end;
988         lstNotes.Items.Insert(0, x);
989   
990         uChanging := True;
991         tvCsltNotes.Items.BeginUpdate;
992         tmpNode := tvCsltNotes.Items.AddObjectFirst(tvCsltNotes.Items.GetFirstNode, 'New Addendum in Progress',
993                                                 MakeConsultsNoteTreeObject('ADDENDUM^New Addendum in Progress^^^^^^^^^^^%^0'));
994         TORTreeNode(tmpNode).StringData := 'ADDENDUM^New Addendum in Progress^^^^^^^^^^^%^0';
995         tmpNode.ImageIndex := IMG_TOP_LEVEL;
996         tmpNode := tvCsltNotes.Items.AddChildObjectFirst(tmpNode, MakeConsultNoteDisplayText(x), MakeConsultsNoteTreeObject(x));
997         TORTreeNode(tmpNode).StringData := x;
998         tmpNode.ImageIndex := IMG_ADDENDUM;
999         tmpNode.SelectedIndex := IMG_ADDENDUM;
1000        tvCsltNotes.Selected := tmpNode;
1001        tvCsltNotes.Items.EndUpdate;
1002        uChanging := False;
1003  
1004        Changes.Add(CH_CON, IntToStr(CreatedNote.IEN), GetTitleText(0), '', CH_SIGN_YES);
1005        lstNotes.ItemIndex := 0;
1006        EditingIndex := 0;
1007        SetSubjectVisible(AskSubjectForNotes);
1008        cmdChangeClick(Self); // will set captions, sign state for Changes
1009        lstNotesClick(Self);  // will make pnlWrite visible
1010        if timAutoSave.Interval <> 0 then timAutoSave.Enabled := True;
1011        memResults.SetFocus;
1012      end else
1013      begin
1014        // if note creation failed or failed to get note lock (both unlikely), unlock consult
1015        if FEditNote.PkgIEN > 0 then UnlockConsultRequest(0, FEditNote.PkgIEN);
1016        //if FEditNote.Consult > 0 then UnlockConsultRequest(0, FEditNote.Consult);
1017        InfoBox(CreatedNote.ErrorText, TX_CREATE_ERR, MB_OK);
1018        HaveRequired := False;
1019        pnlConsultList.Enabled := True; //CQ#15785
1020  //      lstConsults.Enabled := True;
1021  //      tvConsults.Enabled := True;
1022      end; {if CreatedNote.IEN}
1023    end; {if HaveRequired}
1024    if not HaveRequired then ClearEditControls;
1025    SetResultMenus ;
1026  end;
1027  
1028  procedure TfrmConsults.LoadForEdit;
1029  { retrieves an existing note and places the data in the fields of pnlWrite }
1030  var
1031    tmpNode: TTreeNode;
1032    x: string;
1033    ErrMsg: string;
1034    AnAuthor: int64;
1035    AProcSummCode: integer;
1036    AProcDate: TFMDateTime;
1037    tmpBoilerplate: TStringList;
1038    EnableAutoSave: boolean;
1039    DocInfo: string;
1040  begin
1041    ClearEditControls;
1042    if not LockConsultRequestAndNote(lstNotes.ItemIEN) then Exit;
1043    EnableAutosave := FALSE;
1044    tmpBoilerplate := nil;
1045    try
1046      EditingIndex := lstNotes.ItemIndex;
1047      Changes.Add(CH_CON, lstNotes.ItemID, GetTitleText(EditingIndex), '', CH_SIGN_YES);
1048      GetNoteForEdit(FEditNote, lstNotes.ItemIEN);
1049      memResults.Lines.Assign(FEditNote.Lines);
1050      FChanged := False;
1051      if FEditNote.Title = TYP_ADDENDUM then
1052      begin
1053        FEditNote.DocType := TYP_ADDENDUM;
1054        FEditNote.TitleName := Piece(lstNotes.Items[lstNotes.ItemIndex], U, 2);
1055        if Copy(FEditNote.TitleName,1,1) = '+' then FEditNote.TitleName := Copy(FEditNote.TitleName, 3, 199);
1056        if CompareText(Copy(FEditNote.TitleName, 1, 8), 'Addendum') <> 0
1057          then FEditNote.TitleName := FEditNote.TitleName + 'Addendum to ';
1058      end;
1059      uChanging := True;
1060      tvCsltNotes.Items.BeginUpdate;
1061      tmpNode := tvCsltNotes.FindPieceNode('EDIT', 1, U, nil);
1062      if tmpNode = nil then
1063        begin
1064          tmpNode := tvCsltNotes.Items.AddObjectFirst(tvCsltNotes.Items.GetFirstNode, 'Note being edited',
1065                                                  MakeConsultsNoteTreeObject('EDIT^Note being edited^^^^^^^^^^^%^0'));
1066          TORTreeNode(tmpNode).StringData := 'EDIT^Note being edited^^^^^^^^^^^%^0';
1067        end
1068      else
1069        tmpNode.DeleteChildren;
1070      x := lstNotes.Items[lstNotes.ItemIndex];
1071      tmpNode.ImageIndex := IMG_TOP_LEVEL;
1072      tmpNode := tvCsltNotes.Items.AddChildObjectFirst(tmpNode, MakeConsultNoteDisplayText(x), MakeConsultsNoteTreeObject(x));
1073      TORTreeNode(tmpNode).StringData := x;
1074      if CompareText(Copy(FEditNote.TitleName, 1, 8), 'Addendum') <> 0 then
1075        tmpNode.ImageIndex := IMG_SINGLE
1076      else
1077        tmpNode.ImageIndex := IMG_ADDENDUM;
1078      tmpNode.SelectedIndex := tmpNode.ImageIndex;
1079      tvCsltNotes.Selected := tmpNode;
1080      tvCsltNotes.Items.EndUpdate;
1081      uChanging := False;
1082  
1083      uPCEEdit.NoteDateTime := MakeFMDateTime(Piece(lstNotes.Items[lstNotes.ItemIndex], U, 3));
1084      uPCEEdit.PCEForNote(lstNotes.ItemIEN, uPCEShow);
1085      FEditNote.NeedCPT := uPCEEdit.CPTRequired;
1086      txtSubject.Text := FEditNote.Subject;
1087      SetSubjectVisible(AskSubjectForNotes);
1088      if MenuAccessRec.IsClinicalProcedure and LacksClinProcFields(FEditNote, MenuAccessRec, ErrMsg) then
1089        begin
1090          // **** Collect Author, ClinProcSummCode, and ClinProcDate    ****
1091           AnAuthor := FEditNote.Author;
1092           AProcSummCode := FEditNote.ClinProcSummCode;
1093           AProcDate := FEditNote.ClinProcDateTime;
1094           EnterClinProcFields(MenuAccessRec.ClinProcFlag, ErrMsg, AProcSummCode, AProcDate, AnAuthor);
1095          // **** set values into FEditNote ****
1096           FEditNote.Author           := AnAuthor;
1097           FEditNote.ClinProcSummCode := AProcSummCode;
1098           FEditNote.ClinProcDateTime := AProcDate;
1099        end;
1100    (*  if LacksClinProcFields(ErrMsg) then
1101        begin
1102          // **** Collect Author, Cosigner (if required), ClinProcSummCode, and ClinProcDate    ****
1103          EnterClinProcFields(MenuAccessRec.ClinProcFlag, ErrMsg, FEditNote);
1104        end;*)
1105      if MenuAccessRec.IsClinicalProcedure and (memResults.Lines.Text = '') then
1106      begin
1107        if not assigned(TmpBoilerPlate) then
1108          TmpBoilerPlate := TStringList.Create;
1109        LoadBoilerPlate(TmpBoilerPlate, FEditNote.Title);
1110      end;
1111      if frmFrame.Closing then exit;
1112      cmdChangeClick(Self); // will set captions, sign state for Changes
1113      lstNotesClick(Self);  // will make pnlWrite visible
1114      if timAutoSave.Interval <> 0 then EnableAutosave := TRUE;
1115      memResults.SetFocus;
1116    finally
1117      if assigned(TmpBoilerPlate) then
1118      begin
1119        DocInfo := MakeXMLParamTIU(IntToStr(lstNotes.ItemIEN), FEditNote);
1120        ExecuteTemplateOrBoilerPlate(TmpBoilerPlate, FEditNote.Title, ltTitle, Self, 'Title: ' + FEditNote.TitleName, DocInfo);
1121        QuickCopyWith508Msg(TmpBoilerPlate, memResults);
1122        TmpBoilerPlate.Free;
1123      end;
1124      if EnableAutosave then // Don't enable autosave until after dialog fields have been resolved
1125        timAutoSave.Enabled := True;
1126    end;
1127  end;
1128  
1129  procedure TfrmConsults.SaveEditedConsult(var Saved: Boolean);
1130  { validates fields and sends the updated consult result to the server }
1131  var
1132    UpdatedNote: TCreatedDoc;
1133    x, ErrMsg: string;
1134    ContinueSave: boolean;
1135  
1136    // this block executes for Clinical Procedures documents ONLY!!
1137    procedure SaveOrAbort(var AllowSave: boolean);
1138    begin
1139      // if no text, leave as undictated, saving nothing
1140      if (memResults.GetTextLen = 0) or (not ContainsVisibleChar(memResults.Text)) then
1141        begin
1142          if lstNotes.ItemIndex = EditingIndex then
1143            begin
1144              EditingIndex := -1;
1145              lstNotesClick(Self);
1146            end;
1147          EditingIndex := -1;
1148          Saved := True;    // (yes, though not actually saving, this is correct and necessary (RV))
1149          AllowSave := False;
1150        end
1151      // if text, stuff user as author, and allow save as unsigned
1152      else
1153        begin
1154          if FEditNote.Author <= 0 then FEditNote.Author := User.DUZ;
1155          AllowSave := True;
1156        end;
1157    end;
1158  
1159  begin
1160    Saved := False;
1161    ContinueSave := True;
1162    if MenuAccessRec.IsClinicalProcedure and LacksClinProcFields(FEditNote, MenuAccessRec, ErrMsg) then
1163      // this block will execute for Clinical Procedures documents ONLY!!
1164      begin
1165        if not FSilent then                       //  if not timing out, then prompt for required fields
1166          begin
1167            InfoBox(ErrMsg, TC_CLIN_PROC, MB_OK);
1168            cmdChangeClick(mnuActConsultResults);
1169            if frmFrame.TimedOut then exit;
1170            if MenuAccessRec.IsClinicalProcedure and LacksClinProcFields(FEditNote, MenuAccessRec, ErrMsg) then   //  if still not entered, action depends on presence of text
1171              SaveOrAbort(ContinueSave);
1172          end
1173        else SaveOrAbort(ContinueSave);           //  if timing out, action depends on presence of text
1174        if not ContinueSave then exit;
1175      end
1176    else if (memResults.GetTextLen = 0) or (not ContainsVisibleChar(memResults.Text)) then
1177    // this block will NOT execute for Clinical Procedures documents!!
1178    begin
1179      lstNotes.ItemIndex := EditingIndex;
1180      x := lstNotes.ItemID;
1181      uChanging := True;
1182      tvCsltNotes.Selected := tvCsltNotes.FindPieceNode(x, 1, U, tvCsltNotes.Items.GetFirstNode);
1183      uChanging := False;
1184      tvCsltNotesChange(Self, tvCsltNotes.Selected);
1185      if FSilent or
1186         ((not FSilent) and
1187        (InfoBox(GetTitleText(EditingIndex) + TX_EMPTY_NOTE, TC_EMPTY_NOTE, MB_YESNO) = IDYES))
1188      then
1189      begin
1190        FConfirmed := True;
1191        mnuActNoteDeleteClick(Self);
1192        Saved := True;
1193        FDeleted := True;
1194      end
1195      else
1196        FConfirmed := False;
1197      Exit;
1198    end;
1199    //ExpandTabsFilter(memResults.Lines, TAB_STOP_CHARS);
1200    FEditNote.Lines    := memResults.Lines;
1201    FEditNote.Subject  := txtSubject.Text;
1202    FEditNote.NeedCPT  := uPCEEdit.CPTRequired;
1203    timAutoSave.Enabled := False;
1204    try
1205      PutEditedNote(UpdatedNote, FEditNote, lstNotes.GetIEN(EditingIndex));
1206    finally
1207      timAutoSave.Enabled := True;
1208    end;
1209    // there's no unlocking here since the note is still in Changes after a save
1210    if UpdatedNote.IEN > 0 then
1211    begin
1212      if lstNotes.ItemIndex = EditingIndex then
1213      begin
1214        EditingIndex := -1;
1215        lstNotesClick(Self);
1216      end;
1217      EditingIndex := -1;
1218      Saved := True;
1219      FChanged := False;
1220    end else
1221    begin
1222      if not FSilent then
1223        InfoBox(TX_SAVE_ERROR1 + UpdatedNote.ErrorText + TX_SAVE_ERROR2, TC_SAVE_ERROR, MB_OK or MB_ICONWARNING);
1224    end;
1225  end;
1226  
1227  procedure TfrmConsults.SaveCurrentNote(var Saved: Boolean);
1228  begin
1229    if EditingIndex < 0 then Exit;
1230    SaveEditedConsult(Saved);
1231  end;
1232  
1233  
1234  { Form events -----------------------------------------------------------------}
1235  
1236  procedure TfrmConsults.pnlRightExit(Sender: TObject);
1237  begin
1238    inherited;
1239    if TabIsPressed then
1240      FindNextControl(tvConsults, True, True, False).SetFocus
1241    else if ShiftTabIsPressed then
1242      FindNextControl(pnlLeft, True, True, False).SetFocus;
1243  end;
1244  
1245  procedure TfrmConsults.pnlRightResize(Sender: TObject);
1246  { TRichEdit doesn't repaint appropriately unless its parent panel is refreshed }
1247  begin
1248    inherited;
1249    pnlRight.Refresh;
1250    pnlAction.Invalidate;
1251    memConsult.Repaint;
1252    pnlResults.Invalidate;
1253    memResults.Repaint;
1254  end;
1255  
1256  { Left panel (selector) events ------------------------------------------------------------- }
1257  
1258  procedure TfrmConsults.lstConsultsClick(Sender: TObject);
1259  { loads the text for the selected Consult}
1260  const
1261    RSLT_TIU_DOC = 1;
1262    RSLT_MED_RPT = 2;
1263  var
1264    ANode: TTreeNode;
1265  begin
1266    inherited;
1267    lstNotes.Items.Clear ;
1268    memConsult.Clear ;
1269    ClearEditControls ;
1270    if lstConsults.ItemIEN <= 0 then
1271     begin
1272        memConsult.Lines.Add('No consults were found which met the criteria specified: '
1273                                 + #13#10#13#10 + lblConsults.Caption) ;
1274        memConsult.SelStart := 0;
1275        mnuAct.Enabled := False ;
1276        exit ;
1277     end
1278    else mnuAct.Enabled := True;
1279    pnlResults.Visible := False;
1280    pnlResults.SendToBack;
1281    Screen.Cursor := crHourglass ;
1282    StatusText('Retrieving selected consult...');
1283    cmdPCE.Enabled := False;
1284    popNoteMemoEncounter.Enabled := False;
1285    GetConsultRec(lstConsults.ItemIEN) ;
1286    FOrderID := '';
1287    //FOrderID := Piece(lstConsults.Items[lstConsults.ItemIndex], U, 6);
1288    if ConsultRec.EntryDate = -1 then
1289      begin
1290         memConsult.Lines.Add(TX_INVALID_CONSULT_TEXT) ;
1291         lblTitle.Caption :=  TX_INVALID_CONSULT_CAP ;
1292         lblTitle.Hint := lblTitle.Caption;
1293      end
1294    else
1295      begin
1296         lblTitle.Caption := lstConsults.DisplayText[lstConsults.ItemIndex] ;
1297         lblTitle.Hint := lblTitle.Caption;
1298         LoadConsultDetail(memConsult.Lines, lstConsults.ItemIEN) ;
1299         FDocList.Clear;
1300         lstNotes.Items.Clear;
1301         uChanging := True;
1302         tvCsltNotes.Items.BeginUpdate;
1303         KillDocTreeObjects(tvCsltNotes);
1304         tvCsltNotes.Items.Clear;
1305         if (ConsultRec.TIUDocuments.Count + ConsultRec.MedResults.Count) > 0 then
1306         begin
1307           with FCurrentNoteContext do
1308              begin
1309                  if ConsultRec.TIUDocuments.Count > 0 then
1310                    begin
1311                      CreateListItemsForDocumentTree(FDocList, ConsultRec.TIUDocuments, RSLT_TIU_DOC, GroupBy, TreeAscending, CT_CONSULTS);
1312                      UpdateNoteTreeView(FDocList, tvCsltNotes, RSLT_TIU_DOC);
1313                    end;
1314                  FDocList.Clear;
1315                  if ConsultRec.MedResults.Count > 0 then
1316                    begin
1317                      CreateListItemsForDocumentTree(FDocList, ConsultRec.MedResults, RSLT_MED_RPT, GroupBy, TreeAscending, CT_CONSULTS);
1318                      UpdateNoteTreeView(FDocList, tvCsltNotes, RSLT_MED_RPT);
1319                    end;
1320              end;
1321           with tvCsltNotes do
1322             begin
1323               FullExpand;
1324               if Notifications.Active and FNotifPending then
1325                 Selected := FindPieceNode(Piece(Notifications.AlertData, U, 1), 1, U, nil)
1326               else if FLastNoteID <> '' then
1327                 Selected := FindPieceNode(FLastNoteID, 1, U, nil);
1328               if Selected <> nil then
1329                 if Piece(PDocTreeObject(Selected)^.DocID, ';', 1) <> 'MCAR' then DisplayPCE ;
1330             end;
1331          end
1332         else
1333          begin
1334            ANode := tvCsltNotes.Items.AddFirst(tvCsltNotes.Items.GetFirstNode, 'No related documents found');
1335            TORTreeNode(ANode).StringData := '-1^No related documents found';
1336            lstNotes.Items.Add('-1^None') ;
1337            ShowPCEControls(False) ;
1338          end ;
1339         tvCsltNotes.Items.EndUpdate;
1340         uChanging := False;
1341         FLastNoteID := '';
1342         //FLastNoteID := lstNotes.ItemID;
1343     end ;
1344    SetActionMenus ;
1345    SetResultMenus ;
1346    StatusText('');
1347    pnlRight.Repaint ;
1348    memConsult.SelStart := 0;
1349    memConsult.Repaint;
1350    Screen.Cursor := crDefault ;
1351  end;
1352  
1353  procedure TfrmConsults.mnuActNewConsultRequestClick(Sender: TObject);
1354  var
1355    DialogInfo: string;
1356    DelayEvent: TOrderDelayEvent;
1357  begin
1358    inherited;
1359    DelayEvent.EventType := 'C';         // temporary, so can pass to CopyOrders
1360    DelayEvent.Specialty := 0;
1361    DelayEvent.Effective := 0;
1362    DelayEvent.EventIFN  := 0;
1363    DelayEvent.PtEventIFN := 0;
1364    if not ReadyForNewOrder(DelayEvent) then Exit;
1365    { get appropriate form, create the dialog form and show it }
1366    DialogInfo := GetNewDialog(DLG_CONSULT);   // DialogInfo = DlgIEN;FormID;DGroup
1367    case CharAt(Piece(DialogInfo, ';', 4), 1) of
1368    'A':      ActivateAction(     Piece(DialogInfo, ';', 1),             Self, 0);
1369    'D', 'Q': ActivateOrderDialog(Piece(DialogInfo, ';', 1), DelayEvent, Self, 0);
1370    'M':      ActivateOrderMenu(  Piece(DialogInfo, ';', 1), DelayEvent, Self, 0);
1371    'O':      ActivateOrderSet(   Piece(DialogInfo, ';', 1), DelayEvent, Self, 0);
1372    else InfoBox('Unsupported dialog type', 'Error', MB_OK);
1373    end; {case}
1374  end;
1375  
1376  procedure TfrmConsults.mnuActNewProcedureClick(Sender: TObject);
1377  var
1378    DialogInfo: string;
1379    DelayEvent: TOrderDelayEvent;
1380  begin
1381    inherited;
1382    DelayEvent.EventType := 'C';         // temporary, so can pass to CopyOrders
1383    DelayEvent.Specialty := 0;
1384    DelayEvent.Effective := 0;
1385    DelayEvent.EventIFN  := 0;
1386    DelayEvent.PtEventIFN := 0;
1387    
1388    if not ReadyForNewOrder(DelayEvent) then Exit;
1389    { get appropriate form, create the dialog form and show it }
1390    DialogInfo := GetNewDialog(DLG_PROC);   // DialogInfo = DlgIEN;FormID;DGroup
1391    case CharAt(Piece(DialogInfo, ';', 4), 1) of
1392    'D', 'Q': ActivateOrderDialog(Piece(DialogInfo, ';', 1), DelayEvent, Self, 0);
1393    'M':      ActivateOrderMenu(  Piece(DialogInfo, ';', 1), DelayEvent, Self, 0);
1394    'O':      ActivateOrderSet(   Piece(DialogInfo, ';', 1), DelayEvent, Self, 0);
1395    else InfoBox('Unsupported dialog type', 'Error', MB_OK);
1396    end; {case}
1397  end;
1398  
1399  procedure TfrmConsults.cmdNewConsultClick(Sender: TObject);
1400  { maps 'New Consult' button to the New Consult menu item }
1401  begin
1402    inherited;
1403    mnuActNewConsultRequestClick(Self);
1404  end;
1405  
1406  procedure TfrmConsults.cmdNewConsultExit(Sender: TObject);
1407  begin
1408    inherited;
1409    if Not cmdEditResubmit.Visible then
1410      DoLeftPanelCustomShiftTab;
1411  end;
1412  
1413  procedure TfrmConsults.cmdNewProcClick(Sender: TObject);
1414  begin
1415    inherited;
1416    mnuActNewProcedureClick(Self);
1417  end;
1418  
1419  { Right panel (editor) events -------------------------------------------------------------- }
1420  
1421  procedure TfrmConsults.NewPersonNeedData(Sender: TObject; const StartFrom: string;
1422    Direction, InsertAt: Integer);
1423  begin
1424    inherited;
1425    (Sender as TORComboBox).ForDataUse(SubSetOfPersons(StartFrom, Direction));
1426  end;
1427  
1428  procedure TfrmConsults.memResultChange(Sender: TObject);
1429  { sets FChanged to record that the note has really been edited }
1430  begin
1431    inherited;
1432    FChanged := True;
1433  end;
1434  
1435  { View menu events ------------------------------------------------------------------------- }
1436  
1437  procedure TfrmConsults.mnuViewClick(Sender: TObject);
1438  { changes the list of Consults available for viewing }
1439  var
1440    NewView: boolean;
1441    Saved: Boolean;
1442    //tmpNode: TTreeNode;
1443  begin
1444    inherited;
1445    // save note at FEditingIndex?
1446    if EditingIndex <> -1 then
1447    begin
1448      SaveCurrentNote(Saved);
1449      if not Saved then Exit;
1450    end;
1451    NewView := False ;
1452    if Sender is TMenuItem then
1453      begin
1454        ViewContext := TMenuItem(Sender).Tag ;
1455        case ViewContext of
1456          CC_BY_STATUS  :  NewView := SelectStatus(Font.Size, FCurrentContext, StsCtxt);
1457          CC_BY_SERVICE :  NewView := SelectService(Font.Size, FCurrentContext, SvcCtxt);
1458          CC_BY_DATE    :  NewView := SelectConsultDateRange(Font.Size, FCurrentContext, DateRange);
1459          CC_CUSTOM     :  begin
1460                             NewView := SelectConsultsView(Font.Size, FCurrentContext, uSelectContext) ;
1461                             if NewView then lblConsults.Caption := 'Custom List';
1462                           end;  
1463          CC_ALL        :  NewView := True ;
1464        end;
1465      end
1466    else with FCurrentContext do
1467      begin
1468        if ((BeginDate + EndDate + Status + Service + GroupBy) <> '') then
1469          begin
1470            ViewContext := CC_CUSTOM;
1471            NewView := True;
1472            lblConsults.Caption := 'Default List';
1473          end
1474        else
1475          begin
1476            ViewContext := CC_ALL;
1477            NewView := True;
1478            lblConsults.Caption := 'All Consults';
1479          end;
1480      end;
1481    tvConsults.Caption := lblConsults.Caption;
1482    if NewView then
1483      begin
1484        StatusText('Retrieving Consult list...');
1485        lblTitle.Caption := '';
1486        lblTitle.Hint := lblTitle.Caption;
1487        UpdateList ;
1488        StatusText('');
1489      end;
1490    tvConsultsClick(Self);
1491  end;
1492  
1493  { Action menu events ----------------------------------------------------------------------- }
1494  
1495  procedure TfrmConsults.mnuActCompleteClick(Sender: TObject);
1496  const
1497    IS_ID_CHILD = False;
1498  var
1499    NoteIEN: integer;
1500    ActionSts: TActionRec;
1501    UseClinProcTitles: boolean;
1502  begin
1503    inherited;
1504    if lstConsults.ItemIEN = 0  then exit;
1505    if MenuAccessRec.IsClinicalProcedure then
1506      begin
1507        case MenuAccessRec.ClinProcFlag of
1508          {1} CP_NO_INSTRUMENT    : FActionType := CN_ACT_CP_COMPLETE;
1509          {2} CP_INSTR_NO_STUB    : begin
1510                                  InfoBox(TX_CP_NO_RESULTS, TC_CP_NO_RESULTS, MB_OK or MB_ICONERROR);
1511                                  Exit;
1512                                end;
1513          {3} CP_INSTR_INCOMPLETE : FActionType := CN_ACT_CP_COMPLETE;
1514          {4} CP_INSTR_COMPLETE   : FActionType := CN_ACT_CP_COMPLETE;
1515        end;
1516      end
1517    else  // {0} not a clinical procedure
1518      FActionType := TMenuItem(Sender).Tag ;
1519    if not StartNewEdit(NT_ACT_NEW_NOTE) then Exit;
1520  
1521    SelectNoteForProcessing(Font.Size, FActionType, lstNotes.Items, NoteIEN, MenuAccessRec.ClinProcFlag);
1522    if NoteIEN > 0 then
1523      begin
1524        with tvCsltNotes do Selected := FindPieceNode(IntToStr(NoteIEN), 1, U, Items.GetFirstNode);
1525        if tvCsltNotes.Selected = nil then exit;
1526        ActOnDocument(ActionSts, lstNotes.ItemIEN, 'EDIT RECORD');
1527        if not ActionSts.Success then
1528          begin
1529            InfoBox(ActionSts.Reason, TX_IN_AUTH, MB_OK);
1530            Exit;
1531          end ;
1532        mnuActNoteEditClick(Self);
1533      end
1534    else if NoteIEN = StrToInt(CN_NEW_CP_NOTE) then
1535      begin
1536        // make sure a visit (time & location) is available before creating the note
1537        if Encounter.NeedVisit then
1538        begin
1539          UpdateVisit(Font.Size, DfltTIULocation);
1540          frmFrame.DisplayEncounterText;
1541        end;
1542        if Encounter.NeedVisit then
1543        begin
1544          InfoBox(TX_NEED_VISIT, TX_NO_VISIT, MB_OK or MB_ICONWARNING);
1545          Exit;
1546        end;
1547        SetResultMenus ;
1548        UseClinProcTitles := True;
1549        CompleteConsult(IS_ID_CHILD, 0, UseClinProcTitles);
1550      end
1551    else if NoteIEN = StrToInt(CN_NEW_CSLT_NOTE) then
1552      begin
1553        // make sure a visit (time & location) is available before creating the note
1554        if Encounter.NeedVisit then
1555        begin
1556          UpdateVisit(Font.Size, DfltTIULocation);
1557          frmFrame.DisplayEncounterText;
1558        end;
1559        if Encounter.NeedVisit then
1560        begin
1561          InfoBox(TX_NEED_VISIT, TX_NO_VISIT, MB_OK or MB_ICONWARNING);
1562          Exit;
1563        end;
1564        SetResultMenus ;
1565        UseClinProcTitles := False;
1566        CompleteConsult(IS_ID_CHILD, 0, UseClinProcTitles);
1567      end
1568    else if NoteIEN = -1 then Exit
1569  end;
1570  
1571  //wat cq 17586
1572  procedure TfrmConsults.popNoteMemoViewCsltClick(Sender: TObject);
1573  var
1574    CsltIEN: integer ;
1575    ConsultDetail: TStringList;
1576    x: string;
1577  begin
1578    inherited;
1579    if (Screen.ActiveControl <> memResults) or (FEditNote.PkgPtr <> PKG_CONSULTS) then Exit;
1580    CsltIEN := frmConsults.FEditNote.PkgIEN;
1581    x := FindConsult(CsltIEN);
1582    ConsultDetail := TStringList.Create;
1583    try
1584      LoadConsultDetail(ConsultDetail, CsltIEN) ;
1585      ReportBox(ConsultDetail, 'Consult Details: #' + IntToStr(CsltIEN) + ' - ' + Piece(x, U, 4), TRUE);
1586    finally
1587      ConsultDetail.Free;
1588    end;
1589  end;  //END cq 17586
1590  
1591  procedure TfrmConsults.mnuActAddIDEntryClick(Sender: TObject);
1592  const
1593    IS_ID_CHILD = True;
1594    IS_CLIN_PROC = False;
1595  var
1596    AnIDParent: integer;
1597    //AConsultID: string;
1598  { switches to current new note or creates a new note if none is being edited already }
1599  begin
1600    inherited;
1601  (*  AConsultID := lstConsults.ItemID;*)
1602    AnIDParent := lstNotes.ItemIEN;
1603    if not StartNewEdit(NT_ACT_ID_ENTRY) then Exit;
1604  (*  with tvConsults do Selected := FindPieceNode(AConsultID, 1, U, Items.GetFirstNode);
1605    with tvCsltNotes do Selected := FindPieceNode(IntToStr(AnIDParent), 1, U, Items.GetFirstNode);*)
1606  
1607    // make sure a visit (time & location) is available before creating the note
1608    if Encounter.NeedVisit then
1609    begin
1610      UpdateVisit(Font.Size, DfltTIULocation);
1611      frmFrame.DisplayEncounterText;
1612    end;
1613    if Encounter.NeedVisit then
1614    begin
1615      InfoBox(TX_NEED_VISIT, TX_NO_VISIT, MB_OK or MB_ICONWARNING);
1616      Exit;
1617    end;
1618    CompleteConsult(IS_ID_CHILD, AnIDParent, IS_CLIN_PROC);
1619  end;
1620  
1621  procedure TfrmConsults.mnuActMakeAddendumClick(Sender: TObject);
1622  var
1623    ActionSts: TActionRec;
1624    //ANoteID, AConsultID: string;
1625  begin
1626    inherited;
1627    if lstConsults.ItemIEN = 0  then exit;
1628  (*  // ====== REMOVED IN V14 - superfluous with treeview in v15 ===========
1629    FActionType := TMenuItem(Sender).Tag ;
1630    SelectNoteForProcessing(Font.Size, FActionType, lstNotes.Items, NoteIEN);
1631    if NoteIEN = -1 then exit;
1632    //lstNotes.SelectByIEN(NoteIEN);
1633    with tvCsltNotes do Selected := FindPieceNode(IntToStr(NoteIEN), 1, U, Items.GetFirstNode);
1634    if tvCsltNotes.Selected = nil then exit;
1635    // ========================================*)
1636    if lstNotes.ItemIEN <= 0 then Exit;
1637  (*  AConsultID := lstConsults.ItemID;
1638    ANoteID := lstNotes.ItemID;*)
1639    if lstNotes.ItemIndex = EditingIndex then
1640    begin
1641      InfoBox(TX_ADDEND_NO, TX_ADDEND_MK, MB_OK);
1642      Exit;
1643    end;
1644    if not StartNewEdit(NT_ACT_ADDENDUM) then Exit;
1645  (*  with tvConsults do Selected := FindPieceNode(AConsultID, 1, U, Items.GetFirstNode);
1646    with tvCsltNotes do Selected := FindPieceNode(ANoteID, 1, U, Items.GetFirstNode);*)
1647    ActOnDocument(ActionSts, lstNotes.ItemIEN, 'MAKE ADDENDUM');
1648    if not ActionSts.Success then
1649    begin
1650      InfoBox(ActionSts.Reason, TX_IN_AUTH, MB_OK);
1651      Exit;
1652    end;
1653    with lstNotes do if TitleForNote(ItemIEN) = TYP_ADDENDUM then      //v17.5 RV
1654    //with lstNotes do if Copy(Piece(Items[ItemIndex], U, 2), 1, 8) = 'Addendum' then
1655    begin
1656      InfoBox(TX_ADDEND_AD, TX_ADDEND_MK, MB_OK);
1657      Exit;
1658    end;
1659    SetResultMenus ;
1660    InsertAddendum;
1661  end;
1662  
1663  procedure TfrmConsults.mnuActDetachFromIDParentClick(Sender: TObject);
1664  var
1665    DocID, WhyNot: string;
1666    Saved: boolean;
1667    SavedDocID, SavedConsultID: string;
1668  begin
1669    if lstNotes.ItemIEN = 0 then exit;
1670    SavedDocID := lstNotes.ItemID;
1671    if EditingIndex <> -1 then
1672    begin
1673      SaveCurrentNote(Saved);
1674      if not Saved then Exit;
1675      with tvConsults do Selected := FindPieceNode(SavedConsultID, 1, U, Items.GetFirstNode);
1676      tvConsultsClick(Self);
1677      with tvCsltNotes do Selected := FindPieceNode(SavedDocID, 1, U, Items.GetFirstNode);
1678    end;
1679    if not CanBeAttached(PDocTreeObject(tvCsltNotes.Selected.Data)^.DocID, WhyNot) then
1680      begin
1681        WhyNot := StringReplace(WhyNot, 'ATTACH', 'DETACH', [rfIgnoreCase]);
1682        WhyNot := StringReplace(WhyNot, 'to an ID', 'from an ID', [rfIgnoreCase]);
1683        InfoBox(WhyNot, TX_DETACH_FAILURE, MB_OK);
1684        Exit;
1685      end;
1686    if (InfoBox('DETACH:   ' + tvCsltNotes.Selected.Text + CRLF +  CRLF +
1687                '  FROM:   ' + tvCsltNotes.Selected.Parent.Text + CRLF + CRLF +
1688                'Are you sure?', TX_DETACH_CNF, MB_YESNO or MB_DEFBUTTON2 or MB_ICONQUESTION) <> IDYES)
1689        then Exit;
1690    DocID := PDocTreeObject(tvCsltNotes.Selected.Data)^.DocID;
1691    SavedDocID := PDocTreeObject(tvCsltNotes.Selected.Parent.Data)^.DocID;
1692    if DetachEntryFromParent(DocID, WhyNot) then
1693      begin
1694        tvConsultsChange(Self, tvConsults.Selected);
1695        with tvCsltNotes do Selected := FindPieceNode(SavedDocID, U, Items.GetFirstNode);
1696        if tvCsltNotes.Selected <> nil then tvCsltNotes.Selected.Expand(False);
1697      end
1698    else
1699      begin
1700        WhyNot := StringReplace(WhyNot, 'ATTACH', 'DETACH', [rfIgnoreCase]);
1701        WhyNot := StringReplace(WhyNot, 'to an ID', 'from an ID', [rfIgnoreCase]);
1702        InfoBox(WhyNot, TX_DETACH_FAILURE, MB_OK);
1703      end;
1704  end;
1705  
1706  procedure TfrmConsults.mnuActSignatureListClick(Sender: TObject);
1707  { add the note to the Encounter object, see mnuActSignatureSignClick - copied}
1708  const
1709    SIG_COSIGN = 'COSIGNATURE';
1710    SIG_SIGN   = 'SIGNATURE';
1711  var
1712    ActionType, SignTitle: string;
1713    ActionSts: TActionRec;
1714    ErrMsg: string;
1715  begin
1716    inherited;
1717    if lstNotes.ItemIEN = 0 then Exit;
1718    if lstNotes.ItemIndex = EditingIndex then Exit;  // already in signature list
1719    if LacksClinProcFieldsForSignature(lstNotes.ItemIEN, ErrMsg) then
1720       begin
1721         InfoBox(ErrMsg, TC_CLIN_PROC, MB_OK);
1722         Exit;
1723       end;
1724    if not NoteHasText(lstNotes.ItemIEN) then
1725      begin
1726        InfoBox(TX_EMPTY_NOTE1, TC_EMPTY_NOTE, MB_OK or MB_ICONERROR);
1727        Exit;
1728      end;
1729    if not LastSaveClean(lstNotes.ItemIEN) and
1730      (InfoBox(TX_ABSAVE, TC_ABSAVE, MB_YESNO or MB_DEFBUTTON2 or MB_ICONWARNING) <> IDYES) then Exit;
1731    if CosignDocument(lstNotes.ItemIEN) then
1732    begin
1733      SignTitle := TX_COSIGN;
1734      ActionType := SIG_COSIGN;
1735    end else
1736    begin
1737      SignTitle := TX_SIGN;
1738      ActionType := SIG_SIGN;
1739    end;
1740    ActOnDocument(ActionSts, lstNotes.ItemIEN, ActionType);
1741    if not ActionSts.Success then
1742    begin
1743      InfoBox(ActionSts.Reason, TX_IN_AUTH, MB_OK);
1744      Exit;
1745    end;
1746    LockConsultRequestAndNote(lstNotes.ItemIEN);
1747    with lstNotes do Changes.Add(CH_CON, ItemID, GetTitleText(ItemIndex), '', CH_SIGN_YES);
1748  end;
1749  
1750  
1751  procedure TfrmConsults.mnuActNoteDeleteClick(Sender: TObject);
1752  { delete the selected progress note & remove from the Encounter object if necessary }
1753  var
1754    DeleteSts, ActionSts: TActionRec;
1755    SaveConsult, SavedDocIEN: Integer;
1756    ReasonForDelete, AVisitStr, SavedDocID, x: string;
1757    Saved: boolean;
1758  begin
1759    inherited;
1760    if lstNotes.ItemIEN = 0 then Exit;
1761    ActOnDocument(ActionSts, lstNotes.ItemIEN, 'DELETE RECORD');
1762    if ShowMsgOn(not ActionSts.Success, ActionSts.Reason, TX_IN_AUTH) then Exit;
1763    ReasonForDelete := SelectDeleteReason(lstNotes.ItemIEN);
1764    if ReasonForDelete = DR_CANCEL then Exit;
1765    // suppress prompt for deletion when called from SaveEditedNote (Sender = Self)
1766    if (Sender <> Self) and (InfoBox(MakeNoteDisplayText(lstNotes.Items[lstNotes.ItemIndex]) + TX_DEL_OK,
1767      TX_DEL_CNF, MB_YESNO or MB_DEFBUTTON2 or MB_ICONQUESTION) <> IDYES) then Exit;
1768    // do the appropriate locking
1769    if not LockConsultRequestAndNote(lstNotes.ItemIEN) then Exit;
1770    if JustifyDocumentDelete(lstNotes.ItemIEN) then
1771       InfoBox(TX_RETRACT, TX_RETRACT_CAP, MB_OK);
1772    SavedDocID := lstNotes.ItemID;
1773    SavedDocIEN := lstNotes.ItemIEN;
1774    if (EditingIndex > -1) and (not FConfirmed) and (lstNotes.ItemIndex <> EditingIndex) and (memResults.GetTextLen > 0) then
1775      begin
1776        SaveCurrentNote(Saved);
1777        if not Saved then Exit;
1778      end;
1779    EditingIndex := -1;
1780    FConfirmed := False;
1781    (*  if Saved then
1782      begin
1783        EditingIndex := -1;
1784        mnuViewClick(Self);
1785        with tvCsltNotes do Selected := FindPieceNode(SavedDocID, U, Items.GetFirstNode);
1786     end;*)
1787    // remove the note
1788    DeleteSts.Success := True;
1789    x := GetPackageRefForNote(SavedDocIEN);
1790    SaveConsult := StrToIntDef(Piece(x, ';', 1), 0);
1791    //SaveConsult := GetConsultIENforNote(SavedDocIEN);
1792    AVisitStr := VisitStrForNote(SavedDocIEN);
1793    RemovePCEFromChanges(SavedDocIEN, AVisitStr);
1794    if (SavedDocIEN > 0) and (lstNotes.ItemIEN = SavedDocIEN)then DeleteDocument(DeleteSts, SavedDocIEN, ReasonForDelete);
1795    if not Changes.Exist(CH_CON, SavedDocID) then UnlockDocument(SavedDocIEN);
1796    Changes.Remove(CH_CON, SavedDocID);  // this will unlock the document if in Changes
1797    UnlockConsultRequest(0, SaveConsult);     // note has been deleted, so 1st param = 0
1798    // reset the display now that the note is gone
1799    if DeleteSts.Success then
1800    begin
1801      DeletePCE(AVisitStr);  // removes PCE data if this was the only note pointing to it
1802      ClearEditControls;
1803      //ClearPtData;   WRONG - fixed in v15.10 - RV
1804      cmdNewConsult.Visible := True;
1805      cmdNewProc.Top := cmdNewConsult.Top + cmdNewConsult.Height;
1806      cmdNewProc.Visible := True;
1807      pnlConsultList.Height := (pnlLeft.Height div 2);
1808  (*    uChanging := True;
1809      with tvNotes do Selected := FindPieceNode(SavedDocID, U, Items.GetFirstNode);
1810      uChanging := False;
1811      if tvCsltNotes.Selected <> nil then tvCsltNotesChange(Self, tvCsltNotes.Selected) else
1812      begin*)
1813        pnlResults.Visible := False;
1814        pnlResults.SendToBack;
1815        pnlRead.Visible := True;
1816        pnlRead.BringToFront ;
1817        memConsult.TabStop := True;
1818        UpdateReminderFinish;
1819        ShowPCEControls(False);
1820        frmDrawers.DisplayDrawers(FALSE);
1821        cmdPCE.Visible := FALSE;
1822        popNoteMemoEncounter.Visible := FALSE;
1823        UpdateList;
1824        pnlConsultList.Enabled := True; //CQ#15785
1825  //      lstConsults.Enabled := True ;
1826  //      tvConsults.Enabled := True;
1827        with tvConsults do Selected := FindPieceNode(IntToStr(SaveConsult), 1, U, Items.GetFirstNode);
1828        tvConsultsClick(Self);
1829  (*      lstConsults.SelectByIEN(ConsultRec.IEN);
1830        if lstConsults.ItemIEN > 0 then
1831          lstConsultsClick(Self) ;*)
1832        lstNotes.Enabled := True;
1833  (*      uChanging := True;
1834        with tvNotes do Selected := FindPieceNode(SavedDocID, U, Items.GetFirstNode);
1835        uChanging := False;
1836        if tvCsltNotes.Selected <> nil then tvCsltNotesChange(Self, tvCsltNotes.Selected);
1837      end; {if ItemIndex}*)
1838    end {if DeleteSts}
1839    else InfoBox(DeleteSts.Reason, TX_DEL_ERR, MB_OK or MB_ICONWARNING);
1840  end;
1841  
1842  procedure TfrmConsults.mnuActNoteEditClick(Sender: TObject);
1843  { load the selected progress note for editing }
1844  var
1845    ActionSts: TActionRec;
1846    //AConsultID, ANoteID: string;
1847  begin
1848    inherited;
1849    if lstNotes.ItemIndex = EditingIndex then Exit;
1850  (*  AConsultID := lstConsults.ItemID;
1851    ANoteID := lstNotes.ItemID;*)
1852    if not StartNewEdit(NT_ACT_EDIT_NOTE) then Exit;
1853  (*  with tvConsults do Selected := FindPieceNode(AConsultID, 1, U, Items.GetFirstNode);
1854    with tvCsltNotes do Selected := FindPieceNode(ANoteID, 1, U, Items.GetFirstNode);*)
1855    ActOnDocument(ActionSts, lstNotes.ItemIEN, 'EDIT RECORD');
1856    if not ActionSts.Success then
1857    begin
1858      InfoBox(ActionSts.Reason, TX_IN_AUTH, MB_OK);
1859      Exit;
1860    end;
1861    LoadForEdit;
1862  end;
1863  
1864  procedure TfrmConsults.mnuActSignatureSaveClick(Sender: TObject);
1865  { saves the Consult that is currently being edited }
1866  var
1867    Saved: Boolean;
1868  //  i: integer;
1869    SavedDocID, SavedCsltID, x: string;
1870    tmpNode: TORTreeNode;
1871  begin
1872    inherited;
1873    if EditingIndex > -1 then
1874      begin
1875        SavedDocID := Piece(lstNotes.Items[EditingIndex], U, 1);
1876        FLastNoteID := SavedDocID;
1877        SavedCsltID := lstConsults.ItemID;
1878        SaveCurrentNote(Saved) ;
1879        if Saved and (EditingIndex < 0) and (not FDeleted) then
1880        //if Saved then
1881          begin
1882            pnlResults.Visible := False;
1883            pnlResults.SendToBack;
1884            pnlConsultList.Enabled := True; //CQ#15785
1885  //          lstConsults.Enabled := True;
1886  //          tvConsults.Enabled := True;
1887            if Notifications.Active then
1888              with tvConsults do
1889                begin
1890                  uChanging := True;
1891                  Selected := FindPieceNode(SavedCsltID, 1, U, Items.GetFirstNode);
1892                  if Selected <> nil then Selected.Delete;
1893                  x := FindConsult(StrToIntDef(SavedCsltID, 0));
1894                  tmpNode := TORTreeNode(Items.AddChildFirst(Items.GetFirstNode, MakeConsultListDisplayText(x)));
1895                  tmpNode.StringData := x;
1896                  SetNodeImage(tmpNode, FCurrentContext);
1897                  uChanging := False;
1898                  Selected := tmpNode;
1899                  tvConsultsClick(Self);
1900                end
1901            else
1902              begin
1903                UpdateList ;  {update consult list after success}
1904                with tvConsults do Selected := FindPieceNode(SavedCsltID, U, Items.GetFirstNode);
1905                tvConsultsClick(Self);
1906                with tvCsltNotes do Selected := FindPieceNode(SavedDocID, U, Items.GetFirstNode);
1907              end;
1908            pnlLeft.Refresh ;
1909          end;
1910      end
1911    else InfoBox(TX_NO_CONSULT, TX_SAVE_CONSULT, MB_OK or MB_ICONWARNING);
1912    if frmFrame.TimedOut then Exit;
1913    with tvCsltNotes do Selected := FindPieceNode(SavedDocID, U, Items.GetFirstNode);
1914  end;
1915  
1916  procedure TfrmConsults.mnuActSignatureSignClick(Sender: TObject);
1917  { sign the currently selected note, save first if necessary }
1918  const
1919    SIG_COSIGN = 'COSIGNATURE';
1920    SIG_SIGN   = 'SIGNATURE';
1921  var
1922    Saved, NoteUnlocked: Boolean;
1923    ActionType, ESCode, SignTitle, x: string;
1924    ActionSts, SignSts: TActionRec;
1925    OK: boolean;
1926    tmpNode: TORTreeNode;
1927    SavedDocID, SavedCsltID, tmpItem, ErrMsg: string;
1928    EditingID: string;                                         //v22.12 - RV
1929  begin
1930    inherited;
1931  (*  if lstNotes.ItemIndex = EditingIndex then
1932    begin
1933      SaveCurrentNote(Saved);
1934      if (not Saved) or FDeleted then Exit;
1935    end
1936    else if EditingIndex > -1 then
1937      tmpItem := lstNotes.Items[EditingIndex];
1938    SavedDocID := lstNotes.ItemID;*)
1939    SavedCsltID := lstConsults.ItemID;
1940    SavedDocID := lstNotes.ItemID;                             //v22.12 - RV
1941    FLastNoteID := SavedDocID;                                 //v22.12 - RV
1942    if lstNotes.ItemIndex = EditingIndex then                  //v22.12 - RV
1943    begin                                                      //v22.12 - RV
1944      SaveCurrentNote(Saved);                                  //v22.12 - RV
1945      if (not Saved) or FDeleted then Exit;                    //v22.12 - RV
1946    end                                                        //v22.12 - RV
1947    else if EditingIndex > -1 then                             //v22.12 - RV
1948    begin                                                      //v22.12 - RV
1949      tmpItem := lstNotes.Items[EditingIndex];                 //v22.12 - RV
1950      EditingID := Piece(tmpItem, U, 1);                       //v22.12 - RV
1951    end;                                                       //v22.12 - RV
1952    if LacksClinProcFieldsForSignature(lstNotes.ItemIEN, ErrMsg) then
1953       begin
1954         InfoBox(ErrMsg, TC_CLIN_PROC, MB_OK);
1955         Exit;
1956       end;
1957    if not NoteHasText(lstNotes.ItemIEN) then
1958      begin
1959        InfoBox(TX_EMPTY_NOTE1, TC_EMPTY_NOTE, MB_OK or MB_ICONERROR);
1960        Exit;
1961      end;
1962    if not LastSaveClean(lstNotes.ItemIEN) and
1963      (InfoBox(TX_ABSAVE, TC_ABSAVE, MB_YESNO or MB_DEFBUTTON2 or MB_ICONWARNING) <> IDYES) then Exit;
1964    if CosignDocument(lstNotes.ItemIEN) then
1965    begin
1966      SignTitle := TX_COSIGN;
1967      ActionType := SIG_COSIGN;
1968    end else
1969    begin
1970      SignTitle := TX_SIGN;
1971      ActionType := SIG_SIGN;
1972    end;
1973    if not LockConsultRequestAndNote(lstNotes.ItemIEN) then Exit;
1974    // no exits after things are locked
1975    NoteUnlocked := False;
1976    ActOnDocument(ActionSts, lstNotes.ItemIEN, ActionType);
1977    if ActionSts.Success then
1978    begin
1979      OK := IsOK2Sign(uPCEShow, lstNotes.ItemIEN);
1980      if frmFrame.Closing then exit;
1981      if(uPCEShow.Updated) then
1982      begin
1983        uPCEShow.CopyPCEData(uPCEEdit);
1984        uPCEShow.Updated := FALSE;
1985        lstNotesClick(Self); 
1986      end;
1987      if not AuthorSignedDocument(lstNotes.ItemIEN) then
1988      begin
1989        if (InfoBox(TX_AUTH_SIGNED +
1990            GetTitleText(lstNotes.ItemIndex),TX_SIGN ,MB_YESNO)= ID_NO) then exit;
1991      end;
1992      if(OK) then
1993      begin
1994        with lstNotes do SignatureForItem(Font.Size, MakeConsultNoteDisplayText(Items[ItemIndex]), SignTitle, ESCode);
1995        if Length(ESCode) > 0 then
1996        begin
1997          SignDocument(SignSts, lstNotes.ItemIEN, ESCode);
1998          RemovePCEFromChanges(lstNotes.ItemIEN);
1999          NoteUnlocked := Changes.Exist(CH_CON, lstNotes.ItemID);
2000          Changes.Remove(CH_CON, lstNotes.ItemID);  // this will unlock if in Changes
2001          if SignSts.Success then
2002          begin
2003            pnlResults.Visible := False;
2004            pnlResults.SendToBack;
2005            pnlConsultList.Enabled := True; //CQ#15785
2006  //          lstConsults.Enabled := True;
2007  //          tvConsults.Enabled := True;
2008            if Notifications.Active then
2009              with tvConsults do
2010                begin
2011                  uChanging := True;
2012                  Selected := FindPieceNode(SavedCsltID, 1, U, Items.GetFirstNode);
2013                  if Selected <> nil then Selected.Delete;
2014                  x := FindConsult(StrToIntDef(SavedCsltID, 0));
2015                  tmpNode := TORTreeNode(Items.AddChildFirst(Items.GetFirstNode, MakeConsultListDisplayText(x)));
2016                  tmpNode.StringData := x;
2017                  SetNodeImage(tmpNode, FCurrentContext);
2018                  uChanging := False;
2019                  Selected := tmpNode;
2020                  //tvConsultsClick(Self);
2021                end
2022            else
2023              begin
2024                UpdateList ;  {update consult list after success}
2025                with tvConsults do Selected := FindPieceNode(SavedCsltID, U, Items.GetFirstNode);
2026                //tvConsultsClick(Self);
2027                //with tvCsltNotes do Selected := FindPieceNode(SavedDocID, U, Items.GetFirstNode);
2028              end;
2029          end
2030          else InfoBox(SignSts.Reason, TX_SIGN_ERR, MB_OK);
2031        end {if Length(ESCode)}
2032        else
2033          NoteUnlocked := Changes.Exist(CH_CON, lstNotes.ItemID);
2034      end;
2035    end
2036    else InfoBox(ActionSts.Reason, TX_IN_AUTH, MB_OK);
2037    if not NoteUnlocked then UnlockDocument(lstNotes.ItemIEN);
2038    UnlockConsultRequest(lstNotes.ItemIEN, StrToIntDef(SavedCsltID, 0));  // v20.4  RV (unlocking problem)
2039    //UnlockConsultRequest(lstNotes.ItemIEN, ConsultRec.IEN);
2040    tvConsultsClick(Self);
2041    //if EditingIndex > -1 then         //v22.12 - RV
2042    if (EditingID <> '') then           //v22.12 - RV
2043      begin
2044        lstNotes.Items.Insert(0, tmpItem);
2045        tmpNode := TORTreeNode(tvCsltNotes.Items.AddObjectFirst(tvCsltNotes.Items.GetFirstNode, 'Note being edited',
2046                   MakeNoteTreeObject('EDIT^Note being edited^^^^^^^^^^^%^0')));
2047        tmpNode.StringData := 'EDIT^Note being edited^^^^^^^^^^^%^0';
2048        tmpNode.ImageIndex := IMG_TOP_LEVEL;
2049        tmpNode := TORTreeNode(tvCsltNotes.Items.AddChildObjectFirst(tmpNode, MakeConsultNoteDisplayText(tmpItem),
2050                   MakeConsultsNoteTreeObject(tmpItem)));
2051        tmpNode.StringData := tmpItem;
2052        SetTreeNodeImagesAndFormatting(TORTreeNode(tmpNode), FCurrentNoteContext, CT_CONSULTS);
2053        EditingIndex := lstNotes.SelectByID(EditingID);                 //v22.12 - RV
2054      end;
2055    //with tvCsltNotes do Selected := FindPieceNode(SavedDocID, U, Items.GetFirstNode);  //v22.12 - RV
2056    with tvCsltNotes do                                                                  //v22.12 - RV
2057    begin                                                                                //v22.12 - RV
2058      Selected := FindPieceNode(FLastNoteID, U, Items.GetFirstNode);                     //v22.12 - RV
2059      if Selected <> nil then tvCsltNotesChange(Self, Selected);                         //v22.12 - RV
2060    end;
2061  end;
2062  
2063  procedure TfrmConsults.SaveSignItem(const ItemID, ESCode: string);
2064  { saves and optionally signs a progress note or addendum }
2065  const
2066    SIG_COSIGN = 'COSIGNATURE';
2067    SIG_SIGN   = 'SIGNATURE';
2068  var
2069    AnIndex, IEN, i: Integer;
2070    Saved, ContinueSign: Boolean;  {*RAB* 8/26/99}
2071    ActionSts, SignSts: TActionRec;
2072    APCEObject: TPCEData;
2073    OK: boolean;
2074    SavedCsltID, x: string;
2075    tmpNode: TORTreeNode;
2076    ErrMsg: string;
2077    ActionType, SignTitle: string;
2078  begin
2079    AnIndex := -1;
2080    IEN := StrToIntDef(ItemID, 0);
2081    if IEN = 0 then Exit;
2082    x := GetPackageRefForNote(IEN);
2083    SavedCsltID := Piece(x, ';', 1);
2084    //SavedCsltID := IntToStr(GetConsultIENForNote(IEN));
2085    if frmFrame.TimedOut and (EditingIndex <> -1) then FSilent := True;
2086    with lstNotes do for i := 0 to Items.Count - 1 do if lstNotes.GetIEN(i) = IEN then
2087    begin
2088      AnIndex := i;
2089      break;
2090    end;
2091    if (AnIndex > -1) and (AnIndex = EditingIndex) then
2092    begin
2093      SaveCurrentNote(Saved);
2094      if not Saved then Exit;
2095      if FDeleted then
2096        begin
2097          FDeleted := False;
2098          Exit;
2099        end;
2100      AnIndex := lstNotes.SelectByIEN(IEN);
2101      //IEN := lstNotes.GetIEN(AnIndex);                    // saving will change IEN
2102    end;
2103    if Length(ESCode) > 0 then
2104    begin
2105      if CosignDocument(IEN) then
2106      begin
2107        SignTitle := TX_COSIGN;
2108        ActionType := SIG_COSIGN;
2109      end else
2110      begin
2111        SignTitle := TX_SIGN;
2112        ActionType := SIG_SIGN;
2113      end;
2114      ActOnDocument(ActionSts, IEN, ActionType);
2115      if not ActionSts.Success then
2116        begin
2117          InfoBox(ActionSts.Reason, TX_IN_AUTH, MB_OK);
2118          ContinueSign := False;
2119        end
2120      else if LacksClinProcFieldsForSignature(IEN, ErrMsg) then
2121        begin
2122         InfoBox(ErrMsg, TC_CLIN_PROC, MB_OK);
2123         ContinueSign := False;
2124        end
2125      else if not NoteHasText(IEN) then
2126        begin
2127          InfoBox(TX_EMPTY_NOTE1, TC_EMPTY_NOTE, MB_OK or MB_ICONERROR);
2128          ContinueSign := False;
2129        end
2130      else if not LastSaveClean(IEN) and
2131        (InfoBox(TX_ABSAVE, TC_ABSAVE, MB_YESNO or MB_DEFBUTTON2 or MB_ICONWARNING) <> IDYES)
2132         then ContinueSign := False
2133      else ContinueSign := True;
2134      if ContinueSign then
2135      begin
2136        if (AnIndex >= 0) and (AnIndex = lstNotes.ItemIndex) then
2137          APCEObject := uPCEShow
2138        else
2139          APCEObject := nil;
2140        OK := IsOK2Sign(APCEObject, IEN);
2141        if frmFrame.Closing then exit;
2142        if(assigned(APCEObject)) and (uPCEShow.Updated) then
2143        begin
2144          uPCEShow.CopyPCEData(uPCEEdit);
2145          uPCEShow.Updated := FALSE;
2146          lstNotesClick(Self);
2147        end
2148        else
2149          uPCEEdit.Clear;
2150        if(OK) then
2151        begin
2152          SignDocument(SignSts, IEN, ESCode);
2153          if not SignSts.Success then InfoBox(SignSts.Reason, TX_SIGN_ERR, MB_OK);
2154        end; {if OK}
2155      end; {if ContinueSign}
2156    end; {if Length(ESCode)}
2157  
2158    UnlockConsultRequest(IEN);
2159    UnlockDocument(IEN);
2160    if (AnIndex = lstNotes.ItemIndex) and (not frmFrame.ContextChanging) then lstNotesClick(Self);
2161    if Notifications.Active then
2162      with tvConsults do
2163        begin
2164          if (AnIndex = lstNotes.ItemIndex) and (not frmFrame.ContextChanging) then lstNotesClick(Self);
2165          uChanging := True;
2166          Selected := FindPieceNode(SavedCsltID, 1, U, Items.GetFirstNode);
2167          if Selected <> nil then Selected.Delete;
2168          x := FindConsult(StrToIntDef(SavedCsltID, 0));
2169          tmpNode := TORTreeNode(Items.AddChildFirst(Items.GetFirstNode, MakeConsultListDisplayText(x)));
2170          tmpNode.StringData := x;
2171          SetNodeImage(tmpNode, FCurrentContext);
2172          uChanging := False;
2173          Selected := tmpNode;
2174          tvConsultsClick(Self);
2175        end
2176    else
2177      begin
2178        UpdateList ;  {update consult list after success}
2179        if (AnIndex = lstNotes.ItemIndex) and (not frmFrame.ContextChanging) then lstNotesClick(Self);
2180        with tvConsults do Selected := FindPieceNode(SavedCsltID, U, Items.GetFirstNode);
2181        tvConsultsClick(Self);
2182        with tvCsltNotes do Selected := FindPieceNode(IntToStr(IEN), U, Items.GetFirstNode);
2183      end;
2184    pnlLeft.Refresh ;
2185  end ;
2186  
2187  procedure TfrmConsults.cmdPCEClick(Sender: TObject);
2188  begin
2189    inherited;
2190    cmdPCE.Enabled := False;
2191    UpdatePCE(uPCEEdit);
2192    cmdPCE.Enabled := True;
2193    if frmFrame.Closing then exit;
2194    DisplayPCE;
2195  end;
2196  
2197  procedure TfrmConsults.mnuActConsultClick(Sender: TObject);
2198  var
2199  //  i:integer ;
2200    Saved, IsProcedure: boolean;
2201    SavedCsltID, x: string;
2202    tmpNode: TORTreeNode;
2203  begin
2204    inherited;
2205    if lstConsults.ItemIEN = 0  then exit;
2206    SavedCsltID := lstConsults.ItemID;
2207    if EditingIndex <> -1 then
2208    begin
2209      SaveCurrentNote(Saved);
2210      if not Saved then Exit;
2211    end;
2212    FOrderID := Piece(lstConsults.Items[lstConsults.ItemIndex], U, 6);
2213    if not LockConsultRequest(lstConsults.ItemIEN) then Exit;
2214    FActionType := TMenuItem(Sender).Tag ;
2215    ClearEditControls ;
2216    lstNotes.Enabled := False ;
2217    pnlConsultList.Enabled := False; //CQ#15785
2218  //  lstConsults.Enabled  := False ;
2219  //  tvConsults.Enabled := False;
2220    x := Piece(lstConsults.Items[lstConsults.ItemIndex], U, 12);
2221    if x <> '' then
2222      IsProcedure := (x[1] in ['P', 'M'])
2223    else
2224      IsProcedure := (Piece(lstConsults.Items[lstConsults.ItemIndex], U, 9) = 'Procedure');
2225    //if SetActionContext(Font.Size,FActionType, IsProcedure, ConsultRec.ConsultProcedure) then
2226     if SetActionContext(Font.Size,FActionType, IsProcedure, ConsultRec.ConsultProcedure, MenuAccessRec.UserLevel) then
2227      begin
2228        if Notifications.Active then
2229          with tvConsults do
2230            begin
2231              uChanging := True;
2232              Selected := FindPieceNode(SavedCsltID, 1, U, Items.GetFirstNode);
2233              if Selected <> nil then Selected.Delete;
2234              x := FindConsult(StrToIntDef(SavedCsltID, 0));
2235              tmpNode := TORTreeNode(Items.AddChildFirst(Items.GetFirstNode, MakeConsultListDisplayText(x)));
2236              tmpNode.StringData := x;
2237              SetNodeImage(tmpNode, FCurrentContext);
2238              uChanging := False;
2239              Selected := tmpNode;
2240              tvConsultsClick(Self);
2241            end
2242  (*        with tvConsults do
2243            begin
2244              Selected := FindPieceNode(IntToStr(ConsultRec.IEN), 1, U, Items.GetFirstNode);
2245              if Selected <> nil then Selected.Delete;
2246              Items.AddFirst(nil, FindConsult(ConsultRec.IEN));
2247              Selected := FindPieceNode(IntToStr(ConsultRec.IEN), 1, U, Items.GetFirstNode);
2248            end*)
2249        else
2250          begin
2251            UpdateList ;  {update consult list after success}
2252            with tvConsults do Selected := FindPieceNode(SavedCsltID, U, Items.GetFirstNode);
2253            tvConsultsClick(Self);
2254          end;
2255      end;
2256    UnlockConsultRequest(lstNotes.ItemIEN, StrToIntDef(SavedCsltID, 0));  // v20.4  RV (unlocking problem)
2257    //UnlockConsultRequest(lstNotes.ItemIEN, lstConsults.ItemIEN);
2258    lstNotes.Enabled := True ;
2259    pnlConsultList.Enabled := True; //CQ#15785
2260  //  lstConsults.Enabled := True ;
2261  //  tvConsults.Enabled := True;
2262  end;
2263  
2264  procedure TfrmConsults.UpdateList;
2265  begin
2266       { call this after performing some action on a consult that changes its status
2267         or its service  }
2268    case ViewContext of
2269      CC_ALL       : begin
2270                       FillChar(FCurrentContext, SizeOf(FCurrentContext), 0);
2271                       lblConsults.Caption := 'All Consults' ;
2272                       FCurrentContext.Ascending := False;
2273                     end;
2274      CC_BY_STATUS : begin
2275                       with StsCtxt do if Changed then
2276                         begin
2277                           FillChar(FCurrentContext, SizeOf(FCurrentContext), 0);
2278                           lblConsults.Caption := 'All ' + StatusName + ' Consults';
2279                           FCurrentContext.Status := Status;
2280                           FCurrentContext.Ascending := Ascending;
2281                         end;
2282                     end;
2283      CC_BY_SERVICE : begin
2284                        with SvcCtxt do if Changed then
2285                          begin
2286                            FillChar(FCurrentContext, SizeOf(FCurrentContext), 0);
2287                            lblConsults.Caption := 'Consults to ' + ServiceName;
2288                            FCurrentContext.Service := Service;
2289                            FCurrentContext.Ascending := Ascending;
2290                          end;
2291                      end;
2292       CC_BY_DATE   : begin
2293                       with DateRange do if Changed then
2294                         begin
2295                          FillChar(FCurrentContext, SizeOf(FCurrentContext), 0);
2296                          lblConsults.Caption := FormatFMDateTime('mmm dd,yy', StrToFMDateTime(BeginDate)) + ' to ' +
2297                                                 FormatFMDateTime('mmm dd,yy', StrToFMDateTime(EndDate));
2298                          FCurrentContext.BeginDate := BeginDate;
2299                          FCurrentContext.EndDate   := EndDate;
2300                          FCurrentContext.Ascending := Ascending;
2301                         end;
2302                      end;
2303       CC_CUSTOM    : begin
2304                        with uSelectContext do if Changed then
2305                          begin
2306                            FillChar(FCurrentContext, SizeOf(FCurrentContext), 0);
2307                            with lblConsults do if Caption <> 'Default List' then Caption := 'Custom List' ;
2308                            FCurrentContext.BeginDate := BeginDate;
2309                            FCurrentContext.EndDate   := EndDate;
2310                            FCurrentContext.Status := Status;
2311                            FCurrentContext.Service := Service;
2312                            FCurrentContext.GroupBy := GroupBy;
2313                            FCurrentContext.Ascending := Ascending;
2314                          end ;
2315                        end ;
2316     end; {case}
2317     tvConsults.Caption := lblConsults.Caption;
2318     if not frmFrame.ContextChanging then LoadConsults;
2319  end ;
2320  
2321  procedure TfrmConsults.SetActionMenus ;
2322  {Set available menu actions based on consult status and user access to consult's service}
2323  var
2324     status: integer ;
2325  begin
2326  
2327       FillChar(MenuAccessRec, SizeOf(MenuAccessRec), 0);
2328       if (lstConsults.ItemIndex < 0) then
2329        begin
2330          mnuAct.Enabled := False ;
2331          exit ;
2332        end
2333       else
2334        begin
2335         MenuAccessRec  := GetActionMenuLevel(ConsultRec.IEN) ;
2336         status  := ConsultRec.ORStatus ;
2337        end ;
2338  
2339  
2340       with MenuAccessRec do
2341         begin
2342            //     mnuAct.Enabled := (UserLevel > 1) ;    {'User Review'    menu level = 1 }
2343                                               {'Service Action' menu level = 2 }
2344  
2345           mnuActConsultRequest.Enabled :=  (lstConsults.ItemIEN > 0);
2346           mnuActReceive.Enabled        :=  (UserLevel > UL_REVIEW)
2347                                                            and (status=ST_PENDING);
2348           mnuActSchedule.Enabled       :=  (UserLevel > UL_REVIEW)
2349                                                            and ((status=ST_PENDING)
2350                                                            or   (status=ST_ACTIVE));
2351           mnuActDeny.Enabled           :=  (UserLevel > UL_REVIEW)
2352                                                            and ((status<>ST_DISCONTINUED)
2353                                                            and (status<>ST_COMPLETE)
2354                                                            and (status<>ST_CANCELLED)
2355                                                            and (status<>ST_PARTIAL_RESULTS))   ;
2356  (*         mnuActEditResubmit.Enabled   :=  {(UserLevel > 1) and }(Notifications.Active)
2357              {if the user received the alert,}          and (lstConsults.ItemIEN = CurrNotifIEN)
2358              { this menu should be available }          and (status = ST_CANCELLED)
2359                                                         and (not User.NoOrdering);*)
2360          {if processing an alert - NO CHANGE HERE}
2361           if Notifications.Active and (lstConsults.ItemIEN = CurrNotifIEN) then
2362             mnuActEditResubmit.Enabled := (*(lstConsults.ItemIEN = CurrNotifIEN) and*)
2363                                           (status = ST_CANCELLED) and
2364                                           (not User.NoOrdering)
2365          {if not processing an alert, check other stuff}
2366           else
2367             mnuActEditResubmit.Enabled :=  AllowResubmit and
2368                                            (status = ST_CANCELLED) and
2369                                            (not User.NoOrdering);
2370           mnuActForward.Enabled        :=  (UserLevel > UL_REVIEW)
2371                                                         and ((status<>ST_DISCONTINUED)
2372                                                         and (status<>ST_COMPLETE)
2373                                                         and (status<>ST_CANCELLED))   ;
2374           mnuActDiscontinue.Enabled    :=  (UserLevel > UL_REVIEW)
2375                                                         and ((status<>ST_DISCONTINUED)
2376                                                         and (status<>ST_COMPLETE)
2377                                                         and (status<>ST_CANCELLED)
2378                                                         and (status<>ST_PARTIAL_RESULTS))   ;
2379           mnuActSigFindings.Enabled    :=  (UserLevel > UL_REVIEW)
2380                                                         and ((status<>ST_DISCONTINUED)
2381                                                         and (status<>ST_CANCELLED));
2382           mnuActAdminComplete.Enabled  :=  ((UserLevel = UL_ADMIN) or (UserLevel = UL_UPDATE_AND_ADMIN))
2383                                                         and ((status<>ST_DISCONTINUED)
2384                                                         and (status<>ST_COMPLETE)
2385                                                         and (status<>ST_CANCELLED));
2386  
2387           mnuActAddComment.Enabled     :=  True;
2388           mnuActDisplayDetails.Enabled :=  True;
2389           mnuActDisplayResults.Enabled :=  True;
2390           mnuActDisplaySF513.Enabled   :=  True;
2391           mnuActPrintSF513.Enabled     :=  True;
2392           mnuActConsultResults.Enabled :=  (lstConsults.ItemIEN > 0) and
2393                                            (((UserLevel = UL_UPDATE) or (UserLevel = UL_UPDATE_AND_ADMIN) or (UserLevel = UL_UNRESTRICTED)) and
2394                                            ((status<>ST_DISCONTINUED) and
2395                                             (status<>ST_CANCELLED)))
2396                                            or
2397                                             (lstConsults.ItemIEN > 0) and
2398                                            ((AllowMedResulting) and
2399                                            ((status<>ST_DISCONTINUED) and
2400                                             (status<>ST_CANCELLED)))
2401                                            or
2402                                             (lstConsults.ItemIEN > 0) and
2403                                            ((AllowMedDissociate) and
2404                                            ((status = ST_COMPLETE)))
2405                                            or
2406                                             ((Notifications.Active) and
2407                                             (lstConsults.ItemIEN = CurrNotifIEN) and
2408                                             (Notifications.FollowUp = NF_CONSULT_UNSIGNED_NOTE) and
2409                                             (lstNotes.ItemIndex > -1));
2410           cmdEditResubmit.Visible      :=  mnuActEditResubmit.Enabled;
2411         end;
2412  end ;
2413  
2414  procedure TfrmConsults.SetResultMenus ;
2415  var
2416    WhyNot: string;
2417  begin
2418    mnuActComplete.Enabled           :=   mnuActConsultResults.Enabled and
2419                                          ((MenuAccessRec.UserLevel = UL_UPDATE) or
2420                                          (MenuAccessRec.UserLevel = UL_UPDATE_AND_ADMIN) or
2421                                          (MenuAccessRec.UserLevel = UL_UNRESTRICTED))
2422                                          and
2423                                         ((ConsultRec.ORStatus=ST_PENDING) or
2424                                         (ConsultRec.ORStatus=ST_ACTIVE) or
2425                                         (ConsultRec.ORStatus=ST_SCHEDULED) or
2426                                         (ConsultRec.ORStatus=ST_PARTIAL_RESULTS) or
2427                                         (ConsultRec.ORStatus=ST_COMPLETE))   ;
2428    mnuActMakeAddendum.Enabled       :=  mnuActConsultResults.Enabled and
2429                                          ((MenuAccessRec.UserLevel = UL_UPDATE) or
2430                                          (MenuAccessRec.UserLevel = UL_UPDATE_AND_ADMIN) or
2431                                          (MenuAccessRec.UserLevel = UL_UNRESTRICTED))
2432                                          and
2433                                         ((lstNotes.ItemIndex > -1) and
2434                                         ((ConsultRec.TIUResultNarrative>0) or
2435                                         (lstNotes.ItemIEN > 0)));
2436    mnuActAddIDEntry.Enabled         :=   mnuActConsultResults.Enabled and
2437                                          uIDNotesActive and
2438                                          (tvCsltNotes.Selected <> nil) and
2439                                          (tvCsltNotes.Selected.ImageIndex in [IMG_SINGLE, IMG_PARENT,
2440                                          IMG_IDNOTE_OPEN, IMG_IDNOTE_SHUT, IMG_IDPAR_ADDENDA_OPEN,
2441                                          IMG_IDPAR_ADDENDA_SHUT]) and
2442                                          CanReceiveAttachment(PDocTreeObject(tvCsltNotes.Selected.Data)^.DocID, WhyNot);
2443    mnuActDetachFromIDParent.Enabled :=   mnuActConsultResults.Enabled and
2444                                          uIDNotesActive and
2445                                          (tvCsltNotes.Selected <> nil) and
2446                                          (tvCsltNotes.Selected.ImageIndex in [IMG_ID_CHILD, IMG_ID_CHILD_ADD]);
2447    mnuActAttachMed.Enabled          :=   mnuActConsultResults.Enabled and
2448                                          (((mnuActComplete.Enabled) or
2449                                          (MenuAccessRec.UserLevel = UL_ADMIN) or
2450                                          (MenuAccessRec.UserLevel = UL_UPDATE_AND_ADMIN)))
2451                                           and (MenuAccessRec.AllowMedResulting);
2452    mnuActRemoveMed.Enabled          :=   mnuActConsultResults.Enabled and
2453                                          ((ConsultRec.ORStatus=ST_COMPLETE) and (MenuAccessRec.AllowMedDissociate));
2454    mnuActNoteEdit.Enabled           :=   mnuActConsultResults.Enabled and
2455                                          ((lstNotes.ItemIndex > -1) and
2456                                          ((ConsultRec.TIUResultNarrative>0) or
2457                                          (lstNotes.ItemIEN > 0) or
2458                                          (FActionType = CN_ACT_COMPLETE) or
2459                                          (FActionType = CN_ACT_ADDENDUM)));
2460    mnuActNoteDelete.Enabled         :=   mnuActConsultResults.Enabled and
2461                                          ((lstNotes.ItemIndex > -1) and
2462                                          ((ConsultRec.TIUResultNarrative>0) or
2463                                          (lstNotes.ItemIEN > 0) or
2464                                          (FActionType = CN_ACT_COMPLETE) or
2465                                          (FActionType = CN_ACT_ADDENDUM)));
2466    mnuActSignatureSign.Enabled      :=   mnuActConsultResults.Enabled and
2467                                          ((lstNotes.ItemIndex > -1) and
2468                                          ((ConsultRec.TIUResultNarrative>0) or
2469                                          (lstNotes.ItemIEN > 0) or
2470                                          (FActionType = CN_ACT_COMPLETE) or
2471                                          (FActionType = CN_ACT_ADDENDUM)))
2472                                          or
2473                                          ((Notifications.Active) and
2474                                          (lstConsults.ItemIEN = CurrNotifIEN) and
2475                                          (Notifications.FollowUp = NF_CONSULT_UNSIGNED_NOTE) and
2476                                          (lstNotes.ItemIndex > -1));
2477    mnuActSignatureList.Enabled      :=   mnuActConsultResults.Enabled and
2478                                          ((lstNotes.ItemIndex > -1) and
2479                                          ((ConsultRec.TIUResultNarrative>0) or
2480                                          (lstNotes.ItemIEN > 0) or
2481                                          (FActionType = CN_ACT_COMPLETE) or
2482                                          (FActionType = CN_ACT_ADDENDUM)))
2483                                          or
2484                                          ((Notifications.Active) and
2485                                          (lstConsults.ItemIEN = CurrNotifIEN) and
2486                                          (Notifications.FollowUp = NF_CONSULT_UNSIGNED_NOTE) and
2487                                          (lstNotes.ItemIndex > -1));
2488    mnuActSignatureSave.Enabled      :=   mnuActConsultResults.Enabled and
2489                                          ((lstNotes.ItemIndex > -1) and
2490                                          ((ConsultRec.TIUResultNarrative>0) or
2491                                          (lstNotes.ItemIEN > 0) or
2492                                          (FActionType = CN_ACT_COMPLETE) or
2493                                          (FActionType = CN_ACT_ADDENDUM)));
2494    mnuActIdentifyAddlSigners.Enabled :=  mnuActConsultResults.Enabled and
2495                                          ((lstNotes.ItemIndex > -1) and
2496                                          ((ConsultRec.TIUResultNarrative>0) or
2497                                          (lstNotes.ItemIEN > 0)));
2498    mnuActNotePrint.Enabled           :=  mnuActConsultResults.Enabled and
2499                                          ((lstNotes.ItemIndex > -1) and
2500                                          ((ConsultRec.TIUResultNarrative>0) or
2501                                          (lstNotes.ItemIEN > 0)));
2502    mnuActChange.Enabled              :=  mnuActConsultResults.Enabled and
2503                                          ((lstNotes.ItemIndex > -1) and (lstNotes.ItemIndex = EditingIndex));
2504    mnuActLoadBoiler.Enabled          :=  mnuActConsultResults.Enabled and
2505                                          ((lstNotes.ItemIndex > -1) and (lstNotes.ItemIndex = EditingIndex));
2506  
2507    if ((lstNotes.ItemIndex > -1) and UserIsSigner(lstNotes.ItemIEN)) then
2508    begin
2509      mnuActSignatureList.Enabled := True;
2510      mnuActSignatureSign.Enabled := True;
2511      mnuActConsultResults.Enabled := True;
2512    end;
2513  
2514    popNoteMemoSignList.Enabled       :=  //(mnuActConsultResults.Enabled) and
2515                                          (mnuActSignatureList.Enabled) ;
2516    popNoteMemoSign.Enabled           :=  //(mnuActConsultResults.Enabled) and
2517                                          mnuActSignatureSign.Enabled ;
2518    popNoteMemoSave.Enabled           :=  //(mnuActConsultResults.Enabled) and
2519                                          mnuActSignatureSave.Enabled ;
2520    popNoteMemoEdit.Enabled           :=  //(mnuActConsultResults.Enabled) and
2521                                          mnuActNoteEdit.Enabled;
2522    popNoteMemoAddend.Enabled         :=  //(mnuActConsultResults.Enabled) and
2523                                          mnuActMakeAddendum.Enabled;
2524    popNoteMemoDelete.Enabled         :=  //(mnuActConsultResults.Enabled) and
2525                                          mnuActNoteDelete.Enabled;
2526    popNoteMemoAddlSign.Enabled       :=  //(mnuActConsultResults.Enabled) and
2527                                          mnuActIdentifyAddlSigners.Enabled;
2528    popNoteMemoPrint.Enabled          :=  (mnuActNotePrint.Enabled);
2529  end;
2530  
2531  procedure TfrmConsults.DisplayPCE;
2532  { displays PCE information if appropriate & enables/disables editing of PCE data }
2533  var
2534    EnableList, ShowList: TDrawers;
2535    VitalStr:   TStringlist;
2536    NoPCE:      boolean;
2537    ActionSts: TActionRec;
2538  
2539  begin
2540    if (lstNotes.ItemIndex=-1) or (lstNotes.Items.Count=0) then exit ;
2541    memPCEShow.Clear;
2542    with lstNotes do if ItemIndex = EditingIndex then
2543    begin
2544      with uPCEEdit do
2545      begin
2546        AddStrData(memPCEShow.Lines);
2547        NoPCE := (memPCEShow.Lines.Count = 0);
2548        VitalStr  := TStringList.create;
2549        try
2550          GetVitalsFromDate(VitalStr, uPCEEdit);
2551          AddVitalData(VitalStr, memPCEShow.Lines);
2552        finally
2553          VitalStr.free;
2554        end;
2555        cmdPCE.Enabled := CanEditPCE(uPCEEdit);
2556        ShowPCEControls(cmdPCE.Enabled or (memPCEShow.Lines.Count > 0));
2557        if(NoPCE and memPCEShow.Visible) then
2558          memPCEShow.Lines.Insert(0, TX_NOPCE);
2559  
2560        if(InteractiveRemindersActive) then
2561        begin
2562          if(GetReminderStatus = rsNone) then
2563            EnableList := [odTemplates]
2564          else
2565            EnableList := [odTemplates, odReminders];
2566          ShowList := [odTemplates, odReminders];
2567        end
2568        else
2569        begin
2570          EnableList := [odTemplates];
2571          ShowList := [odTemplates];
2572        end;
2573        frmDrawers.Visible := True;
2574        frmDrawers.DisplayDrawers(TRUE, EnableList, ShowList);
2575        cmdNewConsult.Visible := False;
2576        cmdNewProc.Visible := False;
2577        pnlConsultList.Height := (pnlLeft.Height div 5);
2578  
2579        cmdPCE.Visible := TRUE;
2580      end;
2581    end else
2582    begin
2583      //VitalStr := TStringList.create;
2584      //VitalStr.clear;
2585      cmdPCE.Enabled := False;
2586  
2587      frmDrawers.Visible := False;
2588      frmDrawers.DisplayDrawers(FALSE);
2589      cmdPCE.Visible := FALSE;
2590      cmdNewConsult.Visible := True;
2591      cmdNewProc.Top := cmdNewConsult.Top + cmdNewConsult.Height;
2592      cmdNewProc.Visible := True;
2593      pnlConsultList.Height := (pnlLeft.Height div 2);
2594      //pnlConsultList.Height := 3 * (pnlLeft.Height div 5);
2595  
2596      ActOnDocument(ActionSts, lstNotes.ItemIEN, 'VIEW');
2597      if ActionSts.Success then
2598      begin
2599        StatusText('Retrieving encounter information...');
2600        with uPCEShow do
2601        begin
2602          NoteDateTime := MakeFMDateTime(Piece(lstNotes.Items[lstNotes.ItemIndex], U, 3));
2603          PCEForNote(lstNotes.ItemIEN, uPCEEdit);
2604          AddStrData(memPCEShow.Lines);
2605          NoPCE := (memPCEShow.Lines.Count = 0);
2606          VitalStr  := TStringList.create;
2607          try
2608            GetVitalsFromNote(VitalStr, uPCEShow, lstNotes.ItemIEN);
2609            AddVitalData(VitalStr, memPCEShow.Lines);
2610          finally
2611            VitalStr.free;
2612          end;
2613          ShowPCEControls(memPCEShow.Lines.Count > 0);
2614          if(NoPCE and memPCEShow.Visible) then
2615            memPCEShow.Lines.Insert(0, TX_NOPCE);
2616        end;
2617        StatusText('');
2618      end
2619      else
2620        ShowPCEControls(FALSE);
2621    end; {if ItemIndex}
2622    memPCEShow.SelStart := 0;
2623    popNoteMemoEncounter.Enabled := cmdPCE.Enabled;
2624    popNoteMemoEncounter.Visible := cmdPCE.Visible;
2625  end;
2626  
2627  procedure TfrmConsults.ShowPCEControls(ShouldShow: Boolean);
2628  begin
2629    sptVert.Visible    := ShouldShow;
2630    memPCEShow.Visible := ShouldShow;
2631    if(ShouldShow) then
2632      sptVert.Top := memPCEShow.Top - sptVert.Height;
2633    memResults.Invalidate;
2634  end;
2635  
2636  procedure TfrmConsults.RemovePCEFromChanges(IEN: Integer; AVisitStr: string = '');
2637  begin
2638    if IEN = CN_ADDENDUM then Exit;  // no PCE information entered for an addendum
2639    if AVisitStr = '' then AVisitStr := VisitStrForNote(IEN);
2640    Changes.Remove(CH_PCE, 'V' + AVisitStr);
2641    Changes.Remove(CH_PCE, 'P' + AVisitStr);
2642    Changes.Remove(CH_PCE, 'D' + AVisitStr);
2643    Changes.Remove(CH_PCE, 'I' + AVisitStr);
2644    Changes.Remove(CH_PCE, 'S' + AVisitStr);
2645    Changes.Remove(CH_PCE, 'A' + AVisitStr);
2646    Changes.Remove(CH_PCE, 'H' + AVisitStr);
2647    Changes.Remove(CH_PCE, 'E' + AVisitStr);
2648    Changes.Remove(CH_PCE, 'T' + AVisitStr);
2649  end;
2650  
2651  procedure TfrmConsults.lstNotesClick(Sender: TObject);
2652  { loads the text for the selected note or displays the editing panel for the selected note }
2653  var
2654   x: string;
2655  begin
2656    inherited;
2657    if (lstNotes.ItemIEN = -1) then exit ;
2658    with lstNotes do
2659     if ItemIndex = EditingIndex then
2660       begin
2661         pnlConsultList.Enabled := False; //CQ#15785
2662  //       lstConsults.Enabled := False ;
2663  //       tvConsults.Enabled := False;
2664         pnlResults.Visible := True;
2665         pnlResults.BringToFront;
2666         memConsult.TabStop := False;
2667         mnuActChange.Enabled     := True;
2668         mnuActLoadBoiler.Enabled := True;
2669         UpdateReminderFinish;
2670       end
2671     else
2672       begin
2673         StatusText('Retrieving selected item...');
2674         if EditingIndex = -1 then
2675           begin
2676             pnlConsultList.Enabled := True; //CQ#15785
2677  //           lstConsults.Enabled := True ;
2678  //           tvConsults.Enabled := True;
2679           end;
2680         lblTitle.Caption := MakeConsultNoteDisplayText(lstNotes.Items[lstNotes.ItemIndex]);
2681         lblTitle.Hint := lblTitle.Caption;
2682         lstNotes.Enabled := True ;
2683         pnlResults.Visible := False;
2684         UpdateReminderFinish;
2685         pnlRead.BringToFront;
2686         memConsult.TabStop := True;
2687         if Copy(Piece(lstNotes.ItemID, ';', 2), 1, 4)= 'MCAR' then
2688           begin
2689             QuickCopy(GetDetailedMedicineResults(lstNotes.ItemID), memConsult);
2690             x := Piece(Piece(Piece(lstNotes.ItemID, ';', 2), '(', 2), ',', 1) + ';' + Piece(lstNotes.ItemID, ';', 1);
2691             x := 'MED^' + x;
2692             SetPiece(x, U, 10, Piece(lstNotes.Items[lstNotes.ItemIndex], U, 11));
2693             NotifyOtherApps(NAE_REPORT, x);
2694           end
2695         else
2696           begin
2697             LoadDocumentText(memConsult.Lines,ItemIEN) ;
2698             mnuActChange.Enabled     := False;
2699             mnuActLoadBoiler.Enabled := False;
2700             x := 'TIU^' + lstNotes.ItemID;
2701             SetPiece(x, U, 10, Piece(lstNotes.Items[lstNotes.ItemIndex], U, 11));
2702             NotifyOtherApps(NAE_REPORT, x);
2703           end;
2704         memConsult.SelStart := 0;
2705       end;
2706    if Copy(Piece(lstNotes.ItemID, ';', 2), 1, 4) <> 'MCAR' then
2707      begin
2708        if(assigned(frmReminderTree)) then frmReminderTree.EnableActions;
2709        DisplayPCE;
2710      end;
2711    pnlRight.Refresh;
2712    memConsult.Repaint;
2713    memResults.Repaint;
2714    SetResultMenus;
2715    StatusText('');
2716  end;
2717  
2718  procedure TfrmConsults.popNoteMemoPopup(Sender: TObject);
2719  begin
2720    inherited;
2721    if PopupComponent(Sender, popNoteMemo) is TCustomEdit
2722      then FEditCtrl := TCustomEdit(PopupComponent(Sender, popNoteMemo))
2723      else FEditCtrl := nil;
2724    if FEditCtrl <> nil then
2725     begin
2726      popNoteMemoCut.Enabled       := FEditCtrl.SelLength > 0;
2727      popNoteMemoCopy.Enabled      := popNoteMemoCut.Enabled;
2728      popNoteMemoPaste.Enabled     := (not TORExposedCustomEdit(FEditCtrl).ReadOnly) and
2729                                      Clipboard.HasFormat(CF_TEXT);
2730      popNoteMemoTemplate.Enabled  := frmDrawers.CanEditTemplates and popNoteMemoCut.Enabled;
2731      popNoteMemoFind.Enabled      := FEditCtrl.GetTextLen > 0;
2732     end
2733    else
2734     begin
2735      popNoteMemoCut.Enabled       := False;
2736      popNoteMemoCopy.Enabled      := False;
2737      popNoteMemoPaste.Enabled     := False;
2738      popNoteMemoTemplate.Enabled  := False;
2739     end;
2740    if pnlResults.Visible then
2741    begin
2742      popNoteMemoSpell.Enabled    := True;
2743      popNoteMemoGrammar.Enabled  := True;
2744      popNoteMemoReformat.Enabled := True;
2745      popNoteMemoReplace.Enabled  := (FEditCtrl.GetTextLen > 0);
2746      popNoteMemoPreview.Enabled  := (frmDrawers.TheOpenDrawer = odTemplates) and Assigned(frmDrawers.tvTemplates.Selected);
2747      popNoteMemoInsTemplate.Enabled  := (frmDrawers.TheOpenDrawer = odTemplates) and Assigned(frmDrawers.tvTemplates.Selected);
2748      popNoteMemoViewCslt.Enabled := (FEditNote.PkgPtr = PKG_CONSULTS);  //wat cq 17586
2749    end else
2750    begin
2751      popNoteMemoSpell.Enabled    := False;
2752      popNoteMemoGrammar.Enabled  := False;
2753      popNoteMemoReformat.Enabled := False;
2754      popNoteMemoReplace.Enabled  := False;
2755      popNoteMemoPreview.Enabled  := False;
2756      popNoteMemoInsTemplate.Enabled := False;
2757      popNoteMemoViewCslt.Enabled := FALSE; //wat cq 17586
2758    end;
2759  end;
2760  
2761  procedure TfrmConsults.popNoteMemoCutClick(Sender: TObject);
2762  begin
2763    inherited;
2764    FEditCtrl.CutToClipboard;
2765  end;
2766  
2767  procedure TfrmConsults.popNoteMemoCopyClick(Sender: TObject);
2768  begin
2769    inherited;
2770    FEditCtrl.CopyToClipboard;
2771  end;
2772  
2773  procedure TfrmConsults.popNoteMemoPasteClick(Sender: TObject);
2774  begin
2775    inherited;
2776    FEditCtrl.SelText := Clipboard.AsText; {*KCM*}
2777    //FEditCtrl.PasteFromClipboard;        // use AsText to prevent formatting
2778  end;
2779  
2780  procedure TfrmConsults.popNoteMemoReformatClick(Sender: TObject);
2781  begin
2782    inherited;
2783    if Screen.ActiveControl <> memResults then Exit;
2784    ReformatMemoParagraph(memResults);
2785  end;
2786  
2787  procedure TfrmConsults.popNoteMemoFindClick(Sender: TObject);
2788  begin
2789    inherited;
2790    SendMessage(TRichEdit(popNoteMemo.PopupComponent).Handle, WM_VSCROLL, SB_TOP, 0);
2791    with dlgFindText do
2792      begin
2793        Position := Point(Application.MainForm.Left + pnlLeft.Width, Application.MainForm.Top);
2794        FindText := '';
2795        Options := [frDown, frHideUpDown];
2796        Execute;
2797      end;
2798  end;
2799  
2800  procedure TfrmConsults.dlgFindTextFind(Sender: TObject);
2801  begin
2802    dmodShared.FindRichEditText(dlgFindText, TRichEdit(popNoteMemo.PopupComponent));
2803  end;
2804  
2805  procedure TfrmConsults.dlgReplaceTextFind(Sender: TObject);
2806  begin
2807    inherited;
2808    dmodShared.FindRichEditText(dlgFindText, TRichEdit(popNoteMemo.PopupComponent));
2809  end;
2810  
2811  procedure TfrmConsults.dlgReplaceTextReplace(Sender: TObject);
2812  begin
2813    inherited;
2814    dmodShared.ReplaceRichEditText(dlgReplaceText, TRichEdit(popNoteMemo.PopupComponent));
2815  end;
2816  
2817  procedure TfrmConsults.popNoteMemoReplaceClick(Sender: TObject);
2818  begin
2819    inherited;
2820    SendMessage(TRichEdit(popNoteMemo.PopupComponent).Handle, WM_VSCROLL, SB_TOP, 0);
2821    with dlgReplaceText do
2822      begin
2823        Position := Point(Application.MainForm.Left + pnlLeft.Width, Application.MainForm.Top);
2824        FindText := '';
2825        ReplaceText := '';
2826        Options := [frDown, frHideUpDown];
2827        Execute;
2828      end;
2829  end;
2830  
2831  procedure TfrmConsults.popNoteMemoSpellClick(Sender: TObject);
2832  begin
2833    inherited;
2834    DoAutoSave(0);
2835    timAutoSave.Enabled := False;
2836    try
2837      SpellCheckForControl(memResults);
2838    finally
2839      FChanged := True;
2840      DoAutoSave(0);
2841      timAutoSave.Enabled := True;
2842    end;
2843  end;
2844  
2845  procedure TfrmConsults.popNoteMemoGrammarClick(Sender: TObject);
2846  begin
2847    inherited;
2848    DoAutoSave(0);
2849    timAutoSave.Enabled := False;
2850    try
2851      GrammarCheckForControl(memResults);
2852    finally
2853      FChanged := True;
2854      DoAutoSave(0);
2855      timAutoSave.Enabled := True;
2856    end;
2857  end;
2858  
2859  procedure TfrmConsults.RequestPrint;
2860  var
2861    Saved: boolean;
2862  begin
2863    inherited;
2864    if lstNotes.ItemIEN = EditingIndex then  // !KCM! in response to WPB-0898-31166
2865    //if ItemIEN < 0 then
2866    begin
2867      SaveCurrentNote(Saved);
2868      if not Saved then Exit;
2869    end;
2870    with lstConsults do
2871      if ItemIEN > 0 then PrintSF513(ItemIEN, DisplayText[ItemIndex]) else
2872       begin
2873        if ItemIEN = 0 then InfoBox(TX_NOCONSULT, TX_NOCSLT_CAP, MB_OK);
2874        if lstNotes.ItemIEN < 0 then InfoBox(TX_NOPRT_NEW, TX_NOPRT_NEW_CAP, MB_OK);
2875       end;
2876  end;
2877  
2878  procedure TfrmConsults.RequestMultiplePrint(AForm: TfrmPrintList);
2879  var
2880    NoteIEN: int64;
2881    i: integer;
2882  begin
2883    inherited;
2884    with AForm.lbIDParents do
2885    begin
2886      for i := 0 to Items.Count - 1 do
2887       begin
2888         if Selected[i] then
2889          begin
2890           NoteIEN := ItemIEN;  //StrToInt64def(Piece(TStringList(Items.Objects[i])[0],U,1),0);
2891           if NoteIEN > 0 then PrintSF513(NoteIEN, DisplayText[i]) else
2892            begin
2893             if NoteIEN = 0 then InfoBox(TX_NOCONSULT, TX_NOCSLT_CAP, MB_OK);
2894             if NoteIEN < 0 then InfoBox(TX_NOPRT_NEW, TX_NOPRT_NEW_CAP, MB_OK);
2895            end;
2896          end; {if selected}
2897       end; {for}
2898    end; {with}
2899  end;
2900  
2901  procedure TfrmConsults.mnuActDisplayResultsClick(Sender: TObject);
2902  var
2903    Saved: boolean;
2904  begin
2905    inherited;
2906    if lstConsults.ItemIEN = 0 then exit;
2907    if EditingIndex <> -1 then
2908    begin
2909      SaveCurrentNote(Saved);
2910      if not Saved then Exit;
2911    end;
2912    lstNotes.ItemIndex := -1 ;
2913    DisplayResults(memConsult.Lines, lstConsults.ItemIEN) ;
2914    memConsult.SelStart := 0;
2915    SetResultMenus;
2916    if memConsult.CanFocus then
2917      memConsult.SetFocus;
2918  end;
2919  
2920  procedure TfrmConsults.mnuActDisplaySF513Click(Sender: TObject);
2921  var
2922    Saved: boolean;
2923  begin
2924    inherited;
2925    if lstConsults.ItemIEN = 0 then exit;
2926    if EditingIndex <> -1 then
2927    begin
2928      SaveCurrentNote(Saved);
2929      if not Saved then Exit;
2930    end;
2931    lstNotes.ItemIndex := -1 ;
2932    with lstConsults do
2933      if ItemIEN > 0 then ReportBox(ShowSF513(ItemIEN),DisplayText[ItemIndex], False)
2934      else
2935      begin
2936        if ItemIEN = 0 then InfoBox(TX_NOCONSULT, TX_NOCSLT_CAP, MB_OK);
2937        if lstNotes.ItemIEN < 0 then InfoBox(TX_NOPRT_NEW, TX_NOPRT_NEW_CAP, MB_OK);
2938      end;
2939    SetResultMenus;
2940  end;
2941  
2942  procedure TfrmConsults.pnlResultsResize(Sender: TObject);
2943  const
2944    LEFT_MARGIN = 4;
2945  begin
2946    inherited;
2947    LimitEditWidth(memResults, MAX_ENTRY_WIDTH - 1);
2948    memResults.Constraints.MinWidth := TextWidthByFont(memResults.Font.Handle, StringOfChar('X', MAX_ENTRY_WIDTH)) + (LEFT_MARGIN * 2) + ScrollBarWidth;
2949    //CQ13181	508 Consults--Splitter bar doesn't retain size
2950   //CQ13181  pnlLeft.Width := self.ClientWidth - pnlResults.Width - sptHorz.Width;
2951  end;
2952  
2953  procedure TfrmConsults.NotifyOrder(OrderAction: Integer; AnOrder: TOrder);
2954  var
2955    SavedCsltID: string;
2956  begin
2957    if ViewContext = 0 then exit;     // form has not yet been displayed, so nothing to update
2958    if EditingIndex <> -1 then exit;  // do not rebuild list until after save
2959    with tvConsults do if Selected <> nil then SavedCsltID := lstConsults.ItemID;
2960    case OrderAction of
2961    ORDER_NEW:  UpdateList ;
2962    ORDER_SIGN: UpdateList{ sent by fReview, fOrderSign when orders signed, AnOrder=nil}
2963    end;
2964    if SavedCsltID <> '' then with tvConsults do
2965    begin
2966      Selected := FindPieceNode(SavedCsltID, U, Items.GetFirstNode);
2967      tvConsultsChange(Self, Selected);
2968    end;
2969  end;
2970  
2971  procedure TfrmConsults.mnuActPrintSF513Click(Sender: TObject);
2972  var
2973    Saved: boolean;
2974  begin
2975    inherited;
2976    if lstConsults.ItemIEN = 0 then exit;
2977    if EditingIndex <> -1 then
2978    begin
2979      SaveCurrentNote(Saved);
2980      if not Saved then Exit;
2981    end;
2982    RequestPrint;
2983  end;
2984  
2985  
2986  function TfrmConsults.AuthorizedUser: Boolean;
2987  begin
2988    Result := True;
2989    if User.NoOrdering then Result := False;
2990    if User.OrderRole = OR_BADKEYS then
2991    begin
2992      InfoBox(TX_BADKEYS, TC_BADKEYS, MB_OK);
2993      Result := False;
2994    end;
2995  end;
2996  
2997  procedure TfrmConsults.FormCreate(Sender: TObject);
2998  begin
2999    inherited;
3000    FocusToRightPanel := False;
3001    PageID := CT_CONSULTS;
3002    EditingIndex := -1;
3003    FLastNoteID := '';
3004    FEditNote.LastCosigner := 0;
3005    FEditNote.LastCosignerName := '';
3006    //pnlConsultList.Height := (pnlLeft.Height div 2);
3007    pnlConsultList.Height := 3 * (pnlLeft.Height div 5);
3008    frmDrawers := TfrmDrawers.CreateDrawers(Self, pnlAction, [],[]);
3009    frmDrawers.Align := alBottom;
3010    frmDrawers.RichEditControl := memResults;
3011    frmDrawers.Splitter := splDrawers;
3012    frmDrawers.DefTempPiece := 2;
3013    FImageFlag := TBitmap.Create;
3014    FDocList := TStringList.Create;
3015    with FCurrentNoteContext do
3016      begin
3017        GroupBy := '';
3018        TreeAscending := False;
3019        Status := IntToStr(NC_ALL);
3020      end;
3021    FCsltList := TStringList.Create;
3022  end;
3023  
3024  procedure TfrmConsults.mnuActDisplayDetailsClick(Sender: TObject);
3025  var
3026    Saved: boolean;
3027  begin
3028    inherited;
3029    if lstConsults.ItemIEN = 0  then exit;
3030    if EditingIndex <> -1 then
3031    begin
3032      SaveCurrentNote(Saved);
3033      if not Saved then Exit;
3034    end;
3035    tvConsultsChange(Self, tvConsults.Selected);
3036    //lstConsultsClick(Self);
3037    if memConsult.CanFocus then
3038      memConsult.SetFocus;
3039  end;
3040  
3041  procedure TfrmConsults.FormClose(Sender: TObject; var Action: TCloseAction);
3042  var
3043    Saved: Boolean;
3044    IEN: Int64;
3045    ErrMsg: string;
3046    DeleteSts: TActionRec;
3047  begin
3048    inherited;
3049    if frmFrame.TimedOut and (EditingIndex <> -1) then
3050    begin
3051      FSilent := True;
3052      if memResults.GetTextLen > 0 then SaveCurrentNote(Saved)
3053      else
3054      begin
3055        IEN := lstNotes.GetIEN(EditingIndex);
3056        if not LastSaveClean(IEN) then             // means note hasn't been committed yet
3057        begin
3058          LockDocument(IEN, ErrMsg);
3059          if ErrMsg = '' then
3060          begin
3061            DeleteDocument(DeleteSts, IEN, '');
3062            UnlockDocument(IEN);
3063          end; {if ErrMsg}
3064        end; {if not LastSaveClean}
3065      end; {else}
3066    end; {if frmFrame}
3067  end;
3068  
3069  procedure TfrmConsults.mnuActIdentifyAddlSignersClick(Sender: TObject);
3070  var
3071    Exclusions: TStrings;
3072    Saved, x, y: boolean;
3073    SignerList: TSignerList;
3074    ActionSts: TActionRec;
3075    SigAction: integer;
3076    SavedDocID, SavedCsltID: string;
3077    ARefDate: TFMDateTime;
3078  begin
3079    inherited;
3080    if lstNotes.ItemIEN = 0 then exit;
3081    SavedDocID := lstNotes.ItemID;
3082    SavedCsltID := lstConsults.ItemID;
3083    if lstNotes.ItemIndex = EditingIndex then
3084      begin
3085        SaveCurrentNote(Saved);
3086        if not Saved then Exit;
3087        tvConsultsChange(Self, tvConsults.Selected);
3088        with tvCsltNotes do Selected := FindPieceNode(SavedDocID, U, Items.GetFirstNode);
3089      end;
3090    x := CanChangeCosigner(lstNotes.ItemIEN);
3091    ActOnDocument(ActionSts, lstNotes.ItemIEN, 'IDENTIFY SIGNERS');
3092    y := ActionSts.Success;
3093    if x and not y then
3094      begin
3095        if InfoBox(ActionSts.Reason + CRLF + CRLF +
3096                   'Would you like to change the cosigner?',
3097                   TX_IN_AUTH, MB_YESNO or MB_DEFBUTTON2 or MB_ICONQUESTION) = ID_YES then
3098      	SigAction := SG_COSIGNER
3099        else
3100  	Exit;
3101      end
3102    else if y and not x then SigAction := SG_ADDITIONAL
3103    else if x and y then SigAction := SG_BOTH
3104    else
3105      begin
3106        InfoBox(ActionSts.Reason, TX_IN_AUTH, MB_OK);
3107        Exit;
3108      end;
3109  
3110    with lstNotes do
3111      begin
3112        if not LockConsultRequestAndNote(ItemIEN) then Exit;
3113        Exclusions := GetCurrentSigners(ItemIEN);
3114        ARefDate := StrToFloat(Piece(Items[ItemIndex], U, 3));
3115        SelectAdditionalSigners(Font.Size, ItemIEN, SigAction, Exclusions, SignerList, CT_CONSULTS, ARefDate);
3116      end;
3117    with SignerList do
3118      begin
3119        case SigAction of
3120          SG_ADDITIONAL:  if Changed and (Signers <> nil) and (Signers.Count > 0) then
3121                            UpdateAdditionalSigners(lstNotes.ItemIEN, Signers);
3122          SG_COSIGNER:    if Changed then ChangeCosigner(lstNotes.ItemIEN, Cosigner);
3123          SG_BOTH:        if Changed then
3124                            begin
3125                              if (Signers <> nil) and (Signers.Count > 0) then
3126                                UpdateAdditionalSigners(lstNotes.ItemIEN, Signers);
3127                              ChangeCosigner(lstNotes.ItemIEN, Cosigner);
3128                            end;
3129        end;
3130        lstNotesClick(Self);
3131      end;
3132    UnlockDocument(lstNotes.ItemIEN);
3133    UnlockConsultRequest(lstNotes.ItemIEN, StrToIntDef(SavedCsltID, 0));  // v20.4  RV (unlocking problem)
3134    //UnlockConsultRequest(lstNotes.ItemIEN, ConsultRec.IEN);
3135  end;
3136  
3137  procedure TfrmConsults.popNoteMemoAddlSignClick(Sender: TObject);
3138  begin
3139    inherited;
3140    mnuActIdentifyAddlSignersClick(Self);
3141  end;
3142  
3143  procedure TfrmConsults.ProcessNotifications;
3144  var
3145    ConsultIEN, NoteIEN: integer;
3146    x: string;
3147    Saved: boolean;
3148    AnObject: PDocTreeObject;
3149    tmpNode: TORTreeNode;
3150    I:Integer;
3151    CommentDate: String;
3152    Format: CHARFORMAT2;
3153    VisibleLineCount: integer;
3154  begin
3155    if EditingIndex <> -1 then
3156    begin
3157      SaveCurrentNote(Saved);
3158      if not Saved then Exit;
3159    end;
3160    FNotifPending := True;
3161    NoteIEN := 0;
3162    CurrNotifIEN := 0;
3163    lblConsults.Caption := Notifications.Text;
3164    tvConsults.Caption := Notifications.Text;
3165    EditingIndex := -1;
3166    pnlConsultList.Enabled := True; //CQ#15785
3167  //  lstConsults.Enabled := True ;
3168  //  tvConsults.Enabled := True;
3169    lstNotes.Enabled := True ;
3170    pnlRead.BringToFront ;
3171    memConsult.TabStop := True;
3172    lstConsults.Clear;
3173  
3174    if Copy(Piece(Piece(Notifications.RecordID, U, 2),';',1),1,3) = 'TIU' then
3175      begin
3176        ConsultIEN := StrToIntDef(Piece(Piece(Notifications.RecordID, U, 4),';',2),0);
3177        NoteIEN := StrToIntDef(Piece(Notifications.AlertData, U, 1),0);
3178      end
3179    else if Notifications.Followup = NF_STAT_RESULTS then
3180      ConsultIEN := StrToIntDef(Piece(Piece(Piece(Notifications.AlertData, '|', 2), '@', 1), ';', 1), 0)
3181    else if Notifications.Followup = NF_CONSULT_PROC_INTERPRETATION then
3182      ConsultIEN := StrToIntDef(Piece(Notifications.AlertData, '|', 1), 0)
3183    else if ((Notifications.Followup = NF_CONSULT_REQUEST_RESOLUTION) and (Pos('Sig Findings', Notifications.RecordID) = 0)) then
3184      ConsultIEN := StrToIntDef(Piece(Notifications.AlertData, '|', 1), 0)
3185    else
3186      ConsultIEN := StrToIntDef(Notifications.AlertData, 0);
3187    x := FindConsult(ConsultIEN);
3188    CurrNotifIEN := ConsultIEN;
3189    lstConsults.Items.Add(x);
3190    uChanging := True;
3191    tvConsults.Items.BeginUpdate;
3192    tvConsults.Items.Clear;
3193    tmpNode := tvConsults.FindPieceNode('Alerted Consult', 2, U, nil);
3194    if tmpNode = nil then
3195      begin
3196        tmpNode := TORTreeNode(tvConsults.Items.AddFirst(tvConsults.Items.GetFirstNode, 'Alerted Consult'));
3197        tmpNode.StringData := '-1^Alerted Consult^^^^^^0';
3198      end
3199    else
3200      tmpNode.DeleteChildren;
3201    SetNodeImage(tmpNode, FCurrentContext);
3202    tmpNode := TORTreeNode(tvConsults.Items.AddChildFirst(tmpNode, MakeConsultListDisplayText(x)));
3203    tmpNode.StringData := x;
3204    SetNodeImage(tmpNode, FCurrentContext);
3205    with tvConsults do Selected := FindPieceNode(Piece(x, U, 1), U, Items.GetFirstNode);
3206    tvConsults.Items.EndUpdate;
3207    uChanging := False;
3208    tvConsultsChange(Self, tvConsults.Selected);
3209    if ((Notifications.Followup = NF_CONSULT_REQUEST_RESOLUTION) and (Pos('Sig Findings', Notifications.RecordID) = 0)) then
3210      begin
3211        //XQADATA = consult_ien|tiu_ien;TIU(8925,
3212        if Copy(Piece(Piece(Notifications.AlertData, '|', 2), ';', 2), 1, 3) = 'TIU' then
3213          NoteIEN := StrToIntDef(Piece(Piece(Notifications.AlertData, '|', 2), ';', 1), 0);
3214      end
3215    else if (Notifications.Followup = NF_CONSULT_PROC_INTERPRETATION) then
3216      begin
3217        NoteIEN := StrToIntDef(Piece(Piece(Notifications.AlertData, '|', 2), ';', 1), 0);
3218      end
3219    else if (Notifications.Followup = NF_STAT_RESULTS) then
3220      begin
3221        NoteIEN := 0;   // Note IEN not available for this alert - fall through to display all results - CURTIS?
3222      end;
3223    tvCsltNotes.FullExpand;
3224    if NoteIEN > 0 then with lstNotes do
3225      begin
3226        if SelectByIEN(NoteIEN) = -1 then
3227          begin
3228            x := Notifications.AlertData;
3229            uChanging := True;
3230            tvCsltNotes.Items.BeginUpdate;
3231            lstNotes.Clear;
3232            KillDocTreeObjects(tvCsltNotes);
3233            tvCsltNotes.Items.Clear;
3234            lstNotes.Items.Add(x);
3235            AnObject := MakeConsultsNoteTreeObject('ALERT^Alerted Note^^^^^^^^^^^%^0');
3236            tmpNode := TORTreeNode(tvCsltNotes.Items.AddObjectFirst(tvCsltNotes.Items.GetFirstNode, AnObject.NodeText, AnObject));
3237            TORTreeNode(tmpNode).StringData := 'ALERT^Alerted Note^^^^^^^^^^^%^0';
3238            tmpNode.ImageIndex := IMG_TOP_LEVEL;
3239            AnObject := MakeConsultsNoteTreeObject(x);
3240            tmpNode := TORTreeNode(tvCsltNotes.Items.AddChildObjectFirst(tmpNode, AnObject.NodeText, AnObject));
3241            tmpNode.StringData := x;
3242            SetTreeNodeImagesAndFormatting(tmpNode, FCurrentNoteContext, CT_CONSULTS);
3243            with tvCsltNotes do Selected := FindPieceNode(Piece(x, U, 1), U, Items.GetFirstNode);
3244            tvCsltNotes.Items.EndUpdate;
3245            uChanging := False;
3246          end
3247        else
3248          begin
3249            uChanging := True;
3250            with tvCsltNotes do Selected := FindPieceNode(IntToStr(NoteIEN), U , nil);
3251            uChanging := False;
3252          end;
3253        tvCsltNotesChange(Self, tvCsltNotes.Selected);
3254      end
3255    else if (ConsultRec.ORStatus = ST_COMPLETE) and ((ConsultRec.TIUDocuments.Count + ConsultRec.MedResults.Count) > 0)
3256    and (Pos(UpperCase('Comment added'), UpperCase(Notifications.Text)) = 0) then //CB
3257      mnuActDisplayResultsClick(Self);
3258  
3259    //CB
3260     If (Notifications.HighLightSection <> '') and (Pos(UpperCase('Comment added'), UpperCase(Notifications.Text)) > 0) then begin
3261     CommentDate := FormatDateTime('mm/dd/yy hh:mm', StrToDateTime(StringReplace(Notifications.HighLightSection, '@', ' ', [rfReplaceAll])) );
3262     for I := 0 to memConsult.Lines.Count - 1 do begin
3263       If (Pos(CommentDate, memConsult.Lines.Strings[i]) > 0) and (Pos(UpperCase('ADDED COMMENT'), UpperCase(memConsult.Lines.Strings[i])) > 0) then begin
3264        if CustomCanFocus(memconsult) then
3265          memConsult.SetFocus;
3266        memConsult.SelStart := memConsult.Perform(EM_LINEINDEX, i,0);
3267        memConsult.SelLength := Length(memConsult.Lines.Strings[i]);
3268  
3269        //Set the background color
3270        Format.cbSize := SizeOf(Format);
3271        Format.dwMask := CFM_BACKCOLOR;
3272  
3273        Format.crBackColor := clRed;
3274        memConsult.Perform(EM_SETCHARFORMAT, SCF_SELECTION, Longint(@Format));
3275            //Get visible Line Couunt
3276         VisibleLineCount := LinesVisible(memConsult);
3277  
3278        if (I + VisibleLineCount)>= memConsult.Lines.Count - 1 then
3279          memConsult.SelStart := memConsult.Perform(EM_LINEINDEX, memConsult.Lines.Count - 1,0)
3280        else memConsult.SelStart := memConsult.Perform(EM_LINEINDEX,I + VisibleLineCount - 1,0);
3281  
3282        memConsult.Perform($00B7, 0, 0);  //EM_SETCARRET DEFINED WRONG in Richedit.pas
3283        memConsult.SelLength := 0;
3284        break;
3285       end;
3286     end;
3287    end;
3288  
3289    case Notifications.Followup of
3290      NF_CONSULT_REQUEST_RESOLUTION   :  Notifications.Delete;
3291      NF_NEW_SERVICE_CONSULT_REQUEST  :  Notifications.Delete;
3292      NF_STAT_RESULTS                 :  Notifications.Delete;
3293      NF_CONSULT_REQUEST_CANCEL_HOLD  :  Notifications.Delete;
3294      NF_CONSULT_REQUEST_UPDATED      :  Notifications.Delete;
3295      NF_CONSULT_UNSIGNED_NOTE        :  {Will be automatically deleted by TIU sig action!!!} ;
3296      NF_CONSULT_PROC_INTERPRETATION  :  Notifications.Delete;      // not sure we want to do this yet,
3297                                                                    // but if not now, then when?
3298    end;
3299    if Copy(Piece(Notifications.RecordID, U, 2), 1, 6) = 'TIUADD' then Notifications.Delete;
3300    if Copy(Piece(Notifications.RecordID, U, 2), 1, 5) = 'TIUID' then Notifications.Delete;
3301    FNotifPending := False;
3302  end;
3303  
3304  // *****************************************************************
3305  //                  Delphi's Can Focus has a bug.
3306  //     Source: http://qc.embarcadero.com/wc/qcmain.aspx?d=11229
3307  // *****************************************************************
3308  function TfrmConsults.CustomCanFocus(Control: TWinControl): Boolean;
3309  var
3310    Form: TCustomForm;
3311  begin
<