Module

fDCSumm

Path

C:\CPRS\CPRS30\fDCSumm.pas

Last Modified

7/15/2014 3:26:36 PM

Initialization Code

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

Finalization Code

finalization
  uPCEEdit.Free;
  uPCEShow.Free;

end.

Units Used in Interface

Name Comments
fBase508Form -
fDrawers -
fHSplit -
fPrintList -
rDCSumm -
uConst -
uDCSumm -
uDocTree -
uPCE -
uTIU -

Units Used in Implementation

Name Comments
dShared -
fAddlSigners -
fDCSummProps -
fEncnt -
fEncounterFrame -
fFrame -
fIconLegend -
fNoteBA -
fNoteBD -
fNoteDR -
fNoteIDParents -
fNotePrt -
fNotesBP -
fReminderDialog -
fSignItem -
fTemplateDialog -
fTemplateEditor -
fTemplateFieldEditor -
fTIUView -
fVisit -
rCore -
rPCE -
rTemplates -
rTIU -
rVitals -
uCore -
uSpell -
uTemplates -
uVA508CPRSCompatibility -

Classes

Name Comments
TfrmDCSumm -

Procedures

Name Owner Declaration Scope Comments
AssignBoilerText - procedure AssignBoilerText; Local -
ClearEditControls TfrmDCSumm procedure ClearEditControls; Private
General procedures ----------------------------------------------------------------------- 

 resets controls used for entering a new Discharge Summary
ClearPtData TfrmDCSumm procedure ClearPtData; override; Public Clear all controls that contain patient specific information
cmdChangeClick TfrmDCSumm procedure cmdChangeClick(Sender: TObject); Public/Published -
cmdNewSummClick TfrmDCSumm procedure cmdNewSummClick(Sender: TObject); Public/Published Maps 'New Summ' button to the New Discharge Summary menu item
cmdOrdersClick TfrmDCSumm procedure cmdOrdersClick(Sender: TObject); Public/Published -
cmdPCEClick TfrmDCSumm procedure cmdPCEClick(Sender: TObject); Public/Published -
DisplayPage TfrmDCSumm procedure DisplayPage; override; Public Causes page to be visible and conditionally executes initialization code
DisplayPCE TfrmDCSumm procedure DisplayPCE; Private Displays PCE information if appropriate & enables/disabled editing of PCE data
dlgFindTextFind TfrmDCSumm procedure dlgFindTextFind(Sender: TObject); Public/Published -
dlgReplaceTextFind TfrmDCSumm procedure dlgReplaceTextFind(Sender: TObject); Public/Published -
dlgReplaceTextReplace TfrmDCSumm procedure dlgReplaceTextReplace(Sender: TObject); Public/Published -
DoAttachIDChild TfrmDCSumm procedure DoAttachIDChild(AChild, AParent: TORTreeNode); Private -
DoAutoSave TfrmDCSumm procedure DoAutoSave(Suppress: integer = 1); Private -
EnableDisableIDNotes TfrmDCSumm procedure EnableDisableIDNotes; Private -
FormClose TfrmDCSumm procedure FormClose(Sender: TObject; var Action: TCloseAction); Public/Published -
FormCreate TfrmDCSumm procedure FormCreate(Sender: TObject); Public/Published -
FormDestroy TfrmDCSumm procedure FormDestroy(Sender: TObject); Public/Published -
InsertAddendum TfrmDCSumm procedure InsertAddendum; Private Sets up fields of pnlWrite to write an addendum for the selected Summary
InsertNewSumm TfrmDCSumm procedure InsertNewSumm(IsIDChild: boolean; AnIDParent: integer); Private Creates the editing context for a new Discharge Summary & inserts stub into top of view list
LoadForEdit TfrmDCSumm procedure LoadForEdit(PreserveValues: Boolean); Private Retrieves an existing Summ and places the data in the fields of pnlWrite
LoadSumms TfrmDCSumm procedure LoadSumms; Private
Added for treeview - see also uDocTree.pas
===================  Added for sort/search enhancements ======================
lstSummsClick TfrmDCSumm procedure lstSummsClick(Sender: TObject); Public/Published
Left panel (selector) events ------------------------------------------------------------- 

 loads the text for the selected Summ or displays the editing panel for the selected Summ
LstSummsToPrint TfrmDCSumm procedure LstSummsToPrint; Public -
lvSummsColumnClick TfrmDCSumm procedure lvSummsColumnClick(Sender: TObject; Column: TListColumn); Public/Published -
lvSummsCompare TfrmDCSumm procedure lvSummsCompare(Sender: TObject; Item1, Item2: TListItem; Data: Integer; var Compare: Integer); Public/Published -
lvSummsResize TfrmDCSumm procedure lvSummsResize(Sender: TObject); Public/Published -
lvSummsSelectItem TfrmDCSumm procedure lvSummsSelectItem(Sender: TObject; Item: TListItem; Selected: Boolean); Public/Published -
memNewSummChange TfrmDCSumm procedure memNewSummChange(Sender: TObject); Public/Published
Right panel (editor) events -------------------------------------------------------------- 

 sets FChanged to record that the Summ has really been edited
memNewSummKeyUp TfrmDCSumm procedure memNewSummKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState); Public/Published -
mnuActAddendClick TfrmDCSumm procedure mnuActAddendClick(Sender: TObject); Public/Published Make an addendum to an existing Summ
mnuActAddIDEntryClick TfrmDCSumm procedure mnuActAddIDEntryClick(Sender: TObject); Public/Published Switches to current new note or creates a new note if none is being edited already
mnuActAttachtoIDParentClick TfrmDCSumm procedure mnuActAttachtoIDParentClick(Sender: TObject); Public/Published -
mnuActChangeClick TfrmDCSumm procedure mnuActChangeClick(Sender: TObject); Public/Published -
mnuActDeleteClick TfrmDCSumm procedure mnuActDeleteClick(Sender: TObject); Public/Published Delete the selected progress note & remove from the Encounter object if necessary
mnuActDetachFromIDParentClick TfrmDCSumm procedure mnuActDetachFromIDParentClick(Sender: TObject); Public/Published -
mnuActEditClick TfrmDCSumm procedure mnuActEditClick(Sender: TObject); Public/Published Load the selected Discharge Summary for editing
mnuActIdentifyAddlSignersClick TfrmDCSumm procedure mnuActIdentifyAddlSignersClick(Sender: TObject); Public/Published -
mnuActLoadBoilerClick TfrmDCSumm procedure mnuActLoadBoilerClick(Sender: TObject); Public/Published -
mnuActNewClick TfrmDCSumm procedure mnuActNewClick(Sender: TObject); Public/Published Switches to current new Summ or creates a new Summ if none is being edited already
mnuActSaveClick TfrmDCSumm procedure mnuActSaveClick(Sender: TObject); Public/Published Saves the Summ that is currently being edited
mnuActSignClick TfrmDCSumm procedure mnuActSignClick(Sender: TObject); Public/Published Sign the currently selected Summ, save first if necessary
mnuActSignListClick TfrmDCSumm procedure mnuActSignListClick(Sender: TObject); Public/Published Add the Summ to the Encounter object, see mnuActSignClick - copied
mnuChartTabClick TfrmDCSumm procedure mnuChartTabClick(Sender: TObject); Public/Published Reroute to Chart Tab menu of the parent form: frmFrame
mnuEditDialgFieldsClick TfrmDCSumm procedure mnuEditDialgFieldsClick(Sender: TObject); Public/Published -
mnuEditSharedTemplatesClick TfrmDCSumm procedure mnuEditSharedTemplatesClick(Sender: TObject); Public/Published -
mnuEditTemplatesClick TfrmDCSumm procedure mnuEditTemplatesClick(Sender: TObject); Public/Published -
mnuIconLegendClick TfrmDCSumm procedure mnuIconLegendClick(Sender: TObject); Public/Published -
mnuNewSharedTemplateClick TfrmDCSumm procedure mnuNewSharedTemplateClick(Sender: TObject); Public/Published -
mnuNewTemplateClick TfrmDCSumm procedure mnuNewTemplateClick(Sender: TObject); Public/Published -
mnuOptionsClick TfrmDCSumm procedure mnuOptionsClick(Sender: TObject); Public/Published -
mnuViewClick TfrmDCSumm procedure mnuViewClick(Sender: TObject); Public/Published
View menu events ------------------------------------------------------------------------- 

 changes the list of Summs available for viewing
mnuViewDetailClick TfrmDCSumm procedure mnuViewDetailClick(Sender: TObject); Public/Published -
mnuViewInformationClick TfrmDCSumm procedure mnuViewInformationClick(Sender: TObject); Public/Published -
mnuViewReturntoDefaultClick TfrmDCSumm procedure mnuViewReturntoDefaultClick(Sender: TObject); Public/Published -
mnuViewSaveAsDefaultClick TfrmDCSumm procedure mnuViewSaveAsDefaultClick(Sender: TObject); Public/Published -
pnlRightResize TfrmDCSumm procedure pnlRightResize(Sender: TObject); Public/Published
Form events ------------------------------------------------------------------------------ 

 memSumm (TRichEdit) doesn't repaint appropriately unless its parent panel is refreshed
pnlWriteResize TfrmDCSumm procedure pnlWriteResize(Sender: TObject); Public/Published -
popSummListCollapseAllClick TfrmDCSumm procedure popSummListCollapseAllClick(Sender: TObject); Public/Published -
popSummListCollapseSelectedClick TfrmDCSumm procedure popSummListCollapseSelectedClick(Sender: TObject); Public/Published -
popSummListExpandAllClick TfrmDCSumm procedure popSummListExpandAllClick(Sender: TObject); Public/Published -
popSummListExpandSelectedClick TfrmDCSumm procedure popSummListExpandSelectedClick(Sender: TObject); Public/Published -
popSummListPopup TfrmDCSumm procedure popSummListPopup(Sender: TObject); Public/Published -
popSummMemoAddlSignClick TfrmDCSumm procedure popSummMemoAddlSignClick(Sender: TObject); Public/Published -
popSummMemoCopyClick TfrmDCSumm procedure popSummMemoCopyClick(Sender: TObject); Public/Published -
popSummMemoCutClick TfrmDCSumm procedure popSummMemoCutClick(Sender: TObject); Public/Published -
popSummMemoFindClick TfrmDCSumm procedure popSummMemoFindClick(Sender: TObject); Public/Published -
popSummMemoGrammarClick TfrmDCSumm procedure popSummMemoGrammarClick(Sender: TObject); Public/Published -
popSummMemoInsTemplateClick TfrmDCSumm procedure popSummMemoInsTemplateClick(Sender: TObject); Public/Published -
popSummMemoPasteClick TfrmDCSumm procedure popSummMemoPasteClick(Sender: TObject); Public/Published -
popSummMemoPopup TfrmDCSumm procedure popSummMemoPopup(Sender: TObject); Public/Published -
popSummMemoPreviewClick TfrmDCSumm procedure popSummMemoPreviewClick(Sender: TObject); Public/Published -
popSummMemoReformatClick TfrmDCSumm procedure popSummMemoReformatClick(Sender: TObject); Public/Published -
popSummMemoReplaceClick TfrmDCSumm procedure popSummMemoReplaceClick(Sender: TObject); Public/Published -
popSummMemoSaveContinueClick TfrmDCSumm procedure popSummMemoSaveContinueClick(Sender: TObject); Public/Published -
popSummMemoSpellClick TfrmDCSumm procedure popSummMemoSpellClick(Sender: TObject); Public/Published -
popSummMemoTemplateClick TfrmDCSumm procedure popSummMemoTemplateClick(Sender: TObject); Public/Published -
ProcessNotifications TfrmDCSumm procedure ProcessNotifications; Private -
RemovePCEFromChanges TfrmDCSumm procedure RemovePCEFromChanges(IEN: Int64; AVisitStr: string = ''); Private -
RequestMultiplePrint TfrmDCSumm procedure RequestMultiplePrint(AForm: TfrmPrintList); Public -
RequestPrint TfrmDCSumm procedure RequestPrint; override; Public -
SaveCurrentSumm TfrmDCSumm procedure SaveCurrentSumm(var Saved: Boolean); Private Called whenever a Summ should be saved - uses IEN to call appropriate save logic
SaveEditedSumm TfrmDCSumm procedure SaveEditedSumm(var Saved: Boolean); Private Validates fields and sends the updated Summ to the server
SaveSignItem TfrmDCSumm procedure SaveSignItem(const ItemID, ESCode: string); Public Saves and optionally signs a Discharge Summary or addendum
SetEditingIndex TfrmDCSumm procedure SetEditingIndex(const Value: Integer); Private Function MakeTitleText(IsAddendum: Boolean = False): string;
SetFontSize TfrmDCSumm procedure SetFontSize(NewFontSize: Integer); override; Public Adjusts the font size of any controls that don't have ParentFont = True
SetViewContext TfrmDCSumm procedure SetViewContext(AContext: TTIUContext); Private -
ShowPCEControls TfrmDCSumm procedure ShowPCEControls(ShouldShow: Boolean); Private -
sptHorzCanResize TfrmDCSumm procedure sptHorzCanResize(Sender: TObject; var NewSize: Integer; var Accept: Boolean); Public/Published -
timAutoSaveTimer TfrmDCSumm procedure timAutoSaveTimer(Sender: TObject); Public/Published -
tvSummsChange TfrmDCSumm procedure tvSummsChange(Sender: TObject; Node: TTreeNode); Public/Published -
tvSummsClick TfrmDCSumm procedure tvSummsClick(Sender: TObject); Public/Published -
tvSummsCollapsed TfrmDCSumm procedure tvSummsCollapsed(Sender: TObject; Node: TTreeNode); Public/Published -
tvSummsDragDrop TfrmDCSumm procedure tvSummsDragDrop(Sender, Source: TObject; X, Y: Integer); Public/Published -
tvSummsDragOver TfrmDCSumm procedure tvSummsDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); Public/Published -
tvSummsExpanded TfrmDCSumm procedure tvSummsExpanded(Sender: TObject; Node: TTreeNode); Public/Published -
tvSummsStartDrag TfrmDCSumm procedure tvSummsStartDrag(Sender: TObject; var DragObject: TDragObject); Public/Published -
UpdateTreeView TfrmDCSumm procedure UpdateTreeView(DocList: TStringList; Tree: TORTreeView); Private -
ViewInfo TfrmDCSumm procedure ViewInfo(Sender: TObject); Public/Published -

Functions

Name Owner Declaration Scope Comments
AllowContextChange TfrmDCSumm function AllowContextChange(var WhyNot: string): Boolean; override; Public TPage common methods ---------------------------------------------------------------------
GetDrawers TfrmDCSumm function GetDrawers: TfrmDrawers; Private -
GetTitleText TfrmDCSumm function GetTitleText(AnIndex: Integer): string; Private Returns non-tabbed text for the title of a note given the ItemIndex in lstSumms
LacksRequiredForCreate TfrmDCSumm function LacksRequiredForCreate: Boolean; Private
Function TfrmDCSumm.MakeTitleText(IsAddendum: Boolean = False): string;
{returns display text for list box based on FEditNote }
begin
  Result := FormatFMDateTime('mmm dd,yy', FEditDCSumm.DischargeDateTime) + U;
  if IsAddendum and (CompareText(Copy(FEditDCSumm.TitleName, 1, 8), 'Addendum') <> 0)
    then Result := Result + 'Addendum to ';
  Result := Result + FEditDCSumm.TitleName + ', ' + FEditDCSumm.LocationName + ', ' +
            FEditDCSumm.DictatorName;
end;

 determines if the fields required to create the note are present
LockSumm TfrmDCSumm function LockSumm(AnIEN: Int64): Boolean; Private Returns true if summ successfully locked
NoSummSelected TfrmDCSumm function NoSummSelected : Boolean; Private
Returns True & Displays a Message if Currently No D/C Summary is Selected,
 Otherwise returns false and does not display a message.
SetDateRangeText - function SetDateRangeText(AContext: TTIUContext): string; Local -
SetSummTreeLabel TfrmDCSumm function SetSummTreeLabel(AContext: TTIUContext): string; Private -
SortByDate - function SortByDate(Node1, Node2: TTreeNode; Data: Longint): Integer; stdcall; Local -
SortByTitle - function SortByTitle(Node1, Node2: TTreeNode; Data: Longint): Integer; stdcall; Local -
StartNewEdit TfrmDCSumm function StartNewEdit(NewNoteType: integer): Boolean; Private
Action menu events ----------------------------------------------------------------------- 

 if currently editing a note, returns TRUE if the user wants to start a new one
TitleText TfrmDCSumm function TitleText(AnIndex: Integer): string; Private Returns non-tabbed text for the title of a Summ given the ItemIndex in lstSumms
VerifySummTitle TfrmDCSumm function VerifySummTitle: Boolean; Private -

Global Variables

Name Type Declaration Comments
ColumnSortForward Boolean ColumnSortForward: Boolean; -
ColumnToSort Integer ColumnToSort: Integer; -
frmDCSumm TfrmDCSumm frmDCSumm: TfrmDCSumm; -
frmDrawers TfrmDrawers frmDrawers: TfrmDrawers; -
uChanging Boolean uChanging: Boolean; -
uDCSummContext uDCSummContext: TTIUContext; -
uIDNotesActive Boolean uIDNotesActive: Boolean; -
uPCEEdit TPCEData uPCEShow, uPCEEdit: TPCEData; -
uPCEShow TPCEData uPCEShow, uPCEEdit: TPCEData; -
ViewContext Integer ViewContext: Integer; -

Constants

Name Declaration Scope Comments
DC_ACT_ADDENDUM 3 Global -
DC_ACT_EDIT_SUMM 4 Global -
DC_ACT_ID_ENTRY 5 Global -
DC_ACT_NEW_SUMM 2 Global -
DC_ADDENDUM -60 Global Holder IEN for a new addendum
DC_NEW_SUMM -50 Global Holder IEN for a new Summary
NA_CREATE 0 Global New Summ action - create new Summ
NA_SAVECREATE 2 Global New Summ action - save current then create
NA_SHOW 1 Global New Summ action - show current
TC_ABSAVE 'Possible Missing Text' Global -
TC_BLR_CLEAR 'Clear Previous Boilerplate Text' Global -
TC_EMPTY_SUMM 'Empty Note' Global -
TC_MISSING_FIELDS 'Unable to save' Global -
TC_NEW_SAVE2 'Create New Summary' Global -
TC_NEW_SAVE3 'Create New Addendum' Global -
TC_NEW_SAVE4 'Edit Different Summary' Global -
TC_NEW_SAVE5 'Create New Interdisciplinary Entry' Global -
TC_NO_BOIL 'Load Boilerplate Text' Global -
TC_NO_LOCK 'Unable to Lock Summary' Global -
TC_RELEASE 'Release Document' Global 'Do you want to release this discharge summary?';
TX_ABSAVE 'It appears the session terminated abnormally when this' + CRLF + Global -
TX_ADDEND_NO 'Cannot make an addendum to a Summary that is being edited' Global -
TX_AUTH_SIGNED 'Author has not signed, are you SURE you want to sign.' +CRLF Global -
TX_BLR_CLEAR 'Do you want to clear the previously loaded boilerplate text?' Global -
TX_BOILERPLT 'You have modified the text of this Discharge Summary. Changing the title will' + Global -
TX_CAP_NO_ALERT 'Unable to Process Alert' Global -
TX_COSIGN 'Cosign Summary' Global -
TX_CREATE_ERR 'Error Creating Summary' Global -
TX_DEL_ERR 'Unable to Delete Summary' Global -
TX_DEL_OK CRLF + CRLF + 'Delete this Discharge Summary?' Global -
TX_DETACH_CNF 'Confirm Detachment' Global -
TX_DETACH_FAILURE 'Detach failed' Global -
TX_EMPTY_SUMM CRLF + CRLF + 'This discharge summary contains no text and will not be saved.' + CRLF + Global -
TX_EMPTY_SUMM1 'This document contains no text and can not be signed.' Global -
TX_MISSING_FIELDS 'This document can not be saved. An ATTENDING must first be entered.' Global -
TX_NEED_VISIT 'A visit is required before creating a new Discharge Summary.' Global -
TX_NEW_SAVE1 'You are currently editing:' + CRLF + CRLF Global -
TX_NEW_SAVE2 CRLF + CRLF + 'Do you wish to save this summary and begin a new one?' Global -
TX_NEW_SAVE3 CRLF + CRLF + 'Do you wish to save this summary and begin a new addendum?' Global -
TX_NEW_SAVE4 CRLF + CRLF + 'Do you wish to save this summary and edit the one selected?' Global -
TX_NEW_SAVE5 CRLF + CRLF + 'Do you wish to save this summary and begin a new Interdisciplinary entry?' Global -
TX_NEWTITLE 'Change Discharge Summary Title' Global -
TX_NO_ADMISSION_CAP 'No hospital admission was selected' Global -
TX_NO_ALERT 'There is insufficient information to process this alert.' + CRLF + Global -
TX_NO_BOIL 'There is no boilerplate text associated with this title.' Global -
TX_NO_FUTURE_DT 'A Reference Date/Time in the future is not allowed.' Global -
TX_NO_NOTE 'No Discharge Summary is currently being edited' Global -
TX_NO_VISIT 'Insufficient Visit Information' Global -
TX_NOPRT_NEW 'This Discharge Summary may not be printed until it is saved' Global -
TX_NOPRT_NEW_CAP 'Save Discharge Summary' Global -
TX_NOSUMM 'No Discharge Summary is currently selected.' Global -
TX_NOSUMM_CAP 'No Summary Selected' Global -
TX_NOT_INPATIENT 'Discharge Summaries are only applicable to hospital admissions.' Global -
TX_RELEASE 'Do you want to release this summary from DRAFT mode to UNSIGNED' + CRLF + Global -
TX_REQ2 CRLF + CRLF + Global -
TX_REQD_ADDM 'The following information is required to save an addendum - ' + CRLF Global -
TX_REQD_COSIG CRLF + 'Attending Physician' Global -
TX_REQD_SUMM 'The following information is required to save a Discharge Summary - ' + CRLF 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_NOTE 'Save Discharge Summary' Global -
TX_SIGN 'Sign Summary' Global -
TX_SIGN_ERR 'Unable to Sign Summary' Global -
TX_UPDATE_ERR 'Error Updating Summary' Global -
TYP_DC_SUMM 244 Global -


Module Source

1     unit fDCSumm;
2     
3     
4     interface
5     
6     uses
7       Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
8       fHSplit, StdCtrls, ExtCtrls, Menus, ComCtrls, ORCtrls, ORFn, uConst, ORDtTm,
9       uPCE, ORClasses, fDrawers, rDCSumm, uDocTree, uDCSumm, uTIU, fPrintList,
10      VA508AccessibilityManager, fBase508Form, VA508ImageListLabeler;
11    
12    type
13      TfrmDCSumm = class(TfrmHSplit)
14        mnuSumms: TMainMenu;
15        mnuView: TMenuItem;
16        mnuViewChart: TMenuItem;
17        mnuChartReports: TMenuItem;
18        mnuChartLabs: TMenuItem;
19        mnuChartDCSumm: TMenuItem;
20        mnuChartCslts: TMenuItem;
21        mnuChartSumms: TMenuItem;
22        mnuChartOrders: TMenuItem;
23        mnuChartMeds: TMenuItem;
24        mnuChartProbs: TMenuItem;
25        mnuChartCover: TMenuItem;
26        Z1: TMenuItem;
27        mnuViewDetail: TMenuItem;
28        mnuAct: TMenuItem;
29        mnuActNew: TMenuItem;
30        Z2: TMenuItem;
31        mnuActSave: TMenuItem;
32        mnuActDelete: TMenuItem;
33        mnuActEdit: TMenuItem;
34        mnuActSign: TMenuItem;
35        mnuActAddend: TMenuItem;
36        lblSumms: TOROffsetLabel;
37        pnlRead: TPanel;
38        lblTitle: TOROffsetLabel;
39        memSumm: TRichEdit;
40        pnlWrite: TPanel;
41        memNewSumm: TRichEdit;
42        Z3: TMenuItem;
43        mnuViewAll: TMenuItem;
44        mnuViewByAuthor: TMenuItem;
45        mnuViewByDate: TMenuItem;
46        mnuViewUncosigned: TMenuItem;
47        mnuViewUnsigned: TMenuItem;
48        mnuActSignList: TMenuItem;
49        cmdNewSumm: TORAlignButton;
50        lblSpace1: TLabel;
51        cmdPCE: TORAlignButton;
52        popSummMemo: TPopupMenu;
53        popSummMemoCut: TMenuItem;
54        popSummMemoCopy: TMenuItem;
55        popSummMemoPaste: TMenuItem;
56        Z10: TMenuItem;
57        popSummMemoSignList: TMenuItem;
58        popSummMemoDelete: TMenuItem;
59        popSummMemoEdit: TMenuItem;
60        popSummMemoSave: TMenuItem;
61        popSummMemoSign: TMenuItem;
62        popSummList: TPopupMenu;
63        popSummListAll: TMenuItem;
64        popSummListByAuthor: TMenuItem;
65        popSummListByDate: TMenuItem;
66        popSummListUncosigned: TMenuItem;
67        popSummListUnsigned: TMenuItem;
68        pnlFields: TORAutoPanel;
69        sptVert: TSplitter;
70        memPCEShow: TRichEdit;
71        mnuActIdentifyAddlSigners: TMenuItem;
72        popSummMemoAddlSign: TMenuItem;
73        Z11: TMenuItem;
74        popSummMemoSpell: TMenuItem;
75        popSummMemoGrammar: TMenuItem;
76        mnuViewCustom: TMenuItem;
77        N1: TMenuItem;
78        mnuViewSaveAsDefault: TMenuItem;
79        mnuViewReturnToDefault: TMenuItem;
80        pnlDrawers: TPanel;
81        lstSumms: TORListBox;
82        N2: TMenuItem;
83        popSummMemoTemplate: TMenuItem;
84        mnuOptions: TMenuItem;
85        mnuEditTemplates: TMenuItem;
86        mnuNewTemplate: TMenuItem;
87        splDrawers: TSplitter;
88        N3: TMenuItem;
89        mnuEditSharedTemplates: TMenuItem;
90        mnuNewSharedTemplate: TMenuItem;
91        timAutoSave: TTimer;
92        cmdChange: TButton;
93        lblNewTitle: TStaticText;
94        lblVisit: TStaticText;
95        lblRefDate: TStaticText;
96        lblCosigner: TStaticText;
97        lblDictator: TStaticText;
98        lblDischarge: TStaticText;
99        popSummMemoPaste2: TMenuItem;
100       popSummMemoReformat: TMenuItem;
101       Z4: TMenuItem;
102       mnuActChange: TMenuItem;
103       mnuActLoadBoiler: TMenuItem;
104       bvlNewTitle: TBevel;
105       popSummMemoSaveContinue: TMenuItem;
106       N4: TMenuItem;
107       mnuEditDialgFields: TMenuItem;
108       lvSumms: TCaptionListView;
109       sptList: TSplitter;
110       N5: TMenuItem;
111       popSummListExpandSelected: TMenuItem;
112       popSummListExpandAll: TMenuItem;
113       popSummListCollapseSelected: TMenuItem;
114       popSummListCollapseAll: TMenuItem;
115       tvSumms: TORTreeView;
116       popSummListCustom: TMenuItem;
117       N6: TMenuItem;
118       popSummListDetachFromIDParent: TMenuItem;
119       mnuActDetachFromIDParent: TMenuItem;
120       popSummListAddIDEntry: TMenuItem;
121       mnuActAddIDEntry: TMenuItem;
122       N7: TMenuItem;
123       mnuIconLegend: TMenuItem;
124       dlgFindText: TFindDialog;
125       popSummMemoFind: TMenuItem;
126       dlgReplaceText: TReplaceDialog;
127       N8: TMenuItem;
128       popSummMemoReplace: TMenuItem;
129       mnuChartSurgery: TMenuItem;
130       mnuActAttachtoIDParent: TMenuItem;
131       popSummListAttachtoIDParent: TMenuItem;
132       popSummMemoAddend: TMenuItem;
133       N9: TMenuItem;
134       popSummMemoPreview: TMenuItem;
135       popSummMemoInsTemplate: TMenuItem;
136       popSummMemoEncounter: TMenuItem;
137       mnuViewInformation: TMenuItem;
138       mnuViewDemo: TMenuItem;
139       mnuViewVisits: TMenuItem;
140       mnuViewPrimaryCare: TMenuItem;
141       mnuViewMyHealtheVet: TMenuItem;
142       mnuInsurance: TMenuItem;
143       mnuViewFlags: TMenuItem;
144       mnuViewReminders: TMenuItem;
145       mnuViewRemoteData: TMenuItem;
146       mnuViewPostings: TMenuItem;
147       imgLblNotes: TVA508ImageListLabeler;
148       imgLblImages: TVA508ImageListLabeler;
149       procedure mnuChartTabClick(Sender: TObject);
150       procedure lstSummsClick(Sender: TObject);
151       procedure pnlRightResize(Sender: TObject);
152       procedure cmdNewSummClick(Sender: TObject);
153       procedure memNewSummChange(Sender: TObject);
154       procedure mnuActNewClick(Sender: TObject);
155       procedure mnuActAddIDEntryClick(Sender: TObject);
156       procedure mnuActSaveClick(Sender: TObject);
157       procedure mnuViewClick(Sender: TObject);
158       procedure mnuActAddendClick(Sender: TObject);
159       procedure mnuActDetachFromIDParentClick(Sender: TObject);
160       procedure mnuActSignListClick(Sender: TObject);
161       procedure mnuActDeleteClick(Sender: TObject);
162       procedure mnuActEditClick(Sender: TObject);
163       procedure mnuActSignClick(Sender: TObject);
164       procedure cmdOrdersClick(Sender: TObject);
165       procedure cmdPCEClick(Sender: TObject);
166       procedure popSummMemoCutClick(Sender: TObject);
167       procedure popSummMemoCopyClick(Sender: TObject);
168       procedure popSummMemoPasteClick(Sender: TObject);
169       procedure popSummMemoPopup(Sender: TObject);
170       procedure pnlWriteResize(Sender: TObject);
171       procedure FormCreate(Sender: TObject);
172       procedure mnuViewDetailClick(Sender: TObject);
173       procedure FormClose(Sender: TObject; var Action: TCloseAction);
174       procedure mnuActIdentifyAddlSignersClick(Sender: TObject);
175       procedure popSummMemoAddlSignClick(Sender: TObject);
176       procedure popSummMemoSpellClick(Sender: TObject);
177       procedure popSummMemoGrammarClick(Sender: TObject);
178       procedure mnuViewSaveAsDefaultClick(Sender: TObject);
179       procedure mnuViewReturntoDefaultClick(Sender: TObject);
180       procedure popSummMemoTemplateClick(Sender: TObject);
181       procedure mnuNewTemplateClick(Sender: TObject);
182       procedure mnuEditTemplatesClick(Sender: TObject);
183       procedure mnuOptionsClick(Sender: TObject);
184       procedure mnuEditSharedTemplatesClick(Sender: TObject);
185       procedure mnuNewSharedTemplateClick(Sender: TObject);
186       procedure FormDestroy(Sender: TObject);
187       procedure timAutoSaveTimer(Sender: TObject);
188       procedure cmdChangeClick(Sender: TObject);
189       procedure popSummMemoReformatClick(Sender: TObject);
190       procedure mnuActChangeClick(Sender: TObject);
191       procedure mnuActLoadBoilerClick(Sender: TObject);
192       procedure popSummMemoSaveContinueClick(Sender: TObject);
193       procedure mnuEditDialgFieldsClick(Sender: TObject);
194       procedure tvSummsChange(Sender: TObject; Node: TTreeNode);
195       procedure tvSummsClick(Sender: TObject);
196       procedure tvSummsCollapsed(Sender: TObject; Node: TTreeNode);
197       procedure tvSummsExpanded(Sender: TObject; Node: TTreeNode);
198       procedure tvSummsStartDrag(Sender: TObject;
199         var DragObject: TDragObject);
200       procedure tvSummsDragDrop(Sender, Source: TObject; X, Y: Integer);
201       procedure tvSummsDragOver(Sender, Source: TObject; X, Y: Integer;
202         State: TDragState; var Accept: Boolean);
203       procedure lvSummsColumnClick(Sender: TObject; Column: TListColumn);
204       procedure lvSummsCompare(Sender: TObject; Item1, Item2: TListItem; Data: Integer; var Compare: Integer);
205       procedure lvSummsSelectItem(Sender: TObject; Item: TListItem; Selected: Boolean);
206       procedure popSummListExpandAllClick(Sender: TObject);
207       procedure popSummListCollapseAllClick(Sender: TObject);
208       procedure popSummListExpandSelectedClick(Sender: TObject);
209       procedure popSummListCollapseSelectedClick(Sender: TObject);
210       procedure popSummListPopup(Sender: TObject);
211       procedure lvSummsResize(Sender: TObject);
212       procedure mnuIconLegendClick(Sender: TObject);
213       procedure popSummMemoFindClick(Sender: TObject);
214       procedure dlgFindTextFind(Sender: TObject);
215       procedure dlgReplaceTextReplace(Sender: TObject);
216       procedure dlgReplaceTextFind(Sender: TObject);
217       procedure popSummMemoReplaceClick(Sender: TObject);
218       procedure mnuActAttachtoIDParentClick(Sender: TObject);
219       procedure memNewSummKeyUp(Sender: TObject; var Key: Word;
220         Shift: TShiftState);
221       procedure sptHorzCanResize(Sender: TObject; var NewSize: Integer; var Accept: Boolean);
222       procedure popSummMemoPreviewClick(Sender: TObject);
223       procedure popSummMemoInsTemplateClick(Sender: TObject);
224       procedure ViewInfo(Sender: TObject);
225       procedure mnuViewInformationClick(Sender: TObject);
226     private
227       FEditingIndex: Integer;                      // index of Summary being currently edited
228       FChanged: Boolean;                           // true if any text has changed in the Summary
229       FEditCtrl: TCustomEdit;
230       FDischargeDate: TFMDateTime;
231       FSilent: Boolean;
232       FCurrentContext: TTIUContext;
233       FDefaultContext: TTIUContext;
234       FImageFlag: TBitmap;
235       FEditDCSumm: TEditDCSummRec;
236       FShowAdmissions: Boolean;
237       FVerifySummTitle: Integer;
238       FDocList: TStringList;
239       FConfirmed: boolean;
240       FDeleted: boolean;
241       FLastSummID: string;
242       function NoSummSelected : Boolean;
243       procedure ClearEditControls;
244       function StartNewEdit(NewNoteType: integer): Boolean;
245       procedure DoAutoSave(Suppress: integer = 1);
246       function LacksRequiredForCreate: Boolean;
247       function GetTitleText(AnIndex: Integer): string;
248       //function MakeTitleText(IsAddendum: Boolean = False): string;
249       procedure SetEditingIndex(const Value: Integer);
250       procedure DisplayPCE;
251       function  LockSumm(AnIEN: Int64): Boolean;
252       procedure InsertAddendum;
253       procedure InsertNewSumm(IsIDChild: boolean; AnIDParent: integer);
254       procedure LoadForEdit(PreserveValues: Boolean);
255       procedure RemovePCEFromChanges(IEN: Int64; AVisitStr: string = '');
256       procedure SaveEditedSumm(var Saved: Boolean);
257       procedure SaveCurrentSumm(var Saved: Boolean);
258       procedure ShowPCEControls(ShouldShow: Boolean);
259       function  TitleText(AnIndex: Integer): string;
260       procedure ProcessNotifications;
261       procedure SetViewContext(AContext: TTIUContext);
262       function GetDrawers: TfrmDrawers;
263       property EditingIndex: Integer read FEditingIndex write SetEditingIndex;
264       function VerifySummTitle: Boolean;
265       //  added for treeview - see also uDocTree.pas
266       procedure LoadSumms;
267       procedure UpdateTreeView(DocList: TStringList; Tree: TORTreeView);
268       procedure  EnableDisableIDNotes;
269       procedure DoAttachIDChild(AChild, AParent: TORTreeNode);
270       function SetSummTreeLabel(AContext: TTIUContext): string;
271     public
272       function  AllowContextChange(var WhyNot: string): Boolean; override;
273       procedure ClearPtData; override;
274       procedure DisplayPage; override;
275       procedure RequestPrint; override;
276       procedure RequestMultiplePrint(AForm: TfrmPrintList);
277       procedure SetFontSize(NewFontSize: Integer); override;
278       procedure SaveSignItem(const ItemID, ESCode: string);
279       procedure LstSummsToPrint;
280     published
281       property Drawers: TfrmDrawers read GetDrawers; // Keep Drawers published
282     end;
283   
284   var
285     frmDCSumm: TfrmDCSumm;
286   
287   implementation
288   
289   {$R *.DFM}
290   
291   uses fFrame, fVisit, fEncnt, rCore, uCore, fNoteBA, fNoteBD, fSignItem, fEncounterFrame,
292        rPCE, Clipbrd, fNotePrt, fAddlSigners, fNoteDR, uSpell, rVitals, fTIUView,
293        fTemplateEditor, rTIU, fDCSummProps, fNotesBP, fTemplateFieldEditor, uTemplates,
294        fReminderDialog, dShared, rTemplates, fIconLegend, fNoteIDParents,
295        fTemplateDialog, uVA508CPRSCompatibility, VA508AccessibilityRouter;
296   
297   const
298     NA_CREATE     = 0;                             // New Summ action - create new Summ
299     NA_SHOW       = 1;                             // New Summ action - show current
300     NA_SAVECREATE = 2;                             // New Summ action - save current then create
301   
302     TYP_DC_SUMM = 244;
303     DC_NEW_SUMM = -50;                             // Holder IEN for a new Summary
304     DC_ADDENDUM = -60;                             // Holder IEN for a new addendum
305   
306     DC_ACT_NEW_SUMM  = 2;
307     DC_ACT_ADDENDUM  = 3;
308     DC_ACT_EDIT_SUMM = 4;
309     DC_ACT_ID_ENTRY  = 5;
310    
311     TX_NEED_VISIT = 'A visit is required before creating a new Discharge Summary.';
312     TX_NO_VISIT   = 'Insufficient Visit Information';
313     TX_BOILERPLT  = 'You have modified the text of this Discharge Summary.  Changing the title will' +
314                     ' discard the Discharge Summary text.' + CRLF + 'Do you wish to continue?';
315     TX_NEWTITLE   = 'Change Discharge Summary Title';
316     TX_REQD_SUMM  = 'The following information is required to save a Discharge Summary - ' + CRLF;
317     TX_REQD_ADDM  = 'The following information is required to save an addendum - ' + CRLF;
318     TX_REQD_COSIG = CRLF + 'Attending Physician';
319     TX_REQ2       = CRLF + CRLF +
320                     'It is recommended that these fields be entered before continuing' + CRLF +
321                     'to prevent losing the summary should the application time out.';
322     TX_CREATE_ERR = 'Error Creating Summary';
323     TX_UPDATE_ERR = 'Error Updating Summary';
324     TX_NO_NOTE    = 'No Discharge Summary is currently being edited';
325     TX_SAVE_NOTE  = 'Save Discharge Summary';
326     TX_ADDEND_NO  = 'Cannot make an addendum to a Summary that is being edited';
327     TX_DEL_OK     = CRLF + CRLF + 'Delete this Discharge Summary?';
328     TX_DEL_ERR    = 'Unable to Delete Summary';
329     TX_SIGN       = 'Sign Summary';
330     TX_COSIGN     = 'Cosign Summary';
331     TX_SIGN_ERR   = 'Unable to Sign Summary';
332   
333     TX_NOSUMM     = 'No Discharge Summary is currently selected.';
334     TX_NOSUMM_CAP = 'No Summary Selected';
335     TX_NOPRT_NEW  = 'This Discharge Summary may not be printed until it is saved';
336     TX_NOPRT_NEW_CAP = 'Save Discharge Summary';
337     TX_NOT_INPATIENT = 'Discharge Summaries are only applicable to hospital admissions.';
338     TX_NO_ADMISSION_CAP  = 'No hospital admission was selected';
339     TX_NO_ALERT   = 'There is insufficient information to process this alert.' + CRLF +
340                     'Either the alert has already been deleted, or it contained invalid data.' + CRLF + CRLF +
341                     'Click the NEXT button if you wish to continue processing more alerts.';
342     TX_CAP_NO_ALERT = 'Unable to Process Alert';
343     TX_NO_FUTURE_DT = 'A Reference Date/Time in the future is not allowed.';
344     TX_RELEASE      = 'Do you want to release this summary from DRAFT mode to UNSIGNED' + CRLF +
345                       'status? This does not release the summary as the official,' + CRLF +
346                       'completed Discharge Summary until it is COSIGNED.';
347                       //'Do you want to release this discharge summary?';
348     TC_RELEASE      = 'Release Document';
349     TX_NEW_SAVE1    = 'You are currently editing:' + CRLF + CRLF;
350     TX_NEW_SAVE2    = CRLF + CRLF + 'Do you wish to save this summary and begin a new one?';
351     TX_NEW_SAVE3    = CRLF + CRLF + 'Do you wish to save this summary and begin a new addendum?';
352     TX_NEW_SAVE4    = CRLF + CRLF + 'Do you wish to save this summary and edit the one selected?';
353     TX_NEW_SAVE5    = CRLF + CRLF + 'Do you wish to save this summary and begin a new Interdisciplinary entry?';
354     TC_NEW_SAVE2    = 'Create New Summary';
355     TC_NEW_SAVE3    = 'Create New Addendum';
356     TC_NEW_SAVE4    = 'Edit Different Summary';
357     TC_NEW_SAVE5    = 'Create New Interdisciplinary Entry';
358     TC_NO_LOCK      = 'Unable to Lock Summary';
359     TX_EMPTY_SUMM   = CRLF + CRLF + 'This discharge summary contains no text and will not be saved.' + CRLF +
360                       'Do you wish to delete this discharge summary?';
361     TC_EMPTY_SUMM   = 'Empty Note';
362     TX_EMPTY_SUMM1   = 'This document contains no text and can not be signed.';
363     TX_ABSAVE       = 'It appears the session terminated abnormally when this' + CRLF +
364                       'note was last edited. Some text may not have been saved.' + CRLF + CRLF +
365                       'Do you wish to continue and sign the note?';
366     TC_ABSAVE       = 'Possible Missing Text';
367     TX_NO_BOIL      = 'There is no boilerplate text associated with this title.';
368     TC_NO_BOIL      = 'Load Boilerplate Text';
369     TX_BLR_CLEAR    = 'Do you want to clear the previously loaded boilerplate text?';
370     TC_BLR_CLEAR    = 'Clear Previous Boilerplate Text';
371     TX_MISSING_FIELDS = 'This document can not be saved.  An ATTENDING must first be entered.';
372     TC_MISSING_FIELDS = 'Unable to save';
373     TX_DETACH_CNF     = 'Confirm Detachment';
374     TX_DETACH_FAILURE = 'Detach failed';
375     TX_RETRACT_CAP    = 'Retraction Notice';
376     TX_RETRACT        = 'This document will now be RETRACTED.  As Such, it has been removed' +CRLF +
377                         ' from public view, and from typical Releases of Information,' +CRLF +
378                         ' but will remain indefinitely discoverable to HIMS.' +CRLF +CRLF;
379     TX_AUTH_SIGNED    = 'Author has not signed, are you SURE you want to sign.' +CRLF;
380   
381   var
382     uPCEShow, uPCEEdit:  TPCEData;
383     ViewContext: Integer;
384     frmDrawers: TfrmDrawers;
385     uDCSummContext: TTIUContext;
386     ColumnToSort: Integer;
387     ColumnSortForward: Boolean;
388     uChanging: Boolean;
389     uIDNotesActive: Boolean;
390   
391   { TPage common methods --------------------------------------------------------------------- }
392   
393   function TfrmDCSumm.AllowContextChange(var WhyNot: string): Boolean;
394   begin
395     dlgFindText.CloseDialog;
396     Result := inherited AllowContextChange(WhyNot);  // sets result = true
397     if Assigned(frmTemplateDialog) then
398       if Screen.ActiveForm = frmTemplateDialog then
399       //if (fsModal in frmTemplateDialog.FormState) then
400       case BOOLCHAR[frmFrame.CCOWContextChanging] of
401         '1': begin
402                WhyNot := 'A template in progress will be aborted.  ';
403                Result := False;
404              end;
405         '0': begin
406                if WhyNot = 'COMMIT' then
407                  begin
408                    FSilent := True;
409                    frmTemplateDialog.Silent := True;
410                    frmTemplateDialog.ModalResult := mrCancel;
411                  end;
412              end;
413       end;
414     if EditingIndex <> -1 then
415       case BOOLCHAR[frmFrame.CCOWContextChanging] of
416       '1': begin
417                if memNewSumm.GetTextLen > 0 then
418                  WhyNot := WhyNot + 'A discharge summary in progress will be saved as unsigned.  '
419                else
420                  WhyNot := WhyNot + 'An empty discharge summary in progress will be deleted.  ';
421              Result := False;
422            end;
423       '0': begin
424              if WhyNot = 'COMMIT' then FSilent := True;
425              SaveCurrentSumm(Result);
426            end;
427     end;
428     if Assigned(frmEncounterFrame) then
429       if Screen.ActiveForm = frmEncounterFrame then
430       //if (fsModal in frmEncounterFrame.FormState) then
431       case BOOLCHAR[frmFrame.CCOWContextChanging] of
432         '1': begin
433                WhyNot := WhyNot + 'Encounter information being edited will not be saved';
434                Result := False;
435              end;
436         '0': begin
437                if WhyNot = 'COMMIT' then
438                  begin
439                    FSilent := True;
440                    frmEncounterFrame.Abort := False;
441                    frmEncounterFrame.Cancel := True;
442                  end;
443              end;
444       end;
445   end;
446   
447   procedure TfrmDCSumm.LstSummsToPrint;
448   var
449     AParentID: string;
450     SavedDocID: string;
451     Saved: boolean;
452   begin
453     inherited;
454     if lstSumms.ItemIEN = 0 then exit;
455     SavedDocID := lstSumms.ItemID;
456     if EditingIndex <> -1 then
457     begin
458       SaveCurrentSumm(Saved);
459       if not Saved then Exit;
460       LoadSumms;
461       with tvSumms do Selected := FindPieceNode(SavedDocID, U, Items.GetFirstNode);
462     end;
463     if tvSumms.Selected = nil then exit;
464     AParentID := frmPrintList.SelectParentFromList(tvSumms,CT_DCSUMM);
465     if AParentID = '' then exit;
466     with tvSumms do Selected := FindPieceNode(AParentID, 1, U, Items.GetFirstNode);
467   end;
468   
469   procedure TfrmDCSumm.ClearPtData;
470   { clear all controls that contain patient specific information }
471   begin
472     inherited ClearPtData;
473     ClearEditControls;
474     uChanging := True;
475     tvSumms.Items.BeginUpdate;
476     KillDocTreeObjects(tvSumms);
477     tvSumms.Items.Clear;
478     tvSumms.Items.EndUpdate;
479     uChanging := False;
480     lstSumms.Clear;
481     memSumm.Clear;
482     memPCEShow.Clear;
483     uPCEShow.Clear;
484     uPCEEdit.Clear;
485     frmDrawers.ResetTemplates;
486   end;
487   
488   procedure TfrmDCSumm.DisplayPage;
489   { causes page to be visible and conditionally executes initialization code }
490   begin
491     inherited DisplayPage;
492     frmFrame.ShowHideChartTabMenus(mnuViewChart);
493     frmFrame.mnuFilePrint.Tag := CT_DCSUMM;
494     frmFrame.mnuFilePrint.Enabled := True;
495     frmFrame.mnuFilePrintSetup.Enabled := True;
496     frmFrame.mnuFilePrintSelectedItems.Enabled := True;
497     if InitPage then
498     begin
499       EnableDisableIDNotes;
500       FDefaultContext := GetCurrentDCSummContext;
501       FCurrentContext := FDefaultContext;
502       popSummMemoSpell.Visible   := SpellCheckAvailable;
503       popSummMemoGrammar.Visible := popSummMemoSpell.Visible;
504       Z11.Visible                := popSummMemoSpell.Visible;
505       timAutoSave.Interval := User.AutoSave * 1000;  // convert seconds to milliseconds
506       SetEqualTabStops(memNewSumm);
507     end;
508     // to indent the right margin need to set Paragraph.RightIndent for each paragraph?
509     if InitPatient and not (CallingContext = CC_NOTIFICATION) then
510       begin
511         SetViewContext(FDefaultContext);
512       end;
513     case CallingContext of
514       CC_INIT_PATIENT: if not InitPatient then
515                          begin
516                            SetViewContext(FDefaultContext);
517                          end;
518     CC_NOTIFICATION: ProcessNotifications;
519     end;
520   end;
521   
522   procedure TfrmDCSumm.RequestPrint;
523   var
524     Saved: Boolean;
525   begin
526     with lstSumms do
527     begin
528       if ItemIndex = EditingIndex then  
529       //if ItemIEN < 0 then
530       begin
531         SaveCurrentSumm(Saved);
532         if not Saved then Exit;
533       end;
534       if ItemIEN > 0 then PrintNote(ItemIEN, MakeDCSummDisplayText(Items[ItemIndex])) else
535       begin
536         if ItemIEN = 0 then InfoBox(TX_NO_NOTE, TX_NOSUMM_CAP, MB_OK);
537         if ItemIEN < 0 then InfoBox(TX_NOPRT_NEW, TX_NOPRT_NEW_CAP, MB_OK);
538       end;
539     end;
540   end;
541   
542   procedure TfrmDCSumm.RequestMultiplePrint(AForm: TfrmPrintList);
543   var
544     NoteIEN: int64;
545     i: integer;
546   begin
547     with AForm.lbIDParents do
548     begin
549       for i := 0 to Items.Count - 1 do
550        begin
551          if Selected[i] then
552           begin
553            NoteIEN := ItemIEN;  //StrToInt64def(Piece(TStringList(Items.Objects[i])[0],U,1),0);
554            if NoteIEN > 0 then PrintNote(NoteIEN, DisplayText[i], TRUE) else
555             begin
556               if ItemIEN = 0 then InfoBox(TX_NO_NOTE, TX_NOSUMM_CAP, MB_OK);
557               if ItemIEN < 0 then InfoBox(TX_NOPRT_NEW, TX_NOPRT_NEW_CAP, MB_OK);
558             end;
559           end; {if selected}
560        end; {for}
561     end {with}
562   end;
563   
564   procedure TfrmDCSumm.SetFontSize(NewFontSize: Integer);
565   { adjusts the font size of any controls that don't have ParentFont = True }
566   begin
567     inherited SetFontSize(NewFontSize);
568     memSumm.Font.Size := NewFontSize;
569     memNewSumm.Font.Size := NewFontSize;
570     lblTitle.Font.Size := NewFontSize;
571     frmDrawers.Font.Size := NewFontSize;
572     SetEqualTabStops(memNewSumm);
573     // adjust heights of pnlAction, pnlFields, and lstEncntShow
574   end;
575   
576   procedure TfrmDCSumm.mnuChartTabClick(Sender: TObject);
577   { reroute to Chart Tab menu of the parent form: frmFrame }
578   begin
579     inherited;
580     frmFrame.mnuChartTabClick(Sender);
581   end;
582   
583   { General procedures ----------------------------------------------------------------------- }
584   
585   procedure TfrmDCSumm.ClearEditControls;
586   { resets controls used for entering a new Discharge Summary }
587   begin
588     // clear FEditDCSumm (should FEditDCSumm be an object with a clear method?)
589     with FEditDCSumm do
590     begin
591       DocType              := 0;
592       EditIEN              := 0;
593       Title                := 0;
594       TitleName            := '';
595       AdmitDateTime        := 0;
596       DischargeDateTime    := 0;
597       DictDateTime         := 0;
598       Dictator             := 0;
599       DictatorName         := '';
600       Cosigner             := 0;
601       CosignerName         := '';
602       Transcriptionist     := 0;
603       TranscriptionistName := '';
604       Attending            := 0;
605       AttendingName        := '';
606       Urgency              := '';
607       UrgencyName          := '';
608       Location             := 0;
609       LocationName         := '';
610       Addend               := 0;
611       VisitStr             := '';
612       {LastCosigner & LastCosignerName aren't cleared because they're used as default for next note.}
613       Lines                := nil;
614     end;
615     // clear the editing controls (also clear the new labels?)
616     memNewSumm.Clear;
617     timAutoSave.Enabled := False;
618     // clear the PCE object for editing
619     uPCEEdit.Clear;
620     // set the tracking variables to initial state
621     EditingIndex := -1;
622     FChanged := False;
623   end;
624   
625   procedure TfrmDCSumm.ShowPCEControls(ShouldShow: Boolean);
626   begin
627     sptVert.Visible    := ShouldShow;
628     memPCEShow.Visible := ShouldShow;
629     if(ShouldShow) then
630       sptVert.Top := memPCEShow.Top - sptVert.Height;
631     memSumm.Invalidate;
632   end;
633   
634   procedure TfrmDCSumm.DisplayPCE;
635   { displays PCE information if appropriate & enables/disabled editing of PCE data }
636   var
637     VitalStr:   TStringlist;
638     NoPCE:      boolean;
639     ActionSts: TActionRec;
640   
641   begin
642     memPCEShow.Clear;
643     with lstSumms do if ItemIndex = EditingIndex then
644     begin
645       with uPCEEdit do
646       begin
647         AddStrData(memPCEShow.Lines);
648         NoPCE := (memPCEShow.Lines.Count = 0);
649         VitalStr  := TStringList.create;
650         try
651           GetVitalsFromDate(VitalStr, uPCEEdit);
652           AddVitalData(VitalStr, memPCEShow.Lines);
653         finally
654           VitalStr.free;
655         end;
656         cmdPCE.Enabled := CanEditPCE(uPCEEdit);
657         ShowPCEControls(cmdPCE.Enabled or (memPCEShow.Lines.Count > 0));
658         if(NoPCE and memPCEShow.Visible) then
659           memPCEShow.Lines.Insert(0, TX_NOPCE);
660   
661         frmDrawers.DisplayDrawers(TRUE, [odTemplates],[odTemplates]);
662         cmdNewSumm.Visible := FALSE;
663         lblSpace1.Top := cmdPCE.Top - lblSpace1.Height;
664       end;
665     end else
666     begin
667       cmdPCE.Enabled := False;
668   
669       frmDrawers.DisplayDrawers(FALSE);
670       cmdNewSumm.Visible := TRUE;
671       lblSpace1.Top := cmdNewSumm.Top - lblSpace1.Height;
672   
673       ActOnDocument(ActionSts, lstSumms.ItemIEN, 'VIEW');
674       if ActionSts.Success then
675       begin
676         StatusText('Retrieving encounter information...');
677         with uPCEShow do
678         begin
679           NoteDateTime := MakeFMDateTime(Piece(lstSumms.Items[lstSumms.ItemIndex], U, 3));
680           PCEForNote(lstSumms.ItemIEN, uPCEEdit);
681           AddStrData(memPCEShow.Lines);
682           NoPCE := (memPCEShow.Lines.Count = 0);
683           VitalStr  := TStringList.create;
684           try
685             GetVitalsFromNote(VitalStr, uPCEShow, lstSumms.ItemIEN);
686             AddVitalData(VitalStr, memPCEShow.Lines);
687           finally
688             VitalStr.free;
689           end;
690           ShowPCEControls(memPCEShow.Lines.Count > 0);
691           if(NoPCE and memPCEShow.Visible) then
692             memPCEShow.Lines.Insert(0, TX_NOPCE);
693         end;
694         StatusText('');
695       end
696       else
697         ShowPCEControls(FALSE);
698     end; {if ItemIndex}
699     memPCEShow.SelStart := 0;
700     popSummMemoEncounter.Enabled := cmdPCE.Enabled;
701   end;
702   
703   procedure TfrmDCSumm.InsertNewSumm(IsIDChild: boolean; AnIDParent: integer);
704   { creates the editing context for a new Discharge Summary & inserts stub into top of view list}
705   const
706     USE_CURRENT_VISITSTR = -2;
707   var
708     EnableAutosave, HaveRequired, Saved: Boolean;
709     CreatedSumm: TCreatedDoc;
710     ListItemForEdit: string;
711     TmpBoilerPlate: TStringList;
712     tmpNode: TTreeNode;
713     x, WhyNot: string;
714     DocInfo: string;
715   begin
716     EnableAutosave := FALSE;
717     TmpBoilerPlate := nil;
718     try
719       ClearEditControls;
720       FShowAdmissions := True;
721       FillChar(FEditDCSumm, SizeOf(FEditDCSumm), 0);  //v15.7
722       with FEditDCSumm do
723       begin
724         EditIEN               := 0;
725         DocType               := TYP_DC_SUMM;
726         Title                 := DfltDCSummTitle;
727         TitleName             := DfltDCSummTitleName;
728         if IsIDChild and (not CanTitleBeIDChild(Title, WhyNot)) then
729           begin
730             Title := 0;
731             TitleName := '';
732           end;
733         DictDateTime          := FMNow;
734         Dictator              := User.DUZ;
735         DictatorName          := User.Name;
736         if IsIDChild then
737           IDParent            := AnIDParent
738         else
739           IDParent   := 0;
740       end;
741       // check to see if interaction necessary to get required fields
742       if LacksRequiredForCreate or VerifySummTitle
743         then HaveRequired := ExecuteDCSummProperties(FEditDCSumm, ListItemForEdit, FShowAdmissions, IsIDChild)
744         else HaveRequired := True;
745       if HaveRequired then
746       begin
747         if ListItemForEdit <> '' then
748           begin
749             lstSumms.ItemIndex := -1;
750             lstSumms.SelectByID(Piece(ListItemForEdit, U, 1));
751             if lstSumms.ItemIndex < 0 then
752               begin
753                 lstSumms.Items.Insert(0, ListItemForEdit);
754                 lstSumms.ItemIndex := 0;
755               end;
756             if lstSumms.ItemIndex = EditingIndex then Exit;
757             if EditingIndex > -1 then
758               begin
759                 if InfoBox(TX_NEW_SAVE1 + MakeDCSummDisplayText(lstSumms.Items[EditingIndex]) + TX_NEW_SAVE2,
760                            TC_NEW_SAVE2, MB_YESNO) = IDNO then exit
761                 else
762                   begin
763                     SaveCurrentSumm(Saved);
764                     if not Saved then exit;
765                   end;
766               end;
767             //if not StartNewEdit then Exit;
768             lstSummsClick(Self);
769             LoadForEdit(True);
770             Exit;
771           end
772         else
773           begin
774             // set up uPCEEdit for entry of new note
775             uPCEEdit.UseEncounter := True;
776             uPCEEdit.NoteDateTime := FEditDCSumm.DischargeDateTime;
777             uPCEEdit.PCEForNote(USE_CURRENT_VISITSTR, uPCEShow);
778             FEditDCSumm.NeedCPT  := uPCEEdit.CPTRequired;
779              // create the note
780             PutNewDCSumm(CreatedSumm, FEditDCSumm);
781             uPCEEdit.NoteIEN := CreatedSumm.IEN;
782             if CreatedSumm.IEN > 0 then LockDocument(CreatedSumm.IEN, CreatedSumm.ErrorText);
783             if CreatedSumm.ErrorText = '' then
784             begin
785               //x := $$RESOLVE^TIUSRVLO formatted string
786               //7348^Discharge Summary^3000913^NERD, YOURA  (N0165)^1329;Rich Vertigan;VERTIGAN,RICH^8E REHAB MED^unverified^Adm: 11/05/98;2981105.095547^        ;^^0^^^2
787               with FEditDCSumm do
788                 begin
789                   x := IntToStr(CreatedSumm.IEN) + U + TitleName + U + FloatToStr(DischargeDateTime) + U +
790                        Patient.Name + U + IntToStr(Dictator) + ';' + DictatorName + U + LocationName + U + 'new' + U +
791                        'Adm: ' + FormatFMDateTime('mmm dd,yyyy', AdmitDateTime) + ';' + FloatToStr(AdmitDateTime) + U +
792                        'Dis: ' + FormatFMDateTime('mmm dd,yyyy', DischargeDateTime) + ';' + FloatToStr(DischargeDateTime) +
793                        U + U + U + U + U + U;
794                 end;
795               lstSumms.Items.Insert(0, x);
796               uChanging := True;
797               tvSumms.Items.BeginUpdate;
798               if IsIDChild then
799                 begin
800                   tmpNode := tvSumms.FindPieceNode(IntToStr(AnIDParent), 1, U, tvSumms.Items.GetFirstNode);
801                   tmpNode.ImageIndex := IMG_IDNOTE_OPEN;
802                   tmpNode.SelectedIndex := IMG_IDNOTE_OPEN;
803                   tmpNode := tvSumms.Items.AddChildObjectFirst(tmpNode, MakeDCSummDisplayText(x), MakeDCSummTreeObject(x));
804                   tmpNode.ImageIndex := IMG_ID_CHILD;
805                   tmpNode.SelectedIndex := IMG_ID_CHILD;
806                 end
807               else
808                 begin
809                   tmpNode := tvSumms.Items.AddObjectFirst(tvSumms.Items.GetFirstNode, 'New Summary in Progress',
810                                                           MakeDCSummTreeObject('NEW^New Summary in Progress^^^^^^^^^^^%^0'));
811                   TORTreeNode(tmpNode).StringData := 'NEW^New Summary in Progress^^^^^^^^^^^%^0';
812                   tmpNode.ImageIndex := IMG_TOP_LEVEL;
813                   tmpNode := tvSumms.Items.AddChildObjectFirst(tmpNode, MakeDCSummDisplayText(x), MakeDCSummTreeObject(x));
814                   tmpNode.ImageIndex := IMG_SINGLE;
815                   tmpNode.SelectedIndex := IMG_SINGLE;
816                 end;
817               TORTreeNode(tmpNode).StringData := x;
818               tvSumms.Selected := tmpNode;
819               tvSumms.Items.EndUpdate;
820               uChanging := False;
821               Changes.Add(CH_SUM, IntToStr(CreatedSumm.IEN), GetTitleText(0), '', CH_SIGN_YES);
822               lstSumms.ItemIndex := 0;
823               EditingIndex := 0;
824               if not assigned(TmpBoilerPlate) then
825                 TmpBoilerPlate := TStringList.Create;
826               LoadBoilerPlate(TmpBoilerPlate, FEditDCSumm.Title);
827               FChanged := False;
828               cmdChangeClick(Self); // will set captions, sign state for Changes
829               lstSummsClick(Self);  // will make pnlWrite visible
830               if timAutoSave.Interval <> 0 then EnableAutosave := TRUE;
831               memNewSumm.SetFocus;
832             end else
833             begin
834               InfoBox(CreatedSumm.ErrorText, TX_CREATE_ERR, MB_OK);
835               HaveRequired := False;
836             end; {if CreatedSumm.IEN}
837           end; {loaded for edit}
838       end; {if HaveRequired}
839       if not HaveRequired then ClearEditControls;
840     finally
841       if assigned(TmpBoilerPlate) then
842       begin
843         DocInfo := MakeXMLParamTIU(IntToStr(CreatedSumm.IEN), FEditDCSumm);
844         ExecuteTemplateOrBoilerPlate(TmpBoilerPlate, FEditDCSumm.Title, ltTitle, Self, 'Title: ' + FEditDCSumm.TitleName, DocInfo);
845         QuickCopyWith508Msg(TmpBoilerPlate, memNewSumm);
846         TmpBoilerPlate.Free;
847       end;
848       if EnableAutosave then // Don't enable autosave until after dialog fields have been resolved
849         timAutoSave.Enabled := True;
850     end;
851   end;
852   
853   procedure TfrmDCSumm.InsertAddendum;
854   { sets up fields of pnlWrite to write an addendum for the selected Summary}
855   const
856     AS_ADDENDUM = True;
857     IS_ID_CHILD = False;
858   var
859     HaveRequired: Boolean;
860     CreatedSumm: TCreatedDoc;
861     ListItemForEdit: string;
862     tmpNode: TTreeNode;
863     x: string;
864   begin
865     ClearEditControls;
866     FShowAdmissions := False;
867     with FEditDCSumm do
868     begin
869       DocType          := TYP_ADDENDUM;
870       Title            := TitleForNote(lstSumms.ItemIEN);
871       TitleName        := Piece(lstSumms.Items[lstSumms.ItemIndex], U, 2);
872       if Copy(TitleName,1,1) = '+' then TitleName := Copy(TitleName, 3, 199);
873       DictDateTime     := FMNow;
874       Dictator         := User.DUZ;
875       DictatorName     := User.Name;
876       Addend           := lstSumms.ItemIEN;
877     end;
878     // check to see if interaction necessary to get required fields
879     if LacksRequiredForCreate
880       then HaveRequired := ExecuteDCSummProperties(FEditDCSumm, ListItemForEdit, FShowAdmissions, IS_ID_CHILD)
881       else HaveRequired := True;
882     if HaveRequired then
883     begin
884       with FEditDCSumm do
885         begin
886           uPCEEdit.NoteDateTime := DischargeDateTime;
887           uPCEEdit.PCEForNote(Addend, uPCEShow);
888           Location     := uPCEEdit.Location;
889           LocationName := ExternalName(uPCEEdit.Location, 44);
890           AdmitDateTime    := uPCEEdit.DateTime;
891           DischargeDateTime := StrToFMDateTime(GetDischargeDate(Patient.DFN, FloatToStr(AdmitDateTime)));
892           if DischargeDateTime <= 0 then DischargeDateTime := FMNow;
893         end;
894       PutDCAddendum(CreatedSumm, FEditDCSumm, FEditDCSumm.Addend);
895       uPCEEdit.NoteIEN := CreatedSumm.IEN;
896       if CreatedSumm.IEN > 0 then LockDocument(CreatedSumm.IEN, CreatedSumm.ErrorText);
897       if CreatedSumm.ErrorText = '' then
898       begin
899         with FEditDCSumm do
900           begin
901             x := IntToStr(CreatedSumm.IEN) + U + 'Addendum to ' + TitleName + U + FloatToStr(DischargeDateTime) + U +
902                  Patient.Name + U + IntToStr(Dictator) + ';' + DictatorName + U + LocationName + U + 'new' + U +
903                  'Adm: ' + FormatFMDateTime('mmm dd,yyyy', AdmitDateTime) + ';' + FloatToStr(AdmitDateTime) + U +
904                  'Dis: ' + FormatFMDateTime('mmm dd,yyyy', DischargeDateTime) + ';' + FloatToStr(DischargeDateTime) +
905                  U + U + U + U + U + U;
906           end;
907         lstSumms.Items.Insert(0, x);
908         uChanging := True;
909         tvSumms.Items.BeginUpdate;
910         tmpNode := tvSumms.Items.AddObjectFirst(tvSumms.Items.GetFirstNode, 'New Addendum in Progress',
911                                                 MakeDCSummTreeObject('ADDENDUM^New Addendum in Progress^^^^^^^^^^^%^0'));
912         TORTreeNode(tmpNode).StringData := 'ADDENDUM^New Addendum in Progress^^^^^^^^^^^%^0';
913         tmpNode.ImageIndex := IMG_TOP_LEVEL;
914         tmpNode := tvSumms.Items.AddChildObjectFirst(tmpNode, MakeDCSummDisplayText(x), MakeDCSummTreeObject(x));
915         TORTreeNode(tmpNode).StringData := x;
916         tmpNode.ImageIndex := IMG_ADDENDUM;
917         tmpNode.SelectedIndex := IMG_ADDENDUM;
918         tvSumms.Selected := tmpNode;
919         tvSumms.Items.EndUpdate;
920         uChanging := False;
921         Changes.Add(CH_SUM, IntToStr(CreatedSumm.IEN), GetTitleText(0), '', CH_SIGN_YES);
922         lstSumms.ItemIndex := 0;
923         EditingIndex := 0;
924         cmdChangeClick(Self); // will set captions, sign state for Changes
925         lstSummsClick(Self);  // will make pnlWrite visible
926         if timAutoSave.Interval <> 0 then timAutoSave.Enabled := True;
927         memNewSumm.SetFocus;
928       end else
929       begin
930         InfoBox(CreatedSumm.ErrorText, TX_CREATE_ERR, MB_OK);
931         HaveRequired := False;
932       end; {if CreatedNote.IEN}
933     end; {if HaveRequired}
934     if not HaveRequired then ClearEditControls;
935   end;
936   
937   procedure TfrmDCSumm.LoadForEdit(PreserveValues: Boolean);
938   { retrieves an existing Summ and places the data in the fields of pnlWrite }
939   var
940     tmpNode: TTreeNode;
941     x: string;
942   begin
943     if not PreserveValues then ClearEditControls;
944     if not LockSumm(lstSumms.ItemIEN) then Exit;
945     EditingIndex := lstSumms.ItemIndex;
946     Changes.Add(CH_SUM, lstSumms.ItemID, GetTitleText(EditingIndex), '', CH_SIGN_YES);
947     if not PreserveValues then GetDCSummForEdit(FEditDCSumm, lstSumms.ItemIEN);
948     if FEditDCSumm.Lines <> nil then memNewSumm.Lines.Assign(FEditDCSumm.Lines);
949     FChanged := False;
950     if FEditDCSumm.Title = TYP_ADDENDUM then
951     begin
952       FEditDCSumm.DocType := TYP_ADDENDUM;
953       FEditDCSumm.TitleName := Piece(lstSumms.Items[lstSumms.ItemIndex], U, 2);
954       if Copy(FEditDCSumm.TitleName,1,1) = '+' then FEditDCSumm.TitleName := Copy(FEditDCSumm.TitleName, 3, 199);
955       if CompareText(Copy(FEditDCSumm.TitleName, 1, 8), 'Addendum') <> 0
956         then FEditDCSumm.TitleName := FEditDCSumm.TitleName + 'Addendum to ';
957     end;
958   
959     uChanging := True;
960     tvSumms.Items.BeginUpdate;
961     tmpNode := tvSumms.FindPieceNode('EDIT', 1, U, nil);
962     if tmpNode = nil then
963       begin
964         tmpNode := tvSumms.Items.AddObjectFirst(tvSumms.Items.GetFirstNode, 'Summary being edited',
965                                                 MakeDCSummTreeObject('EDIT^Summary being edited^^^^^^^^^^^%^0'));
966         TORTreeNode(tmpNode).StringData := 'EDIT^Summary being edited^^^^^^^^^^^%^0';
967       end
968     else
969       tmpNode.DeleteChildren;
970     x := lstSumms.Items[lstSumms.ItemIndex];
971     tmpNode.ImageIndex := IMG_TOP_LEVEL;
972     tmpNode := tvSumms.Items.AddChildObjectFirst(tmpNode, MakeDCSummDisplayText(x), MakeDCSummTreeObject(x));
973     TORTreeNode(tmpNode).StringData := x;
974     if CompareText(Copy(FEditDCSumm.TitleName, 1, 8), 'Addendum') <> 0 then
975       tmpNode.ImageIndex := IMG_SINGLE
976     else
977       tmpNode.ImageIndex := IMG_ADDENDUM;
978     tmpNode.SelectedIndex := tmpNode.ImageIndex;
979     tvSumms.Selected := tmpNode;
980     tvSumms.Items.EndUpdate;
981     uChanging := False;
982   
983     uPCEEdit.NoteDateTime := MakeFMDateTime(Piece(lstSumms.Items[lstSumms.ItemIndex], U, 3));
984     uPCEEdit.PCEForNote(lstSumms.ItemIEN, uPCEShow);
985     FEditDCSumm.NeedCPT := uPCEEdit.CPTRequired;
986     cmdChangeClick(Self); // will set captions, sign state for Changes
987     lstSummsClick(Self);  // will make pnlWrite visible
988     if timAutoSave.Interval <> 0 then timAutoSave.Enabled := True;
989     memNewSumm.SetFocus;
990   end;
991   
992   function TfrmDCSumm.TitleText(AnIndex: Integer): string;
993   { returns non-tabbed text for the title of a Summ given the ItemIndex in lstSumms }
994   begin
995     with lstSumms do
996       Result := FormatFMDateTime('mmm dd,yy', MakeFMDateTime(Piece(Items[AnIndex], U, 3))) +
997                 ' ' + Piece(Items[AnIndex], U, 2);
998   end;
999   
1000  procedure TfrmDCSumm.SaveEditedSumm(var Saved: Boolean);
1001  { validates fields and sends the updated Summ to the server }
1002  var
1003    UpdatedSumm: TCreatedDoc;
1004    x: string;
1005  begin
1006    Saved := False;
1007    if (memNewSumm.GetTextLen = 0) or (not ContainsVisibleChar(memNewSumm.Text)) then
1008    begin
1009      lstSumms.ItemIndex := EditingIndex;
1010      x := lstSumms.ItemID;
1011      uChanging := True;
1012      tvSumms.Selected := tvSumms.FindPieceNode(x, 1, U, tvSumms.Items.GetFirstNode);
1013      uChanging := False;
1014      tvSummsChange(Self, tvSumms.Selected);
1015      if FSilent or
1016         ((not FSilent) and
1017        (InfoBox(GetTitleText(EditingIndex) + TX_EMPTY_SUMM, TC_EMPTY_SUMM, MB_YESNO) = IDYES))
1018      then
1019      begin
1020        FConfirmed := True;
1021        mnuActDeleteClick(Self);
1022        Saved := True;
1023        FDeleted := True;
1024      end
1025      else
1026        FConfirmed := False;
1027      Exit;
1028    end;
1029    //ExpandTabsFilter(memNewSumm.Lines, TAB_STOP_CHARS);
1030    with FEditDCSumm do
1031      begin
1032        if (Attending = 0) and (not FSilent) then
1033          begin
1034            InfoBox(TX_MISSING_FIELDS, TC_MISSING_FIELDS,MB_OK);
1035            cmdChangeClick(mnuActSave);
1036            Exit;
1037          end;
1038        NeedCPT            := uPCEEdit.CPTRequired;     {*RAB*}
1039        Lines              := memNewSumm.Lines;
1040        if RequireMASVerification(lstSumms.GetIEN(EditingIndex), TYP_DC_SUMM) then
1041           Status := TIU_ST_UNVER;
1042        (*if (User.DUZ <> Dictator) and (User.DUZ <> Attending) and*)   //ALL USERS??
1043        if RequireRelease(lstSumms.GetIEN(EditingIndex), TYP_DC_SUMM) then
1044          begin
1045            if not FSilent then
1046              begin
1047                if InfoBox(TX_RELEASE, TC_RELEASE, MB_YESNO) = IDNO then
1048                  Status := TIU_ST_UNREL;
1049              end
1050            else          // always save as unreleased on timeout
1051              Status := TIU_ST_UNREL;
1052          end;
1053      end;
1054    timAutoSave.Enabled := False;
1055    try
1056      PutEditedDCSumm(UpdatedSumm, FEditDCSumm, lstSumms.GetIEN(EditingIndex));
1057    finally
1058      timAutoSave.Enabled := True;
1059    end;
1060    if UpdatedSumm.IEN > 0 then
1061    begin
1062      if (FEditDCSumm.Status in [TIU_ST_UNREL, TIU_ST_UNVER]) then
1063        begin
1064          Changes.Remove(CH_SUM, IntToStr(UpdatedSumm.IEN)); // DON'T REPROMPT ON PATIENT CHANGE
1065          UnlockDocument(UpdatedSumm.IEN);                   // Unlock only if UNRELEASED or UNVERIFIED
1066        end;
1067      // otherwise, there's no unlocking here since the note is still in Changes after a save
1068      if lstSumms.ItemIndex = EditingIndex then
1069      begin
1070        EditingIndex := -1;
1071        lstSummsClick(Self);
1072      end;
1073      EditingIndex := -1; // make sure EditingIndex reset even if not viewing edited note
1074      Saved := True;
1075      FChanged := False;
1076    end else
1077    begin
1078      if not FSilent then
1079        InfoBox(TX_SAVE_ERROR1 + UpdatedSumm.ErrorText + TX_SAVE_ERROR2, TC_SAVE_ERROR, MB_OK or MB_ICONWARNING);
1080    end;
1081  end;
1082  
1083  procedure TfrmDCSumm.SaveCurrentSumm(var Saved: Boolean);
1084  { called whenever a Summ should be saved - uses IEN to call appropriate save logic }
1085  begin
1086    if EditingIndex < 0 then Exit;
1087    SaveEditedSumm(Saved);
1088  end;
1089  
1090  { Form events ------------------------------------------------------------------------------ }
1091  
1092  procedure TfrmDCSumm.pnlRightResize(Sender: TObject);
1093  { memSumm (TRichEdit) doesn't repaint appropriately unless its parent panel is refreshed }
1094  begin
1095    inherited;
1096    pnlRight.Refresh;
1097    memSumm.Repaint;
1098  end;
1099  
1100  procedure TfrmDCSumm.pnlWriteResize(Sender: TObject);
1101  const
1102    LEFT_MARGIN = 4;
1103  begin
1104    inherited;
1105    LimitEditWidth(memNewSumm, MAX_ENTRY_WIDTH - 1);
1106    memNewSumm.Constraints.MinWidth := TextWidthByFont(memNewSumm.Font.Handle, StringOfChar('X', MAX_ENTRY_WIDTH)) + (LEFT_MARGIN * 2) + ScrollBarWidth;
1107    pnlLeft.Width := self.ClientWidth - pnlWrite.Width - sptHorz.Width;
1108  end;
1109  
1110  { Left panel (selector) events ------------------------------------------------------------- }
1111  
1112  procedure TfrmDCSumm.lstSummsClick(Sender: TObject);
1113  { loads the text for the selected Summ or displays the editing panel for the selected Summ }
1114  var
1115    x: string;
1116  begin
1117    inherited;
1118    with lstSumms do if ItemIndex = -1 then Exit
1119    else if ItemIndex = EditingIndex then
1120    begin
1121      pnlWrite.Visible := True;
1122      pnlRead.Visible := False;
1123      mnuViewDetail.Enabled := False;
1124      mnuActChange.Enabled     := True;
1125      mnuActLoadBoiler.Enabled := True;
1126    end else
1127    begin
1128      StatusText('Retrieving selected Discharge Summary...');
1129      Screen.Cursor := crHourGlass;
1130      pnlRead.Visible := True;
1131      pnlWrite.Visible := False;
1132      lblTitle.Caption := MakeDCSummDisplayText(Items[ItemIndex]);
1133      lvSumms.Caption := lblTitle.Caption;
1134      lblTitle.Hint := lblTitle.Caption;
1135      //lblTitle.Caption := Piece(DisplayText[ItemIndex], #9, 1) + '  ' + Piece(DisplayText[ItemIndex], #9, 2);
1136      LoadDocumentText(memSumm.Lines, ItemIEN);
1137      memSumm.SelStart := 0;
1138      mnuViewDetail.Enabled := True;
1139      mnuViewDetail.Checked    := False;
1140      mnuActChange.Enabled     := False;
1141      mnuActLoadBoiler.Enabled := False;
1142      Screen.Cursor := crDefault;
1143      StatusText('');
1144    end;
1145    DisplayPCE;
1146    pnlRight.Refresh;
1147    memNewSumm.Repaint;
1148    memSumm.Repaint;
1149    x := 'TIU^' + lstSumms.ItemID;
1150    SetPiece(x, U, 10, Piece(lstSumms.Items[lstSumms.ItemIndex], U, 11));
1151    NotifyOtherApps(NAE_REPORT, x);
1152  end;
1153  
1154  procedure TfrmDCSumm.cmdNewSummClick(Sender: TObject);
1155  { maps 'New Summ' button to the New Discharge Summary menu item }
1156  begin
1157    inherited;
1158    mnuActNewClick(Self);
1159  end;
1160  
1161  procedure TfrmDCSumm.cmdPCEClick(Sender: TObject);
1162  begin
1163    inherited;
1164    cmdPCE.Enabled := False;
1165    UpdatePCE(uPCEEdit);
1166    cmdPCE.Enabled := True;
1167    if frmFrame.Closing then exit;
1168    DisplayPCE;
1169  end;
1170  
1171  procedure TfrmDCSumm.cmdOrdersClick(Sender: TObject);
1172  begin
1173    inherited;
1174    { call add orders here }
1175  end;
1176  
1177  { Right panel (editor) events -------------------------------------------------------------- }
1178  
1179  procedure TfrmDCSumm.memNewSummChange(Sender: TObject);
1180  { sets FChanged to record that the Summ has really been edited }
1181  begin
1182    inherited;
1183    FChanged := True;
1184  end;
1185  
1186  { View menu events ------------------------------------------------------------------------- }
1187  
1188  procedure TfrmDCSumm.mnuViewClick(Sender: TObject);
1189  { changes the list of Summs available for viewing }
1190  var
1191    AuthCtxt: TAuthorContext;
1192    DateRange: TNoteDateRange;
1193    Saved: Boolean;
1194  begin
1195    inherited;
1196    if EditingIndex <> -1 then
1197    begin
1198      SaveCurrentSumm(Saved);
1199      if not Saved then Exit;
1200    end;
1201    FLastSummID := lstSumms.ItemID;
1202    StatusText('Retrieving Discharge Summary list...');
1203    mnuViewDetail.Checked := False;
1204    if Sender is TMenuItem then ViewContext := TMenuItem(Sender).Tag
1205      else if FCurrentContext.Status <> '' then ViewContext := NC_CUSTOM
1206      else ViewContext := NC_RECENT;
1207    case ViewContext of
1208    NC_RECENT:     begin
1209                     FillChar(FCurrentContext, SizeOf(FCurrentContext), 0);
1210                     lblSumms.Caption := 'Last ' + IntToStr(ReturnMaxDCSumms) + ' Summaries';
1211                     FCurrentContext.Status := IntToStr(ViewContext);
1212                     FCurrentContext.MaxDocs := ReturnMaxDCSumms;
1213                     LoadSumms;
1214                   end;
1215    NC_ALL:        begin
1216                     FillChar(FCurrentContext, SizeOf(FCurrentContext), 0);
1217                     lblSumms.Caption := 'All Signed Summaries';
1218                     FCurrentContext.Status := IntToStr(ViewContext);
1219                     LoadSumms;
1220                   end;
1221    NC_UNSIGNED:   begin
1222                     FillChar(FCurrentContext, SizeOf(FCurrentContext), 0);
1223                     lblSumms.Caption := 'Unsigned Summaries';
1224                     FCurrentContext.Status := IntToStr(ViewContext);
1225                     LoadSumms;
1226                   end;
1227    NC_UNCOSIGNED: begin
1228                     FillChar(FCurrentContext, SizeOf(FCurrentContext), 0);
1229                     lblSumms.Caption := 'Uncosigned Summaries';
1230                     FCurrentContext.Status := IntToStr(ViewContext);
1231                     LoadSumms;
1232                   end;
1233    NC_BY_AUTHOR:  begin
1234                     SelectAuthor(Font.Size, FCurrentContext, AuthCtxt);
1235                     with AuthCtxt do if Changed then
1236                     begin
1237                       FillChar(FCurrentContext, SizeOf(FCurrentContext), 0);
1238                       lblSumms.Caption := AuthorName + ': Signed Summaries';
1239                       FCurrentContext.Status := IntToStr(NC_BY_AUTHOR);
1240                       FCurrentContext.Author := Author;
1241                       FCurrentContext.TreeAscending := Ascending;
1242                       LoadSumms;
1243                     end;
1244                   end;
1245    NC_BY_DATE:    begin
1246                     SelectNoteDateRange(Font.Size, FCurrentContext, DateRange);
1247                     with DateRange do if Changed then
1248                     begin
1249                       FillChar(FCurrentContext, SizeOf(FCurrentContext), 0);
1250                       lblSumms.Caption := FormatFMDateTime('mmm dd,yy', FMBeginDate) + ' to ' +
1251                                           FormatFMDateTime('mmm dd,yy', FMEndDate) + ': Signed Summaries';
1252                       FCurrentContext.BeginDate     := BeginDate;
1253                       FCurrentContext.EndDate       := EndDate;
1254                       FCurrentContext.FMBeginDate   := FMBeginDate;
1255                       FCurrentContext.FMEndDate     := FMEndDate;
1256                       FCurrentContext.TreeAscending := Ascending;
1257                       FCurrentContext.Status := IntToStr(NC_BY_DATE);
1258                       LoadSumms;
1259                     end;
1260                   end;
1261    NC_CUSTOM:     begin
1262                     if Sender is TMenuItem then
1263                       begin
1264                         SelectTIUView(Font.Size, True, FCurrentContext, uDCSummContext);
1265                         //lblSumms.Caption := 'Custom List';
1266                       end;
1267                     with uDCSummContext do if Changed then
1268                     begin
1269                       //if not (Sender is TMenuItem) then lblSumms.Caption := 'Default List';
1270                       //if MaxDocs = 0 then MaxDocs := ReturnMaxNotes;
1271                       FCurrentContext.BeginDate     := BeginDate;
1272                       FCurrentContext.EndDate       := EndDate;
1273                       FCurrentContext.FMBeginDate   := FMBeginDate;
1274                       FCurrentContext.FMEndDate     := FMEndDate;
1275                       FCurrentContext.Status        := Status;
1276                       FCurrentContext.Author        := Author;
1277                       FCurrentContext.MaxDocs       := MaxDocs;
1278                       FCurrentContext.ShowSubject   := ShowSubject;
1279                       // NEW PREFERENCES:
1280                       FCurrentContext.SortBy        := SortBy;
1281                       FCurrentContext.ListAscending := ListAscending;
1282                       FCurrentContext.GroupBy       := GroupBy;
1283                       FCurrentContext.TreeAscending := TreeAscending;
1284                       FCurrentContext.SearchField   := SearchField;
1285                       FCurrentContext.Keyword       := Keyword;
1286                       FCurrentContext.Filtered      := Filtered;
1287                       LoadSumms;
1288                     end;
1289                   end;
1290    end; {case}
1291    lblSumms.Caption := SetSummTreeLabel(FCurrentContext);
1292    lblSumms.hint := lblSumms.Caption;
1293    tvSumms.Caption := lblSumms.Caption;
1294    StatusText('');
1295  end;
1296  
1297  { Action menu events ----------------------------------------------------------------------- }
1298  
1299  function TfrmDCSumm.StartNewEdit(NewNoteType: integer): Boolean;
1300  { if currently editing a note, returns TRUE if the user wants to start a new one }
1301  var
1302    Saved: Boolean;
1303    Msg, CapMsg: string;
1304  begin
1305    Result := True;
1306    if EditingIndex > -1 then
1307    begin
1308      case NewNoteType of
1309        DC_ACT_ADDENDUM:  begin
1310                            Msg := TX_NEW_SAVE1 + MakeDCSummDisplayText(lstSumms.Items[EditingIndex]) + TX_NEW_SAVE3;
1311                            CapMsg := TC_NEW_SAVE3;
1312                          end;
1313        DC_ACT_EDIT_SUMM: begin
1314                            Msg := TX_NEW_SAVE1 + MakeDCSummDisplayText(lstSumms.Items[EditingIndex]) + TX_NEW_SAVE4;
1315                            CapMsg := TC_NEW_SAVE4;
1316                          end;
1317        DC_ACT_ID_ENTRY:  begin
1318                            Msg := TX_NEW_SAVE1 + MakeDCSummDisplayText(lstSumms.Items[EditingIndex]) + TX_NEW_SAVE5;
1319                            CapMsg := TC_NEW_SAVE5;
1320                          end;
1321      else
1322        begin
1323          Msg := TX_NEW_SAVE1 + MakeDCSummDisplayText(lstSumms.Items[EditingIndex]) + TX_NEW_SAVE2;
1324          CapMsg := TC_NEW_SAVE2;
1325        end;
1326      end;
1327  
1328      if InfoBox(Msg, CapMsg, MB_YESNO) = IDNO then Result := False
1329      else
1330        begin
1331          SaveCurrentSumm(Saved);
1332          if not Saved then Result := False else LoadSumms;
1333        end;
1334    end;
1335  end;
1336  
1337  procedure TfrmDCSumm.mnuActNewClick(Sender: TObject);
1338  const
1339    IS_ID_CHILD = False;
1340  { switches to current new Summ or creates a new Summ if none is being edited already }
1341  begin
1342    inherited;
1343    if not StartNewEdit(DC_ACT_NEW_SUMM) then Exit;
1344    //LoadSumms;
1345    // a visit (time & location) need not be available before creating the summary,
1346    // since an admission will be prompted for to link the summary to.  (REV - v14d)
1347  (*  if Encounter.NeedVisit then
1348    begin
1349      UpdateVisit(Font.Size);
1350      frmFrame.DisplayEncounterText;
1351    end;
1352    if Encounter.NeedVisit then
1353    begin
1354      InfoBox(TX_NEED_VISIT, TX_NO_VISIT, MB_OK or MB_ICONWARNING);
1355      Exit;
1356    end;*)
1357  
1358    InsertNewSumm(IS_ID_CHILD, 0);
1359  end;
1360  
1361  procedure TfrmDCSumm.mnuActAddIDEntryClick(Sender: TObject);
1362  const
1363    IS_ID_CHILD = True;
1364  var
1365    AnIDParent: integer;
1366  { switches to current new note or creates a new note if none is being edited already }
1367  begin
1368    inherited;
1369    AnIDParent := lstSumms.ItemIEN;
1370    if not StartNewEdit(DC_ACT_ID_ENTRY) then Exit;
1371    //LoadSumms;
1372    with tvSumms do Selected := FindPieceNode(IntToStr(AnIDParent), U, Items.GetFirstNode);
1373    // make sure a visit (time & location) is available before creating the note
1374    if Encounter.NeedVisit then
1375    begin
1376      UpdateVisit(Font.Size, DfltTIULocation);
1377      frmFrame.DisplayEncounterText;
1378    end;
1379    if Encounter.NeedVisit then
1380    begin
1381      InfoBox(TX_NEED_VISIT, TX_NO_VISIT, MB_OK or MB_ICONWARNING);
1382      Exit;
1383    end;
1384    InsertNewSumm(IS_ID_CHILD, AnIDParent);
1385  end;
1386  
1387  procedure TfrmDCSumm.mnuActAddendClick(Sender: TObject);
1388  { make an addendum to an existing Summ }
1389  var
1390    ActionSts: TActionRec;
1391    ASummID: string;
1392  begin
1393    inherited;
1394    if NoSummSelected() then Exit;
1395    ASummID := lstSumms.ItemID;
1396    if not StartNewEdit(DC_ACT_ADDENDUM) then Exit;
1397    //LoadSumms;
1398    with tvSumms do Selected := FindPieceNode(ASummID, 1, U, Items.GetFirstNode);
1399    if lstSumms.ItemIndex = EditingIndex then
1400    begin
1401      InfoBox(TX_ADDEND_NO, TX_ADDEND_MK, MB_OK);
1402      Exit;
1403    end;
1404    ActOnDCDocument(ActionSts, lstSumms.ItemIEN, 'MAKE ADDENDUM');
1405    if not ActionSts.Success then
1406    begin
1407      InfoBox(ActionSts.Reason, TX_IN_AUTH, MB_OK);
1408      Exit;
1409    end;
1410    with lstSumms do if TitleForNote(ItemIEN) = TYP_ADDENDUM then    //v17.5  RV
1411    //with lstSumms do if Copy(Piece(Items[ItemIndex], U, 2), 1, 8) = 'Addendum' then
1412    begin
1413      InfoBox(TX_ADDEND_AD, TX_ADDEND_MK, MB_OK);
1414      Exit;
1415    end;
1416    FEditDCSumm.DischargeDateTime := FMNow;
1417    InsertAddendum;
1418  end;
1419  
1420  procedure TfrmDCSumm.mnuActDetachFromIDParentClick(Sender: TObject);
1421  var
1422    DocID, WhyNot: string;
1423    Saved: boolean;
1424    SavedDocID: string;
1425  begin
1426    if lstSumms.ItemIEN = 0 then exit;
1427    SavedDocID := lstSumms.ItemID;
1428    if EditingIndex <> -1 then
1429    begin
1430      SaveCurrentSumm(Saved);
1431      if not Saved then Exit;
1432      LoadSumms;
1433      with tvSumms do Selected := FindPieceNode(SavedDocID, U, Items.GetFirstNode);
1434    end;
1435    if not CanBeAttached(PDocTreeObject(tvSumms.Selected.Data)^.DocID, WhyNot) then
1436      begin
1437        WhyNot := StringReplace(WhyNot, 'ATTACH', 'DETACH', [rfIgnoreCase]);
1438        WhyNot := StringReplace(WhyNot, 'to an ID', 'from an ID', [rfIgnoreCase]);
1439        InfoBox(WhyNot, TX_DETACH_FAILURE, MB_OK);
1440        Exit;
1441      end;
1442    if (InfoBox('DETACH:   ' + tvSumms.Selected.Text + CRLF +  CRLF +
1443                '  FROM:   ' + tvSumms.Selected.Parent.Text + CRLF + CRLF +
1444                'Are you sure?', TX_DETACH_CNF, MB_YESNO or MB_DEFBUTTON2 or MB_ICONQUESTION) <> IDYES)
1445        then Exit;
1446    DocID := PDocTreeObject(tvSumms.Selected.Data)^.DocID;
1447    SavedDocID := PDocTreeObject(tvSumms.Selected.Parent.Data)^.DocID;
1448    if DetachEntryFromParent(DocID, WhyNot) then
1449      begin
1450        LoadSumms;
1451        with tvSumms do Selected := FindPieceNode(SavedDocID, U, Items.GetFirstNode);
1452        if tvSumms.Selected <> nil then tvSumms.Selected.Expand(False);
1453      end
1454    else
1455      begin
1456        WhyNot := StringReplace(WhyNot, 'ATTACH', 'DETACH', [rfIgnoreCase]);
1457        WhyNot := StringReplace(WhyNot, 'to an ID', 'from an ID', [rfIgnoreCase]);
1458        InfoBox(WhyNot, TX_DETACH_FAILURE, MB_OK);
1459      end;
1460  end;
1461  
1462  
1463  procedure TfrmDCSumm.mnuActSignListClick(Sender: TObject);
1464  { add the Summ to the Encounter object, see mnuActSignClick - copied}
1465  const
1466    SIG_COSIGN = 'COSIGNATURE';
1467    SIG_SIGN   = 'SIGNATURE';
1468  var
1469    ActionType, SignTitle: string;
1470    ActionSts: TActionRec;
1471  begin
1472    inherited;
1473    if NoSummSelected() then Exit;
1474    if lstSumms.ItemIndex = EditingIndex then Exit;  // already in signature list
1475    if not NoteHasText(lstSumms.ItemIEN) then
1476      begin
1477        InfoBox(TX_EMPTY_SUMM1, TC_EMPTY_SUMM, MB_OK or MB_ICONERROR);
1478        Exit;
1479      end;
1480    if not LastSaveClean(lstSumms.ItemIEN) and
1481      (InfoBox(TX_ABSAVE, TC_ABSAVE, MB_YESNO or MB_DEFBUTTON2 or MB_ICONWARNING) <> IDYES) then Exit;
1482    if CosignDocument(lstSumms.ItemIEN) then
1483    begin
1484      SignTitle := TX_COSIGN;
1485      ActionType := SIG_COSIGN;
1486    end else
1487    begin
1488      SignTitle := TX_SIGN;
1489      ActionType := SIG_SIGN;
1490    end;
1491    ActOnDCDocument(ActionSts, lstSumms.ItemIEN, ActionType);
1492    if not ActionSts.Success then
1493    begin
1494      InfoBox(ActionSts.Reason, TX_IN_AUTH, MB_OK);
1495      Exit;
1496    end;
1497    LockSumm(lstSumms.ItemIEN);
1498    with lstSumms do Changes.Add(CH_SUM, ItemID, TitleText(ItemIndex), '', CH_SIGN_YES);
1499  end;
1500  
1501  procedure TfrmDCSumm.RemovePCEFromChanges(IEN: Int64; AVisitStr: string = '');
1502  begin
1503    if IEN = DC_ADDENDUM then Exit;  // no PCE information entered for an addendum
1504    // do we need to call DeletePCE(AVisitStr), as was done with NT_NEW_NOTE (ien=-10)???
1505    if AVisitStr = '' then AVisitStr := VisitStrForNote(IEN);
1506    Changes.Remove(CH_PCE, 'V' + AVisitStr);
1507    Changes.Remove(CH_PCE, 'P' + AVisitStr);
1508    Changes.Remove(CH_PCE, 'D' + AVisitStr);
1509    Changes.Remove(CH_PCE, 'I' + AVisitStr);
1510    Changes.Remove(CH_PCE, 'S' + AVisitStr);
1511    Changes.Remove(CH_PCE, 'A' + AVisitStr);
1512    Changes.Remove(CH_PCE, 'H' + AVisitStr);
1513    Changes.Remove(CH_PCE, 'E' + AVisitStr);
1514    Changes.Remove(CH_PCE, 'T' + AVisitStr);
1515  end;
1516  
1517  
1518  procedure TfrmDCSumm.mnuActDeleteClick(Sender: TObject);
1519  { delete the selected progress note & remove from the Encounter object if necessary }
1520  var
1521    DeleteSts, ActionSts: TActionRec;
1522    ReasonForDelete, AVisitStr, SavedDocID: string;
1523    Saved: boolean;
1524    SavedDocIEN: integer;
1525  begin
1526    inherited;
1527    if NoSummSelected() then Exit;
1528    ActOnDocument(ActionSts, lstSumms.ItemIEN, 'DELETE RECORD');
1529    if ShowMsgOn(not ActionSts.Success, ActionSts.Reason, TX_IN_AUTH) then Exit;
1530    ReasonForDelete := SelectDeleteReason(lstSumms.ItemIEN);
1531    if ReasonForDelete = DR_CANCEL then Exit;
1532    // suppress prompt for deletion when called from SaveEditedNote (Sender = Self)
1533    if (Sender <> Self) and (InfoBox(MakeDCSummDisplayText(lstSumms.Items[lstSumms.ItemIndex]) + TX_DEL_OK,
1534      TX_DEL_CNF, MB_YESNO or MB_DEFBUTTON2 or MB_ICONQUESTION) <> IDYES) then Exit;
1535    // do the appropriate locking
1536    if not LockSumm(lstSumms.ItemIEN) then Exit;
1537      // retraction notification message
1538    if JustifyDocumentDelete(lstSumms.ItemIEN) then
1539       InfoBox(TX_RETRACT, TX_RETRACT_CAP, MB_OK);
1540    SavedDocID := lstSumms.ItemID;
1541    SavedDocIEN := lstSumms.ItemIEN;
1542    if (EditingIndex > -1) and (not FConfirmed) and (lstSumms.ItemIndex <> EditingIndex) and (memNewSumm.GetTextLen > 0) then
1543      begin
1544        SaveCurrentSumm(Saved);
1545        if not Saved then Exit;
1546      end;
1547    EditingIndex := -1;
1548    FConfirmed := False;
1549  (*  if Saved then
1550      begin
1551        EditingIndex := -1;
1552        mnuViewClick(Self);
1553        with tvSumms do Selected := FindPieceNode(SavedDocID, U, Items.GetFirstNode);
1554     end;*)
1555    // remove the note
1556    DeleteSts.Success := True;
1557    AVisitStr := VisitStrForNote(SavedDocIEN);
1558    RemovePCEFromChanges(SavedDocIEN, AVisitStr);
1559    if (SavedDocIEN > 0) and (lstSumms.ItemIEN = SavedDocIEN) then DeleteDocument(DeleteSts, SavedDocIEN, ReasonForDelete);
1560    if not Changes.Exist(CH_SUM, SavedDocID) then UnlockDocument(SavedDocIEN);
1561    Changes.Remove(CH_SUM, SavedDocID);  // this will unlock the document if in Changes
1562    // reset the display now that the note is gone
1563    if DeleteSts.Success then
1564    begin
1565      DeletePCE(AVisitStr);  // removes PCE data if this was the only note pointing to it
1566      ClearEditControls;
1567      //ClearPtData;   WRONG - fixed in v15.10 - RV
1568      LoadSumms;
1569  (*    with tvSumms do Selected := FindPieceNode(SavedDocID, U, Items.GetFirstNode);
1570      if tvSumms.Selected <> nil then tvSummsChange(Self, tvSumms.Selected) else
1571      begin*)
1572        pnlWrite.Visible := False;
1573        pnlRead.Visible := True;
1574        UpdateReminderFinish;
1575        ShowPCEControls(False);
1576        frmDrawers.DisplayDrawers(FALSE);
1577        cmdNewSumm.Visible := TRUE;
1578        cmdPCE.Visible := FALSE;
1579        popSummMemoEncounter.Visible := cmdPCE.Visible;
1580        lblSpace1.Top := cmdNewSumm.Top - lblSpace1.Height;
1581  //    end; {if ItemIndex}
1582    end {if DeleteSts}
1583    else InfoBox(DeleteSts.Reason, TX_DEL_ERR, MB_OK or MB_ICONWARNING);
1584  end;
1585  
1586  procedure TfrmDCSumm.mnuActEditClick(Sender: TObject);
1587  { load the selected Discharge Summary for editing }
1588  var
1589    ActionSts: TActionRec;
1590    ASummID: string;
1591  begin
1592    inherited;
1593    if NoSummSelected() then Exit;
1594    if lstSumms.ItemIndex = EditingIndex then Exit;
1595    ASummID := lstSumms.ItemID;
1596    if not StartNewEdit(DC_ACT_EDIT_SUMM) then Exit;
1597    //LoadSumms;
1598    with tvSumms do Selected := FindPieceNode(ASummID, 1, U, Items.GetFirstNode);
1599    ActOnDCDocument(ActionSts, lstSumms.ItemIEN, 'EDIT RECORD');
1600    if not ActionSts.Success then
1601    begin
1602      InfoBox(ActionSts.Reason, TX_IN_AUTH, MB_OK);
1603      Exit;
1604    end;
1605    LoadForEdit(False);
1606  end;
1607  
1608  procedure TfrmDCSumm.mnuActSaveClick(Sender: TObject);
1609  { saves the Summ that is currently being edited }
1610  var
1611    Saved: Boolean;
1612    SavedDocID: string;
1613  begin
1614    inherited;
1615    if EditingIndex > -1 then
1616      begin
1617        SavedDocID := Piece(lstSumms.Items[EditingIndex], U, 1);
1618        FLastSummID := SavedDocID;
1619        SaveCurrentSumm(Saved);
1620        if Saved and (EditingIndex < 0) and (not FDeleted) then
1621        //if Saved then
1622          begin
1623            LoadSumms;
1624            with tvSumms do Selected := FindPieceNode(SavedDocID, U, Items.GetFirstNode);
1625         end;
1626      end
1627      else InfoBox(TX_NO_NOTE, TX_SAVE_NOTE, MB_OK or MB_ICONWARNING);
1628  end;
1629  
1630  procedure TfrmDCSumm.mnuActSignClick(Sender: TObject);
1631  { sign the currently selected Summ, save first if necessary }
1632  const
1633    SIG_COSIGN = 'COSIGNATURE';
1634    SIG_SIGN   = 'SIGNATURE';
1635  var
1636    Saved, SummUnlocked: Boolean;
1637    ActionType, ESCode, SignTitle: string;
1638    ActionSts, SignSts: TActionRec;
1639    OK: boolean;
1640    SavedDocID, tmpItem: string;
1641    EditingID: string;                                         //v22.12 - RV
1642    tmpNode: TTreeNode;
1643  begin
1644    inherited;
1645    if NoSummSelected() then Exit;
1646  (*  if lstSumms.ItemIndex = EditingIndex then                //v22.12 - RV
1647    begin                                                      //v22.12 - RV
1648      SaveCurrentSumm(Saved);                                  //v22.12 - RV
1649      if (not Saved) or FDeleted then Exit;                    //v22.12 - RV
1650    end                                                        //v22.12 - RV
1651    else if EditingIndex > -1 then                             //v22.12 - RV
1652      tmpItem := lstSumms.Items[EditingIndex];                 //v22.12 - RV
1653    SavedDocID := lstSumms.ItemID;*)                           //v22.12 - RV
1654    SavedDocID := lstSumms.ItemID;                             //v22.12 - RV
1655    FLastSummID := SavedDocID;                                 //v22.12 - RV
1656    if lstSumms.ItemIndex = EditingIndex then                  //v22.12 - RV
1657    begin                                                      //v22.12 - RV
1658      SaveCurrentSumm(Saved);                                  //v22.12 - RV
1659      if (not Saved) or FDeleted then Exit;                    //v22.12 - RV
1660    end                                                        //v22.12 - RV
1661    else if EditingIndex > -1 then                             //v22.12 - RV
1662    begin                                                      //v22.12 - RV
1663      tmpItem := lstSumms.Items[EditingIndex];                 //v22.12 - RV
1664      EditingID := Piece(tmpItem, U, 1);                       //v22.12 - RV
1665    end;                                                       //v22.12 - RV
1666    if not NoteHasText(lstSumms.ItemIEN) then
1667      begin
1668        InfoBox(TX_EMPTY_SUMM1, TC_EMPTY_SUMM, MB_OK or MB_ICONERROR);
1669        Exit;
1670      end;
1671    if not LastSaveClean(lstSumms.ItemIEN) and
1672      (InfoBox(TX_ABSAVE, TC_ABSAVE, MB_YESNO or MB_DEFBUTTON2 or MB_ICONWARNING) <> IDYES) then Exit;
1673    if CosignDocument(lstSumms.ItemIEN) then
1674    begin
1675      SignTitle := TX_COSIGN;
1676      ActionType := SIG_COSIGN;
1677    end else
1678    begin
1679      SignTitle := TX_SIGN;
1680      ActionType := SIG_SIGN;
1681    end;
1682    if not LockSumm(lstSumms.ItemIEN) then Exit;
1683    // no exits after things are locked
1684    SummUnlocked := False;
1685    ActOnDCDocument(ActionSts, lstSumms.ItemIEN, ActionType);
1686    if ActionSts.Success then
1687    begin
1688      OK := IsOK2Sign(uPCEShow, lstSumms.ItemIEN);
1689      if frmFrame.Closing then exit;
1690      if(uPCEShow.Updated) then
1691      begin
1692        uPCEShow.CopyPCEData(uPCEEdit);
1693        uPCEShow.Updated := FALSE;
1694        lstSummsClick(Self);
1695      end;
1696      if not AuthorSignedDocument(lstSumms.ItemIEN) then
1697      begin
1698        if (InfoBox(TX_AUTH_SIGNED +
1699            GetTitleText(lstSumms.ItemIndex),TX_SIGN ,MB_YESNO)= ID_NO) then exit;
1700      end;
1701      if(OK) then
1702      begin                                       
1703        with lstSumms do SignatureForItem(Font.Size, MakeDCSummDisplayText(Items[ItemIndex]), SignTitle, ESCode);
1704        if Length(ESCode) > 0 then
1705        begin
1706          SignDCDocument(SignSts, lstSumms.ItemIEN, ESCode);
1707          RemovePCEFromChanges(lstSumms.ItemIEN);
1708          SummUnlocked := Changes.Exist(CH_SUM, lstSumms.ItemID);
1709          Changes.Remove(CH_SUM, lstSumms.ItemID);
1710          if SignSts.Success
1711            then lstSummsClick(Self)
1712            else InfoBox(SignSts.Reason, TX_SIGN_ERR, MB_OK);
1713        end  {if Length(ESCode)}
1714        else
1715          SummUnlocked := Changes.Exist(CH_SUM, lstSumms.ItemID);
1716      end;
1717    end
1718    else InfoBox(ActionSts.Reason, TX_IN_AUTH, MB_OK);
1719    if not SummUnlocked then UnlockDocument(lstSumms.ItemIEN);
1720    //SetViewContext(FCurrentContext);  //v22.12 - RV
1721    LoadSumms;                          //v22.12 - RV
1722    //if EditingIndex > -1 then         //v22.12 - RV
1723    if (EditingID <> '') then           //v22.12 - RV
1724      begin
1725        lstSumms.Items.Insert(0, tmpItem);
1726        tmpNode := tvSumms.Items.AddObjectFirst(tvSumms.Items.GetFirstNode, 'Summary being edited',
1727                   MakeDCSummTreeObject('EDIT^Summary being edited^^^^^^^^^^^%^0'));
1728        TORTreeNode(tmpNode).StringData := 'EDIT^Summary being edited^^^^^^^^^^^%^0';
1729        tmpNode.ImageIndex := IMG_TOP_LEVEL;
1730        tmpNode := tvSumms.Items.AddChildObjectFirst(tmpNode, MakeDCSummDisplayText(tmpItem), MakeDCSummTreeObject(tmpItem));
1731        TORTreeNode(tmpNode).StringData := tmpItem;
1732        SetTreeNodeImagesAndFormatting(TORTreeNode(tmpNode), FCurrentContext, CT_DCSUMM);
1733        EditingIndex := lstSumms.SelectByID(EditingID);                 //v22.12 - RV
1734      end;
1735    //with tvSumms do Selected := FindPieceNode(SavedDocID, U, Items.GetFirstNode);  //v22.12 - RV
1736    with tvSumms do                                                                  //v22.12 - RV
1737    begin                                                                            //v22.12 - RV
1738      Selected := FindPieceNode(FLastSummID, U, Items.GetFirstNode);                 //v22.12 - RV
1739      if Selected <> nil then tvSummsChange(Self, Selected);                         //v22.12 - RV
1740    end;                                                                             //v22.12 - RV
1741  end;
1742  
1743  procedure TfrmDCSumm.SaveSignItem(const ItemID, ESCode: string);
1744  { saves and optionally signs a Discharge Summary or addendum }
1745  const
1746    SIG_COSIGN = 'COSIGNATURE';
1747    SIG_SIGN   = 'SIGNATURE';
1748  var
1749    AnIndex, IEN, i: Integer;
1750    Saved, ContinueSign: Boolean;   {*RAB* 8/26/99}
1751    ActionSts, SignSts: TActionRec;
1752    APCEObject: TPCEData;
1753    OK: boolean;
1754    ActionType, SignTitle: string;
1755  begin
1756    AnIndex := -1;
1757    IEN := StrToIntDef(ItemID, 0);
1758    if IEN = 0 then Exit;
1759    if frmFrame.TimedOut and (EditingIndex <> -1) then FSilent := True;
1760    with lstSumms do for i := 0 to Items.Count - 1 do if lstSumms.GetIEN(i) = IEN then
1761    begin
1762      AnIndex := i;
1763      break;
1764    end;
1765    if (AnIndex > -1) and (AnIndex = EditingIndex) then
1766    begin
1767      SaveCurrentSumm(Saved);
1768      if not Saved then Exit;
1769      if FDeleted then
1770        begin
1771          FDeleted := False;
1772          Exit;
1773        end;
1774      AnIndex := lstSumms.SelectByIEN(IEN);
1775      //IEN := lstNotes.GetIEN(AnIndex);                    // saving will change IEN
1776    end;
1777    if Length(ESCode) > 0 then
1778    begin
1779      if CosignDocument(IEN) then
1780      begin
1781        SignTitle := TX_COSIGN;
1782        ActionType := SIG_COSIGN;
1783      end else
1784      begin
1785        SignTitle := TX_SIGN;
1786        ActionType := SIG_SIGN;
1787      end;
1788      ActOnDocument(ActionSts, IEN, ActionType);
1789      if not ActionSts.Success then
1790        begin
1791          InfoBox(ActionSts.Reason, TX_IN_AUTH, MB_OK);
1792          ContinueSign := False;
1793        end
1794      else if not NoteHasText(IEN) then
1795        begin
1796          InfoBox(TX_EMPTY_SUMM1, TC_EMPTY_SUMM, MB_OK or MB_ICONERROR);
1797          ContinueSign := False;
1798        end
1799      else if not LastSaveClean(IEN) and
1800        (InfoBox(TX_ABSAVE, TC_ABSAVE, MB_YESNO or MB_DEFBUTTON2 or MB_ICONWARNING) <> IDYES)
1801         then ContinueSign := False
1802      else ContinueSign := True;
1803      if ContinueSign then
1804      begin
1805        if (AnIndex >= 0) and (AnIndex = lstSumms.ItemIndex) then
1806          APCEObject := uPCEShow
1807        else
1808          APCEObject := nil;
1809        OK := IsOK2Sign(APCEObject, IEN);
1810        if frmFrame.Closing then exit;
1811        if(assigned(APCEObject)) and (uPCEShow.Updated) then
1812        begin
1813          uPCEShow.CopyPCEData(uPCEEdit);
1814          uPCEShow.Updated := FALSE;
1815          lstSummsClick(Self);
1816        end
1817        else
1818          uPCEEdit.Clear;
1819        if(OK) then
1820        begin
1821          SignDocument(SignSts, IEN, ESCode);
1822          if not SignSts.Success then InfoBox(SignSts.Reason, TX_SIGN_ERR, MB_OK);
1823        end; {if OK}
1824      end; {if ContinueSign}
1825    end; {if Length(ESCode)}
1826  
1827    if (AnIndex = lstSumms.ItemIndex) and (not frmFrame.ContextChanging) then
1828      begin
1829        LoadSumms;
1830        with tvSumms do Selected := FindPieceNode(IntToStr(IEN), U, Items.GetFirstNode);
1831      end;
1832  end;
1833  
1834  procedure TfrmDCSumm.popSummMemoPopup(Sender: TObject);
1835  begin
1836    inherited;
1837    if PopupComponent(Sender, popSummMemo) is TCustomEdit
1838      then FEditCtrl := TCustomEdit(PopupComponent(Sender, popSummMemo))
1839      else FEditCtrl := nil;
1840    if FEditCtrl <> nil then
1841    begin
1842      popSummMemoCut.Enabled      := FEditCtrl.SelLength > 0;
1843      popSummMemoCopy.Enabled     := popSummMemoCut.Enabled;
1844      popSummMemoPaste.Enabled    := (not TORExposedCustomEdit(FEditCtrl).ReadOnly) and
1845                                     Clipboard.HasFormat(CF_TEXT);
1846      popSummMemoTemplate.Enabled := frmDrawers.CanEditTemplates and popSummMemoCut.Enabled;
1847      popSummMemoFind.Enabled     := FEditCtrl.GetTextLen > 0;
1848    end else
1849    begin
1850      popSummMemoCut.Enabled      := False;
1851      popSummMemoCopy.Enabled     := False;
1852      popSummMemoPaste.Enabled    := False;
1853      popSummMemoTemplate.Enabled := False;
1854    end;
1855    if pnlWrite.Visible then
1856    begin
1857      popSummMemoSpell.Enabled   := True;
1858      popSummMemoGrammar.Enabled := True;
1859      popSummMemoReformat.Enabled := True;
1860      popSummMemoReplace.Enabled  := (FEditCtrl.GetTextLen > 0);
1861      popSummMemoPreview.Enabled  := (frmDrawers.TheOpenDrawer = odTemplates) and Assigned(frmDrawers.tvTemplates.Selected);
1862      popSummMemoInsTemplate.Enabled  := (frmDrawers.TheOpenDrawer = odTemplates) and Assigned(frmDrawers.tvTemplates.Selected);
1863    end else
1864    begin
1865      popSummMemoSpell.Enabled   := False;
1866      popSummMemoGrammar.Enabled := False;
1867      popSummMemoReformat.Enabled := False;
1868      popSummMemoReplace.Enabled := False;
1869      popSummMemoPreview.Enabled  := False;
1870      popSummMemoInsTemplate.Enabled  := False;
1871    end;
1872  end;
1873  
1874  procedure TfrmDCSumm.popSummMemoCutClick(Sender: TObject);
1875  begin
1876    inherited;
1877    FEditCtrl.CutToClipboard;
1878  end;
1879  
1880  procedure TfrmDCSumm.popSummMemoCopyClick(Sender: TObject);
1881  begin
1882    inherited;
1883    FEditCtrl.CopyToClipboard;
1884  end;
1885  
1886  procedure TfrmDCSumm.popSummMemoPasteClick(Sender: TObject);
1887  begin
1888    inherited;
1889    FEditCtrl.SelText := Clipboard.AsText; {*KCM*}
1890    //FEditCtrl.PasteFromClipboard;        // use AsText to prevent formatting
1891  end;
1892  
1893  procedure TfrmDCSumm.popSummMemoReformatClick(Sender: TObject);
1894  begin
1895    inherited;
1896    if Screen.ActiveControl <> memNewSumm then Exit;
1897    ReformatMemoParagraph(memNewSumm);
1898  end;
1899  
1900  procedure TfrmDCSumm.popSummMemoFindClick(Sender: TObject);
1901  begin
1902    inherited;
1903    SendMessage(TRichEdit(popSummMemo.PopupComponent).Handle, WM_VSCROLL, SB_TOP, 0);
1904    with dlgFindText do
1905      begin
1906        Position := Point(Application.MainForm.Left + pnlLeft.Width, Application.MainForm.Top);
1907        FindText := '';
1908        Options := [frDown, frHideUpDown];
1909        Execute;
1910      end;
1911  end;
1912  
1913  procedure TfrmDCSumm.dlgFindTextFind(Sender: TObject);
1914  begin
1915    dmodShared.FindRichEditText(dlgFindText, TRichEdit(popSummMemo.PopupComponent));
1916  end;
1917  
1918  procedure TfrmDCSumm.popSummMemoReplaceClick(Sender: TObject);
1919  begin
1920    inherited;
1921    SendMessage(TRichEdit(popSummMemo.PopupComponent).Handle, WM_VSCROLL, SB_TOP, 0);
1922    with dlgReplaceText do
1923      begin
1924        Position := Point(Application.MainForm.Left + pnlLeft.Width, Application.MainForm.Top);
1925        FindText := '';
1926        ReplaceText := '';
1927        Options := [frDown, frHideUpDown];
1928        Execute;
1929      end;
1930  end;
1931  
1932  procedure TfrmDCSumm.dlgReplaceTextReplace(Sender: TObject);
1933  begin
1934    inherited;
1935    dmodShared.ReplaceRichEditText(dlgReplaceText, TRichEdit(popSummMemo.PopupComponent));
1936  end;
1937  
1938  procedure TfrmDCSumm.dlgReplaceTextFind(Sender: TObject);
1939  begin
1940    inherited;
1941    dmodShared.FindRichEditText(dlgFindText, TRichEdit(popSummMemo.PopupComponent));
1942  end;
1943  
1944  procedure TfrmDCSumm.popSummMemoSpellClick(Sender: TObject);
1945  begin
1946    inherited;
1947    DoAutoSave(0);
1948    timAutoSave.Enabled := False;
1949    try
1950      SpellCheckForControl(memNewSumm);
1951    finally
1952      FChanged := True;
1953      DoAutoSave(0);
1954      timAutoSave.Enabled := True;
1955    end;
1956  end;
1957  
1958  procedure TfrmDCSumm.popSummMemoGrammarClick(Sender: TObject);
1959  begin
1960    inherited;
1961    DoAutoSave(0);
1962    timAutoSave.Enabled := False;
1963    try
1964      GrammarCheckForControl(memNewSumm);
1965    finally
1966      FChanged := True;
1967      DoAutoSave(0);
1968      timAutoSave.Enabled := True;
1969    end;
1970  end;
1971  
1972  procedure TfrmDCSumm.FormCreate(Sender: TObject);
1973  begin
1974    inherited;
1975    PageID := CT_DCSUMM;
1976    FDischargeDate := FMNow;
1977    EditingIndex := -1;
1978    FEditDCSumm.LastCosigner := 0;
1979    FEditDCSumm.LastCosignerName := '';
1980    FLastSummID := '';
1981    frmDrawers := TfrmDrawers.CreateDrawers(Self, pnlDrawers, [],[]);
1982    frmDrawers.Align := alBottom;
1983    frmDrawers.RichEditControl := memNewSumm;
1984    frmDrawers.Splitter := splDrawers;
1985    frmDrawers.DefTempPiece := 3;
1986    FImageFlag := TBitmap.Create;
1987    FDocList := TStringList.Create;
1988  end;
1989  
1990  procedure TfrmDCSumm.mnuViewDetailClick(Sender: TObject);
1991  begin
1992    inherited;
1993    if lstSumms.ItemIEN <= 0 then Exit;
1994    mnuViewDetail.Checked := not mnuViewDetail.Checked;
1995    if mnuViewDetail.Checked then
1996      begin
1997        StatusText('Retrieving discharge summary details...');
1998        Screen.Cursor := crHourGlass;
1999        LoadDetailText(memSumm.Lines, lstSumms.ItemIEN);
2000        Screen.Cursor := crDefault;
2001        StatusText('');
2002        memSumm.SelStart := 0;
2003        memSumm.Repaint;
2004      end
2005    else
2006      lstSummsClick(Self);
2007    SendMessage(memSumm.Handle, WM_VSCROLL, SB_TOP, 0);
2008  end;
2009  
2010  procedure TfrmDCSumm.FormClose(Sender: TObject; var Action: TCloseAction);
2011  var
2012    Saved: Boolean;
2013    IEN: Int64;
2014    ErrMsg: string;
2015    DeleteSts: TActionRec;
2016  begin
2017    inherited;
2018    if frmFrame.TimedOut and (EditingIndex <> -1) then
2019    begin
2020      FSilent := True;
2021      if memNewSumm.GetTextLen > 0 then SaveCurrentSumm(Saved)
2022      else
2023      begin
2024        IEN := lstSumms.GetIEN(EditingIndex);
2025        if not LastSaveClean(IEN) then             // means note hasn't been committed yet
2026        begin
2027          LockDocument(IEN, ErrMsg);
2028          if ErrMsg = '' then
2029          begin
2030            DeleteDocument(DeleteSts, IEN, '');
2031            UnlockDocument(IEN);
2032          end; {if ErrMsg}
2033        end; {if not LastSaveClean}
2034      end; {else}
2035    end; {if frmFrame}
2036  end;
2037  
2038  procedure TfrmDCSumm.mnuActIdentifyAddlSignersClick(Sender: TObject);
2039  var
2040    Exclusions: TStrings;
2041    Saved, x, y: boolean;
2042    SignerList: TSignerList;
2043    ActionSts: TActionRec;
2044    SigAction: integer;
2045    SavedDocID: string;
2046    ARefDate: TFMDateTime;
2047  begin
2048    inherited;
2049    if NoSummSelected() then Exit;
2050    if lstSumms.ItemIndex = EditingIndex then
2051      begin
2052        SaveCurrentSumm(Saved);
2053        if not Saved then Exit;
2054        LoadSumms;
2055        with tvSumms do Selected := FindPieceNode(SavedDocID, U, Items.GetFirstNode);
2056      end;
2057    x := CanChangeCosigner(lstSumms.ItemIEN);
2058    ActOnDocument(ActionSts, lstSumms.ItemIEN, 'IDENTIFY SIGNERS');
2059    y := ActionSts.Success;
2060    if x and not y then
2061      begin
2062        if InfoBox(ActionSts.Reason + CRLF + CRLF +
2063                   'Would you like to change the cosigner?',
2064                   TX_IN_AUTH, MB_YESNO or MB_DEFBUTTON2 or MB_ICONQUESTION) = ID_YES then
2065      	SigAction := SG_COSIGNER
2066        else
2067  	Exit;
2068      end
2069    else if y and not x then SigAction := SG_ADDITIONAL
2070    else if x and y then SigAction := SG_BOTH
2071    else
2072      begin
2073        InfoBox(ActionSts.Reason, TX_IN_AUTH, MB_OK);
2074        Exit;
2075      end;
2076  
2077  //  NEED TO PREVENT CHANGE OF COSIGNER ON DC SUMMARIES?
2078  {  if y then SigAction := SG_ADDITIONAL
2079      else
2080      begin
2081        InfoBox(ActionSts.Reason, TX_IN_AUTH, MB_OK);
2082        Exit;
2083      end;  }
2084  
2085    Exclusions := GetCurrentSigners(lstSumms.ItemIEN);
2086    ARefDate := ExtractFloat(Piece(Piece(lstSumms.Items[lstSumms.ItemIndex], U, 9), ';', 2));
2087    if ARefDate = 0 then        //no discharge date, so use note date
2088      ARefDate := StrToFloat(Piece(lstSumms.Items[lstSumms.ItemIndex], U, 3));
2089    SelectAdditionalSigners(Font.Size, lstSumms.ItemIEN, SigAction, Exclusions, SignerList, CT_DCSUMM, ARefDate);
2090    with SignerList do
2091      begin
2092        case SigAction of
2093          SG_ADDITIONAL:  if Changed and (Signers <> nil) and (Signers.Count > 0) then
2094                            UpdateAdditionalSigners(lstSumms.ItemIEN, Signers);
2095          SG_COSIGNER:    if Changed then ChangeAttending(lstSumms.ItemIEN, Cosigner);
2096          SG_BOTH:        if Changed then
2097                            begin
2098                              if (Signers <> nil) and (Signers.Count > 0) then
2099                                UpdateAdditionalSigners(lstSumms.ItemIEN, Signers);
2100                              ChangeAttending(lstSumms.ItemIEN, Cosigner);
2101                            end;
2102        end;
2103        lstSummsClick(Self);
2104      end;
2105  end;
2106  
2107  procedure TfrmDCSumm.popSummMemoAddlSignClick(Sender: TObject);
2108  begin
2109    inherited;
2110    mnuActIdentifyAddlSignersClick(Self);
2111  end;
2112  
2113  procedure TfrmDCSumm.ProcessNotifications;
2114  var
2115    x: string;
2116    Saved: boolean;
2117    tmpNode: TTreeNode;
2118    AnObject: PDocTreeObject;
2119  begin
2120    if EditingIndex <> -1 then
2121    begin
2122      SaveCurrentSumm(Saved);
2123      if not Saved then Exit;
2124    end;
2125    lblSumms.Caption := Notifications.Text;
2126    tvSumms.Caption := Notifications.Text;
2127    EditingIndex := -1;
2128    lstSumms.Enabled := True ;
2129    pnlRead.BringToFront ;
2130    x := Notifications.AlertData;
2131    //x := MakeDCSummListItem(Notifications.AlertData);
2132    if StrToIntDef(Piece(x, U, 1), 0) = 0 then
2133      begin
2134        InfoBox(TX_NO_ALERT, TX_CAP_NO_ALERT, MB_OK);
2135        Exit;
2136      end;
2137    uChanging := True;
2138    tvSumms.Items.BeginUpdate;
2139    lstSumms.Clear;
2140    KillDocTreeObjects(tvSumms);
2141    tvSumms.Items.Clear;
2142    lstSumms.Items.Add(x);
2143    AnObject := MakeDCSummTreeObject('ALERT^Alerted Note^^^^^^^^^^^%^0');
2144    tmpNode := tvSumms.Items.AddObjectFirst(tvSumms.Items.GetFirstNode, AnObject.NodeText, AnObject);
2145    TORTreeNode(tmpNode).StringData := 'ALERT^Alerted Note^^^^^^^^^^^%^0';
2146    tmpNode.ImageIndex := IMG_TOP_LEVEL;
2147    AnObject := MakeDCSummTreeObject(x);
2148    tmpNode := tvSumms.Items.AddChildObjectFirst(tmpNode, AnObject.NodeText, AnObject);
2149    TORTreeNode(tmpNode).StringData := x;
2150    SetTreeNodeImagesAndFormatting(TORTreeNode(tmpNode), FCurrentContext, CT_DCSUMM);
2151    tvSumms.Selected := tmpNode;
2152    tvSumms.Items.EndUpdate;
2153    uChanging := False;
2154    tvSummsChange(Self, tvSumms.Selected);
2155    case Notifications.Followup of
2156      NF_DCSUMM_UNSIGNED_NOTE:   ;  //Automatically deleted by sig action!!!
2157    end;
2158    if Copy(Piece(Notifications.RecordID, U, 2), 1, 6) = 'TIUADD' then Notifications.Delete;
2159    if Copy(Piece(Notifications.RecordID, U, 2), 1, 5) = 'TIUID' then Notifications.Delete;
2160  end;
2161  
2162  procedure TfrmDCSumm.SetViewContext(AContext: TTIUContext);
2163  var
2164    Saved: boolean;
2165  begin
2166    if EditingIndex <> -1 then
2167    begin
2168      SaveCurrentSumm(Saved);
2169      if not Saved then Exit;
2170    end;
2171    EditingIndex := -1;
2172    tvSumms.Enabled := True ;
2173    pnlRead.BringToFront ;
2174    if AContext.Status <> '' then with uDCSummContext do
2175      begin
2176        BeginDate      := AContext.BeginDate;
2177        EndDate        := AContext.EndDate;
2178        FMBeginDate    := AContext.FMBeginDate;
2179        FMEndDate      := AContext.FMEndDate;
2180        Status         := AContext.Status;
2181        Author         := AContext.Author;
2182        MaxDocs        := AContext.MaxDocs;
2183        ShowSubject    := AContext.ShowSubject;
2184        GroupBy        := AContext.GroupBy;
2185        SortBy         := AContext.SortBy;
2186        ListAscending  := AContext.ListAscending;
2187        TreeAscending  := AContext.TreeAscending;
2188        Keyword        := AContext.Keyword;
2189        SearchField    := AContext.SearchField;
2190        Filtered       := AContext.Filtered;
2191        Changed        := True;
2192        mnuViewClick(Self);
2193      end
2194    else
2195      begin
2196        ViewContext := NC_RECENT ;
2197        mnuViewClick(Self);
2198      end;
2199  end;
2200  
2201  procedure TfrmDCSumm.mnuViewSaveAsDefaultClick(Sender: TObject);
2202  const
2203    TX_NO_MAX =  'You have not specified a maximum number of summaries to be returned.' + CRLF +
2204                 'If you save this preference, the result will be that ALL summaries for every' + CRLF +
2205                 'patient will be saved as your default view.' + CRLF + CRLF +
2206                 'For patients with large numbers of summaries, this could result in some lengthy' + CRLF +
2207                 'delays in loading the list of summaries.' + CRLF + CRLF +
2208                 'Are you sure you mean to do this?';
2209    TX_REPLACE = 'Replace current defaults?';
2210  begin
2211    inherited;
2212    if FCurrentContext.MaxDocs = 0 then
2213       if InfoBox(TX_NO_MAX,'Warning', MB_YESNO or MB_ICONWARNING) = IDNO then
2214         begin
2215           mnuViewClick(mnuViewCustom);
2216           Exit;
2217         end;
2218    if InfoBox(TX_REPLACE,'Confirmation', MB_YESNO or MB_ICONQUESTION) = IDYES then
2219      begin
2220        SaveCurrentDCSummContext(FCurrentContext);
2221        FDefaultContext := FCurrentContext;
2222        //lblSumms.Caption := 'Default List';
2223      end;
2224  end;
2225  
2226  procedure TfrmDCSumm.mnuViewReturntoDefaultClick(Sender: TObject);
2227  begin
2228    inherited;
2229    SetViewContext(FDefaultContext);
2230  end;
2231  
2232  procedure TfrmDCSumm.popSummMemoTemplateClick(Sender: TObject);
2233  begin
2234    inherited;
2235    EditTemplates(Self, True, FEditCtrl.SelText);
2236  end;
2237  
2238  procedure TfrmDCSumm.popSummListPopup(Sender: TObject);
2239  begin
2240    inherited;
2241    N5.Visible                          := (popSummList.PopupComponent is TORTreeView);
2242    popSummListExpandAll.Visible        := N5.Visible;
2243    popSummListExpandSelected.Visible   := N5.Visible;
2244    popSummListCollapseAll.Visible      := N5.Visible;
2245    popSummListCollapseSelected.Visible := N5.Visible;
2246  end;
2247  
2248  procedure TfrmDCSumm.popSummListExpandAllClick(Sender: TObject);
2249  begin
2250    inherited;
2251    tvSumms.FullExpand;
2252  end;
2253  
2254  procedure TfrmDCSumm.popSummListCollapseAllClick(Sender: TObject);
2255  begin
2256    inherited;
2257    tvSumms.Selected := nil;
2258    lvSumms.Items.Clear;
2259    memSumm.Clear;
2260    tvSumms.FullCollapse;
2261    tvSumms.Selected := tvSumms.TopItem;
2262  end;
2263  
2264  procedure TfrmDCSumm.popSummListExpandSelectedClick(Sender: TObject);
2265  begin
2266    inherited;
2267    if tvSumms.Selected = nil then exit;
2268    with tvSumms.Selected do if HasChildren then Expand(True);
2269  end;
2270  
2271  procedure TfrmDCSumm.popSummListCollapseSelectedClick(Sender: TObject);
2272  begin
2273    inherited;
2274    if tvSumms.Selected = nil then exit;
2275    with tvSumms.Selected do if HasChildren then Collapse(True);
2276  end;
2277  
2278  procedure TfrmDCSumm.mnuNewTemplateClick(Sender: TObject);
2279  begin
2280    inherited;
2281    EditTemplates(Self, True);
2282  end;
2283  
2284  procedure TfrmDCSumm.mnuEditTemplatesClick(Sender: TObject);
2285  begin
2286    inherited;
2287    EditTemplates(Self);
2288  end;
2289  
2290  procedure TfrmDCSumm.mnuOptionsClick(Sender: TObject);
2291  begin
2292    inherited;
2293    mnuEditTemplates.Enabled := frmDrawers.CanEditTemplates;
2294    mnuNewTemplate.Enabled := frmDrawers.CanEditTemplates;
2295    mnuEditSharedTemplates.Enabled := frmDrawers.CanEditShared;
2296    mnuNewSharedTemplate.Enabled := frmDrawers.CanEditShared;
2297    mnuEditDialgFields.Enabled := CanEditTemplateFields;
2298  end;         
2299  
2300  procedure TfrmDCSumm.mnuEditSharedTemplatesClick(Sender: TObject);
2301  begin
2302    inherited;
2303    EditTemplates(Self, FALSE, '', TRUE);
2304  end;
2305  
2306  procedure TfrmDCSumm.mnuNewSharedTemplateClick(Sender: TObject);
2307  begin
2308    inherited;
2309    EditTemplates(Self, TRUE, '', TRUE);
2310  end;
2311  
2312  procedure TfrmDCSumm.FormDestroy(Sender: TObject);
2313  begin
2314    FImageFlag.Free;
2315    FDocList.Free;
2316    KillDocTreeObjects(tvSumms);
2317    inherited;
2318  end;
2319  
2320  function TfrmDCSumm.GetDrawers: TfrmDrawers;
2321  begin
2322    Result := frmDrawers;
2323  end;
2324  
2325  procedure TfrmDCSumm.SetEditingIndex(const Value: Integer);
2326  begin
2327    FEditingIndex := Value;
2328  end;
2329  
2330  (*function TfrmDCSumm.MakeTitleText(IsAddendum: Boolean = False): string;
2331  { returns display text for list box based on FEditNote }
2332  begin
2333    Result := FormatFMDateTime('mmm dd,yy', FEditDCSumm.DischargeDateTime) + U;
2334    if IsAddendum and (CompareText(Copy(FEditDCSumm.TitleName, 1, 8), 'Addendum') <> 0)
2335      then Result := Result + 'Addendum to ';
2336    Result := Result + FEditDCSumm.TitleName + ', ' + FEditDCSumm.LocationName + ', ' +
2337              FEditDCSumm.DictatorName;
2338  end;*)
2339  
2340  function TfrmDCSumm.LacksRequiredForCreate: Boolean;
2341  { determines if the fields required to create the note are present }
2342  var
2343    CurTitle: Integer;
2344    ADateTime:  TFMDateTime;
2345  begin
2346    Result := False;
2347    with FEditDCSumm do
2348    begin
2349      if Title <= 0    then Result := True;
2350      if Dictator <= 0   then Result := True;
2351      if AdmitDateTime <= 0 then Result := True;
2352      if DischargeDateTime > 0 then
2353        ADateTime := DischargeDateTime
2354      else
2355        ADateTime := DictDateTime;
2356      if (DocType = TYP_ADDENDUM) then
2357      begin
2358        if AskCosignerForDocument(Addend, Dictator, ADateTime) and (Cosigner <= 0) then Result := True;
2359      end else
2360      begin
2361        if Title > 0 then CurTitle := Title else CurTitle := DocType;
2362        if AskCosignerForTitle(CurTitle, Dictator, ADateTime) and (Cosigner <= 0) then Result := True;
2363      end;
2364    end;
2365  end;
2366  
2367  function TfrmDCSumm.VerifySummTitle: Boolean;
2368  const
2369    VNT_UNKNOWN = 0;
2370    VNT_NO      = 1;
2371    VNT_YES     = 2;
2372  var
2373    AParam: string;
2374  begin
2375    if FVerifySummTitle = VNT_UNKNOWN then
2376    begin
2377      AParam := GetUserParam('ORWOR VERIFY NOTE TITLE');
2378      if AParam = '1' then FVerifySummTitle := VNT_YES else FVerifySummTitle := VNT_NO;
2379    end;
2380    Result := FVerifySummTitle = VNT_YES;
2381  end;
2382  
2383  function TfrmDCSumm.LockSumm(AnIEN: Int64): Boolean;
2384  { returns true if summ successfully locked }
2385  var
2386    LockMsg: string;
2387  begin
2388    Result := True;
2389    if Changes.Exist(CH_SUM, IntToStr(AnIEN)) then Exit;  // already locked
2390    LockDocument(AnIEN, LockMsg);
2391    if LockMsg <> '' then
2392      begin
2393        Result := False;
2394        InfoBox(LockMsg, TC_NO_LOCK, MB_OK);
2395      end;
2396  end;
2397  
2398  procedure TfrmDCSumm.DoAutoSave(Suppress: integer = 1);
2399  var
2400    ErrMsg: string;
2401  begin
2402    if fFrame.frmFrame.DLLActive = True then Exit;  
2403    if (EditingIndex > -1) and FChanged then
2404    begin
2405      StatusText('Autosaving note...');
2406      //PutTextOnly(ErrMsg, memNewNote.Lines, lstNotes.GetIEN(EditingIndex));
2407      timAutoSave.Enabled := False;
2408      try
2409        SetText(ErrMsg, memNewSumm.Lines, lstSumms.GetIEN(EditingIndex), Suppress);
2410      finally
2411        timAutoSave.Enabled := True;
2412      end;
2413      FChanged := False;
2414      StatusText('');
2415    end;
2416    if ErrMsg <> '' then
2417      InfoBox(TX_SAVE_ERROR1 + ErrMsg + TX_SAVE_ERROR2, TC_SAVE_ERROR, MB_OK or MB_ICONWARNING);
2418    //Assert(ErrMsg = '', 'AutoSave: ' + ErrMsg);
2419  end;
2420  
2421  procedure TfrmDCSumm.timAutoSaveTimer(Sender: TObject);
2422  begin
2423    inherited;
2424    DoAutoSave;
2425  end;
2426  
2427  function TfrmDCSumm.GetTitleText(AnIndex: Integer): string;
2428  { returns non-tabbed text for the title of a note given the ItemIndex in lstSumms }
2429  begin
2430    with lstSumms do
2431      Result := FormatFMDateTime('mmm dd,yy', MakeFMDateTime(Piece(Items[AnIndex], U, 3))) +
2432                '  ' + Piece(Items[AnIndex], U, 2) + ', ' + Piece(Items[AnIndex], U, 6) + ', ' +
2433                Piece(Piece(Items[AnIndex], U, 5), ';', 2)
2434  end;
2435  
2436  procedure TfrmDCSumm.cmdChangeClick(Sender: TObject);
2437  var
2438    LastTitle: Integer;
2439    OKPressed, IsIDChild: Boolean;
2440    x: string;
2441    ListItemForEdit: string;
2442  begin
2443    inherited;
2444    IsIDChild := uIDNotesActive and (FEditDCSumm.IDParent > 0);
2445    LastTitle   := FEditDCSumm.Title;
2446    if Sender <> Self then
2447      begin
2448        FShowAdmissions := False;
2449        OKPressed := ExecuteDCSummProperties(FEditDCSumm, ListItemForEdit, FShowAdmissions, IsIDChild);
2450      end
2451    else
2452      OKPressed := True;
2453    if not OKPressed then Exit;
2454    // update display fields & uPCEEdit
2455    lblNewTitle.Caption := ' ' + FEditDCSumm.TitleName + ' ';
2456    if (FEditDCSumm.Addend > 0)  and (CompareText(Copy(lblNewTitle.Caption, 2, 8), 'Addendum') <> 0) then
2457      lblNewTitle.Caption := 'Addendum to: ' + lblNewTitle.Caption;
2458    with lblNewTitle do bvlNewTitle.SetBounds(Left - 1, Top - 1, Width + 2, Height + 2);
2459    lblRefDate.Caption := FormatFMDateTime('mmm dd,yyyy@hh:nn', FEditDCSumm.DischargeDateTime);
2460    lblDictator.Caption  := FEditDCSumm.DictatorName;
2461    x := 'Adm: ' + FormatFMDateTime('mm/dd/yy', FEditDCSumm.AdmitDateTime) + '  ' + FEditDCSumm.LocationName;
2462    lblVisit.Caption   := x;
2463    x := '  Dis: ' + FormatFMDateTime('mm/dd/yy', FEditDCSumm.DischargeDateTime);
2464    lblDischarge.Caption := x;
2465    if Length(FEditDCSumm.AttendingName) > 0
2466      then lblCosigner.Caption := 'Attending: ' + FEditDCSumm.AttendingName
2467      else lblCosigner.Caption := '';
2468    uPCEEdit.NoteTitle  := FEditDCSumm.Title;
2469    // modify signature requirements if author or cosigner changed
2470    if (User.DUZ <> FEditDCSumm.Dictator) and (User.DUZ <> FEditDCSumm.Attending)
2471      then Changes.ReplaceSignState(CH_SUM, lstSumms.ItemID, CH_SIGN_NA)
2472      else Changes.ReplaceSignState(CH_SUM, lstSumms.ItemID, CH_SIGN_YES);
2473    x := lstSumms.Items[EditingIndex];
2474    SetPiece(x, U, 2, lblNewTitle.Caption);
2475    SetPiece(x, U, 3, FloatToStr(FEditDCSumm.DischargeDateTime));
2476    tvSumms.Selected.Text := MakeDCSummDisplayText(x);
2477    TORTreeNode(tvSumms.Selected).StringData := x;
2478    lstSumms.Items[EditingIndex] := x;
2479    Changes.ReplaceText(CH_SUM, lstSumms.ItemID, GetTitleText(EditingIndex));
2480    if LastTitle <> FEditDCSumm.Title then mnuActLoadBoilerClick(Self);
2481  end;
2482  
2483  procedure TfrmDCSumm.mnuActChangeClick(Sender: TObject);
2484  begin
2485    inherited;
2486    if NoSummSelected() then Exit;
2487    if (FEditingIndex < 0) or (lstSumms.ItemIndex <> FEditingIndex) then Exit;
2488    cmdChangeClick(Sender);
2489  end;
2490  
2491  procedure TfrmDCSumm.mnuActLoadBoilerClick(Sender: TObject);
2492  var
2493    NoteEmpty: Boolean;
2494    BoilerText: TStringList;
2495    DocInfo: string;
2496  
2497    procedure AssignBoilerText;
2498    begin
2499      ExecuteTemplateOrBoilerPlate(BoilerText, FEditDCSumm.Title, ltTitle, Self, 'Title: ' + FEditDCSumm.TitleName, DocInfo);
2500      QuickCopyWith508Msg(BoilerText, memNewSumm);
2501      FChanged := False;
2502    end;
2503  
2504  begin
2505    inherited;
2506    if NoSummSelected() then Exit;
2507    if (FEditingIndex < 0) or (lstSumms.ItemIndex <> FEditingIndex) then Exit;
2508    BoilerText := TStringList.Create;
2509    try
2510      NoteEmpty := memNewSumm.Text = '';
2511      LoadBoilerPlate(BoilerText, FEditDCSumm.Title);
2512      if (BoilerText.Text <> '') or
2513         assigned(GetLinkedTemplate(IntToStr(FEditDCSumm.Title), ltTitle)) then
2514      begin
2515        DocInfo := MakeXMLParamTIU(IntToStr(lstSumms.ItemIEN), FEditDCSumm);
2516        if NoteEmpty then AssignBoilerText else
2517        begin
2518          case QueryBoilerPlate(BoilerText) of
2519          0:  { do nothing } ;                         // ignore
2520          1: begin
2521               ExecuteTemplateOrBoilerPlate(BoilerText, FEditDCSumm.Title, ltTitle, Self, 'Title: ' + FEditDCSumm.TitleName, DocInfo);
2522               QuickAddWith508Msg(BoilerText, memNewSumm);  // append
2523             end;
2524          2: AssignBoilerText                          // replace
2525          end;
2526        end;
2527      end else
2528      begin
2529        if Sender = mnuActLoadBoiler
2530          then InfoBox(TX_NO_BOIL, TC_NO_BOIL, MB_OK)
2531          else
2532          begin
2533            if not NoteEmpty then
2534              if not FChanged and (InfoBox(TX_BLR_CLEAR, TC_BLR_CLEAR, MB_YESNO) = ID_YES)
2535                then memNewSumm.Lines.Clear;
2536          end;
2537      end; {if BoilerText.Text <> ''}
2538    finally
2539      BoilerText.Free;
2540    end;
2541  end;
2542  
2543  procedure TfrmDCSumm.popSummMemoSaveContinueClick(Sender: TObject);
2544  begin
2545    inherited;
2546    FChanged := True;
2547    DoAutoSave;
2548  end;
2549  
2550  procedure TfrmDCSumm.mnuEditDialgFieldsClick(Sender: TObject);
2551  begin
2552    inherited;
2553    EditDialogFields;
2554  end;
2555  
2556  //===================  Added for sort/search enhancements ======================
2557  procedure TfrmDCSumm.LoadSumms;
2558  var
2559    tmpList: TStringList;
2560    ANode: TORTreeNode;
2561  
2562  begin
2563    tmpList := TStringList.Create;
2564    try
2565      FDocList.Clear;
2566      uChanging := True;
2567      RedrawSuspend(memSumm.Handle);
2568      RedrawSuspend(lvSumms.Handle);
2569      tvSumms.Items.BeginUpdate;
2570      lstSumms.Items.Clear;
2571      KillDocTreeObjects(tvSumms);
2572      tvSumms.Items.Clear;
2573      tvSumms.Items.EndUpdate;
2574      lvSumms.Items.Clear;
2575      memSumm.Clear;
2576      memSumm.Invalidate;
2577      lblTitle.Caption := '';
2578      lvSumms.Caption := lblTitle.Caption;
2579      lblTitle.Hint := lblTitle.Caption;
2580      with FCurrentContext do
2581        begin
2582          if Status <> IntToStr(NC_UNSIGNED) then
2583            begin
2584              ListSummsForTree(tmpList, NC_UNSIGNED, 0, 0, 0, 0, TreeAscending);
2585              if tmpList.Count > 0 then
2586                begin
2587                  CreateListItemsForDocumentTree(FDocList, tmpList, NC_UNSIGNED, GroupBy, TreeAscending, CT_DCSUMM);
2588                  UpdateTreeView(FDocList, tvSumms);
2589                end;
2590              tmpList.Clear;
2591              FDocList.Clear;
2592            end;
2593          if Status <> IntToStr(NC_UNCOSIGNED) then
2594            begin
2595              ListSummsForTree(tmpList, NC_UNCOSIGNED, 0, 0, 0, 0, TreeAscending);
2596              if tmpList.Count > 0 then
2597                begin
2598                  CreateListItemsForDocumentTree(FDocList, tmpList, NC_UNCOSIGNED, GroupBy, TreeAscending, CT_DCSUMM);
2599                  UpdateTreeView(FDocList, tvSumms);
2600                end;
2601              tmpList.Clear;
2602              FDocList.Clear;
2603            end;
2604          ListSummsForTree(tmpList, StrToIntDef(Status, 0), FMBeginDate, FMEndDate, Author, MaxDocs, TreeAscending);
2605          CreateListItemsForDocumentTree(FDocList, tmpList, StrToIntDef(Status, 0), GroupBy, TreeAscending, CT_DCSUMM);
2606          UpdateTreeView(FDocList, tvSumms);
2607        end;
2608      with tvSumms do
2609        begin
2610          uChanging := True;
2611          tvSumms.Items.BeginUpdate;
2612          RemoveParentsWithNoChildren(tvSumms, FCurrentContext);   // moved TO here in v15.9  (RV)
2613          if FLastSummID <> '' then
2614            Selected := FindPieceNode(FLastSummID, 1, U, nil);
2615          if Selected = nil then
2616            begin
2617              if (FCurrentContext.GroupBy <> '') or (FCurrentContext.Filtered) then
2618                begin
2619                  ANode := TORTreeNode(Items.GetFirstNode);
2620                  while ANode <> nil do
2621                    begin
2622                      ANode.Expand(False);
2623                      Selected := ANode;
2624                      ANode := TORTreeNode(ANode.GetNextSibling);
2625                    end;
2626                end
2627              else
2628                begin
2629                  ANode := tvSumms.FindPieceNode(FCurrentContext.Status, 1, U, nil);
2630                  if ANode <> nil then ANode.Expand(False);
2631                  ANode := tvSumms.FindPieceNode(IntToStr(NC_UNSIGNED), 1, U, nil);
2632                  if ANode = nil then
2633                    ANode := tvSumms.FindPieceNode(IntToStr(NC_UNCOSIGNED), 1, U, nil);
2634                  if ANode = nil then
2635                    ANode := tvSumms.FindPieceNode(FCurrentContext.Status, 1, U, nil);
2636                  if ANode <> nil then
2637                    begin
2638                      if ANode.getFirstChild <> nil then
2639                        Selected := ANode.getFirstChild
2640                      else
2641                        Selected := ANode;
2642                    end;
2643                end;
2644            end;
2645          memSumm.Clear;
2646          with lvSumms do
2647            begin
2648              Selected := nil;
2649              if FCurrentContext.SortBy <> '' then
2650                ColumnToSort := Pos(FCurrentContext.SortBy, 'RDSAL') - 1;
2651              if not FCurrentContext.ShowSubject then
2652                begin
2653                  Columns[1].Width := 2 * (Width div 5);
2654                  Columns[2].Width := 0;
2655                end
2656              else
2657                begin
2658                  Columns[1].Width := Width div 5;
2659                  Columns[2].Width := Columns[1].Width;
2660                end;
2661            end;
2662          //RemoveParentsWithNoChildren(tvSumms, FCurrentContext);  //moved FROM here in v15.9  (RV)
2663          tvSumms.Items.EndUpdate;
2664          uChanging := False;
2665          SendMessage(tvSumms.Handle, WM_VSCROLL, SB_TOP, 0);
2666          if Selected <> nil then tvSummsChange(Self, Selected);
2667        end;
2668    finally
2669      RedrawActivate(memSumm.Handle);
2670      RedrawActivate(lvSumms.Handle);
2671      tmpList.Free;
2672    end;
2673  end;
2674  
2675  procedure TfrmDCSumm.UpdateTreeView(DocList: TStringList; Tree: TORTreeView);
2676  begin
2677    with Tree do
2678      begin
2679        uChanging := True;
2680        Items.BeginUpdate;
2681        FastAddStrings(DocList, lstSumms.Items);
2682        BuildDocumentTree(DocList, '0', Tree, nil, FCurrentContext, CT_DCSUMM);
2683        Items.EndUpdate;
2684        uChanging := False;
2685      end;
2686  end;
2687  
2688  procedure TfrmDCSumm.tvSummsChange(Sender: TObject; Node: TTreeNode);
2689  var
2690    x, MySearch, MyNodeID: string;
2691    i: integer;
2692    WhyNot: string;
2693  begin
2694    if uChanging then Exit;
2695    //This gives the change a chance to occur when keyboarding, so that WindowEyes
2696    //doesn't use the old value.
2697    Application.ProcessMessages;
2698    with tvSumms do
2699      begin
2700        memSumm.Clear;
2701        if Selected = nil then Exit;
2702        if uIDNotesActive then
2703          begin
2704            mnuActDetachFromIDParent.Enabled := (Selected.ImageIndex in [IMG_ID_CHILD, IMG_ID_CHILD_ADD]);
2705            popSummListDetachFromIDParent.Enabled := (Selected.ImageIndex in [IMG_ID_CHILD, IMG_ID_CHILD_ADD]);
2706            if (Selected.ImageIndex in [IMG_SINGLE, IMG_PARENT, IMG_ID_CHILD, IMG_ID_CHILD_ADD]) then
2707              mnuActAttachtoIDParent.Enabled := CanBeAttached(PDocTreeObject(Selected.Data)^.DocID, WhyNot)
2708            else
2709              mnuActAttachtoIDParent.Enabled := False;
2710            popSummListAttachtoIDParent.Enabled := mnuActAttachtoIDParent.Enabled;
2711            if (Selected.ImageIndex in [IMG_SINGLE, IMG_PARENT,
2712                                        IMG_IDNOTE_OPEN, IMG_IDNOTE_SHUT,
2713                                        IMG_IDPAR_ADDENDA_OPEN, IMG_IDPAR_ADDENDA_SHUT]) then
2714              mnuActAddIDEntry.Enabled := CanReceiveAttachment(PDocTreeObject(Selected.Data)^.DocID, WhyNot)
2715            else
2716              mnuActAddIDEntry.Enabled := False;
2717            popSummListAddIDEntry.Enabled := mnuActAddIDEntry.Enabled
2718          end;
2719        RedrawSuspend(lvSumms.Handle);
2720        RedrawSuspend(memSumm.Handle);
2721        popSummListExpandSelected.Enabled := Selected.HasChildren;
2722        popSummListCollapseSelected.Enabled := Selected.HasChildren;
2723        x := TORTreeNode(Selected).StringData;
2724        if (Selected.ImageIndex in [IMG_TOP_LEVEL, IMG_GROUP_OPEN, IMG_GROUP_SHUT]) then
2725          begin
2726            lvSumms.Visible := True;
2727            lvSumms.Items.Clear;
2728            lvSumms.Height := (2 * lvSumms.Parent.Height) div 5;
2729            with lblTitle do
2730              begin
2731                Caption := Trim(Selected.Text);
2732                if (FCurrentContext.SearchField <> '') and (FCurrentContext.Filtered) then
2733                  begin
2734                    case FCurrentContext.SearchField[1] of
2735                      'T': MySearch := 'TITLE';
2736                      'S': MySearch := 'SUBJECT';
2737                      'B': MySearch := 'TITLE or SUBJECT';
2738                    end;
2739                    Caption := Caption + ' where ' + MySearch + ' contains "' + UpperCase(FCurrentContext.Keyword) + '"';
2740                  end;
2741                Hint := Caption;
2742                lvSumms.Caption := Caption;
2743              end;
2744  
2745            if Selected.ImageIndex = IMG_TOP_LEVEL then
2746              MyNodeID := Piece(TORTreeNode(Selected).StringData, U, 1)
2747            else if Selected.Parent.ImageIndex = IMG_TOP_LEVEL then
2748              MyNodeID := Piece(TORTreeNode(Selected.Parent).StringData, U, 1)
2749            else if Selected.Parent.Parent.ImageIndex = IMG_TOP_LEVEL then
2750              MyNodeID := Piece(TORTreeNode(Selected.Parent.Parent).StringData, U, 1);
2751  
2752            uChanging := True;
2753            TraverseTree(tvSumms, lvSumms, Selected.GetFirstChild, MyNodeID, FCurrentContext);
2754            with lvSumms do
2755              begin
2756                for i := 0 to Columns.Count - 1 do
2757                  Columns[i].ImageIndex := IMG_NONE;
2758                ColumnSortForward := FCurrentContext.ListAscending;
2759                if ColumnToSort = 5 then ColumnToSort := 0;
2760                if ColumnSortForward then
2761                  Columns[ColumnToSort].ImageIndex := IMG_ASCENDING
2762                else
2763                  Columns[ColumnToSort].ImageIndex := IMG_DESCENDING;
2764                if ColumnToSort = 0 then ColumnToSort := 5;
2765                AlphaSort;
2766                Columns[5].Width := 0;
2767                Columns[6].Width := 0;
2768              end;
2769            uChanging := False;
2770            with lvSumms do
2771              if Items.Count > 0 then
2772                begin
2773                  Selected := Items[0];
2774                  lvSummsSelectItem(Self, Selected, True);
2775                end
2776              else
2777                begin
2778                  Selected := nil;
2779                  lstSumms.ItemIndex := -1;
2780                  memPCEShow.Clear;
2781                  ShowPCEControls(False);
2782                end;
2783            pnlWrite.Visible := False;
2784            pnlRead.Visible := True;
2785  (*          UpdateReminderFinish;
2786            ShowPCEControls(False);
2787            frmDrawers.DisplayDrawers(FALSE);
2788            cmdNewSumm.Visible := TRUE;
2789            cmdPCE.Visible := FALSE;
2790            lblSpace1.Top := cmdNewSumm.Top - lblSpace1.Height;*)
2791            //memSumm.Clear;
2792          end
2793        else if StrToIntDef(Piece(x, U, 1), 0) > 0 then
2794          begin
2795            memSumm.Clear;
2796            lvSumms.Visible := False;
2797            lstSumms.SelectByID(Piece(x, U, 1));
2798            lstSummsClick(Self);
2799            SendMessage(memSumm.Handle, WM_VSCROLL, SB_TOP, 0);
2800          end;
2801        SendMessage(tvSumms.Handle, WM_HSCROLL, SB_THUMBTRACK, 0);
2802        RedrawActivate(lvSumms.Handle);
2803        RedrawActivate(memSumm.Handle);
2804      end;
2805  end;
2806  
2807  procedure TfrmDCSumm.tvSummsCollapsed(Sender: TObject; Node: TTreeNode);
2808  begin
2809    with Node do
2810      begin
2811        if (ImageIndex in [IMG_GROUP_OPEN, IMG_IDNOTE_OPEN, IMG_IDPAR_ADDENDA_OPEN]) then
2812          ImageIndex := ImageIndex - 1;
2813        if (SelectedIndex in [IMG_GROUP_OPEN, IMG_IDNOTE_OPEN, IMG_IDPAR_ADDENDA_OPEN]) then
2814          SelectedIndex := SelectedIndex - 1;
2815      end;
2816  end;
2817  
2818  procedure TfrmDCSumm.tvSummsExpanded(Sender: TObject; Node: TTreeNode);
2819  
2820    function SortByTitle(Node1, Node2: TTreeNode; Data: Longint): Integer; stdcall;
2821    begin
2822      { Within an ID parent node, sorts in ascending order by title
2823      BUT - addenda to parent document are always at the top of the sort, in date order}
2824      if (Copy(PDocTreeObject(Node1.Data)^.DocTitle, 1, 8) = 'Addendum') and
2825         (Copy(PDocTreeObject(Node2.Data)^.DocTitle, 1, 8) = 'Addendum') then
2826        begin
2827          Result :=  AnsiStrIComp(PChar(PDocTreeObject(Node1.Data)^.DocFMDate),
2828                                  PChar(PDocTreeObject(Node2.Data)^.DocFMDate));
2829        end
2830      else if Copy(PDocTreeObject(Node1.Data)^.DocTitle, 1, 8) = 'Addendum' then Result := -1
2831      else if Copy(PDocTreeObject(Node2.Data)^.DocTitle, 1, 8) = 'Addendum' then Result := 1
2832      else
2833        begin
2834          if Data = 0 then
2835            Result :=  AnsiStrIComp(PChar(PDocTreeObject(Node1.Data)^.DocTitle),
2836                                    PChar(PDocTreeObject(Node2.Data)^.DocTitle))
2837          else
2838            Result := -AnsiStrIComp(PChar(PDocTreeObject(Node1.Data)^.DocTitle),
2839                                    PChar(PDocTreeObject(Node2.Data)^.DocTitle));
2840        end
2841    end;
2842  
2843    function SortByDate(Node1, Node2: TTreeNode; Data: Longint): Integer; stdcall;
2844    begin
2845      { Within an ID parent node, sorts in ascending order by document date
2846      BUT - addenda to parent document are always at the top of the sort, in date order}
2847      if (Copy(PDocTreeObject(Node1.Data)^.DocTitle, 1, 8) = 'Addendum') and
2848         (Copy(PDocTreeObject(Node2.Data)^.DocTitle, 1, 8) = 'Addendum') then
2849        begin
2850          Result :=  AnsiStrIComp(PChar(PDocTreeObject(Node1.Data)^.DocFMDate),
2851                                  PChar(PDocTreeObject(Node2.Data)^.DocFMDate));
2852        end
2853      else if Copy(PDocTreeObject(Node1.Data)^.DocTitle, 1, 8) = 'Addendum' then Result := -1
2854      else if Copy(PDocTreeObject(Node2.Data)^.DocTitle, 1, 8) = 'Addendum' then Result := 1
2855      else
2856        begin
2857          if Data = 0 then
2858            Result :=  AnsiStrIComp(PChar(PDocTreeObject(Node1.Data)^.DocFMDate),
2859                                    PChar(PDocTreeObject(Node2.Data)^.DocFMDate))
2860          else
2861            Result := -AnsiStrIComp(PChar(PDocTreeObject(Node1.Data)^.DocFMDate),
2862                                    PChar(PDocTreeObject(Node2.Data)^.DocFMDate));
2863        end;
2864    end;
2865  
2866  begin
2867    with Node do
2868      begin
2869        if Assigned(Data) then
2870          if (Pos('<', PDocTreeObject(Data)^.DocHasChildren) > 0) then
2871            begin
2872              if (PDocTreeObject(Node.Data)^.OrderByTitle) then
2873                CustomSort(@SortByTitle, 0)
2874              else
2875                CustomSort(@SortByDate, 0);
2876            end;
2877        if (ImageIndex in [IMG_GROUP_SHUT, IMG_IDNOTE_SHUT, IMG_IDPAR_ADDENDA_SHUT]) then
2878          ImageIndex := ImageIndex + 1;
2879        if (SelectedIndex in [IMG_GROUP_SHUT, IMG_IDNOTE_SHUT, IMG_IDPAR_ADDENDA_SHUT]) then
2880          SelectedIndex := SelectedIndex + 1;
2881      end;
2882  end;
2883  
2884  procedure TfrmDCSumm.tvSummsClick(Sender: TObject);
2885  begin
2886  (*  if tvSumms.Selected = nil then exit;
2887    if (tvSumms.Selected.ImageIndex in [IMG_TOP_LEVEL, IMG_GROUP_OPEN, IMG_GROUP_SHUT]) then
2888      begin
2889        uChanging := True;
2890        lvSumms.Selected := nil;
2891        uChanging := False;
2892        memSumm.Clear;
2893      end;*)
2894  end;
2895  
2896  procedure TfrmDCSumm.tvSummsDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
2897  var
2898    AnItem: TORTreeNode;
2899  begin
2900    Accept := False;
2901    if not uIDNotesActive then exit;
2902    AnItem := TORTreeNode(tvSumms.GetNodeAt(X, Y));
2903    if (AnItem = nil) or (AnItem.ImageIndex in [IMG_GROUP_OPEN, IMG_GROUP_SHUT, IMG_TOP_LEVEL]) then Exit;
2904    with tvSumms.Selected do
2905      if (ImageIndex in [IMG_SINGLE, IMG_PARENT, IMG_ID_CHILD, IMG_ID_CHILD_ADD]) then
2906        Accept := (AnItem.ImageIndex in [IMG_SINGLE, IMG_PARENT,
2907                                         IMG_IDNOTE_OPEN, IMG_IDNOTE_SHUT,
2908                                         IMG_IDPAR_ADDENDA_OPEN, IMG_IDPAR_ADDENDA_SHUT])
2909      else if (ImageIndex in [IMG_IDNOTE_OPEN, IMG_IDNOTE_SHUT, IMG_IDPAR_ADDENDA_OPEN, IMG_IDPAR_ADDENDA_SHUT]) then
2910        Accept := (AnItem.ImageIndex in [IMG_GROUP_OPEN, IMG_GROUP_SHUT, IMG_TOP_LEVEL])
2911      else if (ImageIndex in [IMG_ADDENDUM, IMG_GROUP_OPEN, IMG_GROUP_SHUT, IMG_TOP_LEVEL]) then
2912        Accept := False;
2913  end;
2914  
2915  procedure TfrmDCSumm.tvSummsDragDrop(Sender, Source: TObject; X, Y: Integer);
2916  var
2917    HT: THitTests;
2918    Saved: boolean;
2919    ADestNode: TORTreeNode;
2920  begin
2921    if not uIDNotesActive then
2922      begin
2923        CancelDrag;
2924        exit;
2925      end;
2926    if tvSumms.Selected = nil then exit;
2927    if EditingIndex <> -1 then
2928    begin
2929      SaveCurrentSumm(Saved);
2930      if not Saved then Exit;
2931    end;
2932    HT := tvSumms.GetHitTestInfoAt(X, Y);
2933    ADestNode := TORTreeNode(tvSumms.GetNodeAt(X, Y));
2934    DoAttachIDChild(TORTreeNode(tvSumms.Selected), ADestNode);
2935  end;
2936  
2937  procedure TfrmDCSumm.tvSummsStartDrag(Sender: TObject;
2938    var DragObject: TDragObject);
2939  const
2940    TX_CAP_NO_DRAG = 'Item cannot be moved';
2941    var
2942    WhyNot: string;
2943    Saved: boolean;
2944  begin
2945    if (tvSumms.Selected.ImageIndex in [IMG_ADDENDUM, IMG_GROUP_OPEN, IMG_GROUP_SHUT, IMG_TOP_LEVEL]) or
2946       (not uIDNotesActive) or
2947       (lstSumms.ItemIEN = 0) then
2948      begin
2949        CancelDrag;
2950        Exit;
2951      end;
2952    if EditingIndex <> -1 then
2953    begin
2954      SaveCurrentSumm(Saved);
2955      if not Saved then Exit;
2956    end;
2957    if not CanBeAttached(PDocTreeObject(tvSumms.Selected.Data)^.DocID, WhyNot) then
2958      begin
2959        InfoBox(WhyNot, TX_CAP_NO_DRAG, MB_OK);
2960        CancelDrag;
2961      end;
2962  end;
2963  
2964  procedure TfrmDCSumm.lvSummsColumnClick(Sender: TObject; Column: TListColumn);
2965  var
2966    i, ClickedColumn: Integer;
2967  begin
2968    if Column.Index = 0 then ClickedColumn := 5 else ClickedColumn := Column.Index;
2969    if ClickedColumn = ColumnToSort then
2970      ColumnSortForward := not ColumnSortForward
2971    else
2972      ColumnSortForward := True;
2973    for i := 0 to lvSumms.Columns.Count - 1 do
2974      lvSumms.Columns[i].ImageIndex := IMG_NONE;
2975    if ColumnSortForward then lvSumms.Columns[Column.Index].ImageIndex := IMG_ASCENDING
2976    else lvSumms.Columns[Column.Index].ImageIndex := IMG_DESCENDING;
2977    ColumnToSort := ClickedColumn;
2978    case ColumnToSort of
2979      5:  FCurrentContext.SortBy := 'R';
2980      1:  FCurrentContext.SortBy := 'D';
2981      2:  FCurrentContext.SortBy := 'S';
2982      3:  FCurrentContext.SortBy := 'A';
2983      4:  FCurrentContext.SortBy := 'L';
2984    else
2985      FCurrentContext.SortBy := 'R';
2986    end;
2987    FCurrentContext.ListAscending := ColumnSortForward;
2988    (Sender as TCustomListView).AlphaSort;
2989    //with lvSumms do if Selected <> nil then Scroll(0,  Selected.Top - TopItem.Top);
2990  end;
2991  
2992  procedure TfrmDCSumm.lvSummsCompare(Sender: TObject; Item1, Item2: TListItem; Data: Integer; var Compare: Integer);
2993  var
2994    ix: Integer;
2995  begin
2996    if ColumnToSort = 0 then
2997      Compare := CompareText(Item1.Caption,Item2.Caption)
2998    else begin
2999     ix := ColumnToSort - 1;
3000     Compare := CompareText(Item1.SubItems[ix],Item2.SubItems[ix]);
3001    end;
3002    if not ColumnSortForward then Compare := -Compare;
3003  end;
3004  
3005  procedure TfrmDCSumm.lvSummsSelectItem(Sender: TObject; Item: TListItem;
3006    Selected: Boolean);
3007  begin
3008    if uChanging or (not Selected) then Exit;
3009    with lvSumms do
3010      begin
3011        StatusText('Retrieving selected discharge summary...');
3012        lstSumms.SelectByID(Item.SubItems[5]);
3013        lstSummsClick(Self);
3014        SendMessage(memSumm.Handle, WM_VSCROLL, SB_TOP, 0);
3015      end;
3016  end;
3017  
3018  procedure TfrmDCSumm.lvSummsResize(Sender: TObject);
3019  begin
3020    inherited;
3021    with lvSumms do
3022      begin
3023        if not FCurrentContext.ShowSubject then
3024          begin
3025            Columns[1].Width := 2 * (Width div 5);
3026            Columns[2].Width := 0;
3027          end
3028        else
3029          begin
3030            Columns[1].Width := Width div 5;
3031            Columns[2].Width := Columns[1].Width;
3032          end;
3033      end;
3034  end;
3035  
3036  procedure TfrmDCSumm.EnableDisableIDNotes;
3037  begin
3038    uIDNotesActive := False; // := IDNotesInstalled;       Not yet on this tab
3039    mnuActDetachFromIDParent.Visible := uIDNotesActive;
3040    popSummListDetachFromIDParent.Visible := uIDNotesActive;
3041    mnuActAddIDEntry.Visible := uIDNotesActive;
3042    popSummListAddIDEntry.Visible := uIDNotesActive;
3043    mnuActAttachtoIDParent.Visible := uIDNotesActive;
3044    popSummListAttachtoIDParent.Visible := uIDNotesActive;
3045    if uIDNotesActive then
3046      tvSumms.DragMode := dmAutomatic
3047    else
3048      tvSumms.DragMode := dmManual;
3049  end;
3050  
3051  procedure TfrmDCSumm.mnuIconLegendClick(Sender: TObject);
3052  begin
3053    inherited;
3054    ShowIconLegend(ilNotes);
3055  end;
3056  
3057  procedure TfrmDCSumm.mnuActAttachtoIDParentClick(Sender: TObject);
3058  var
3059    AChildNode: TORTreeNode;
3060    AParentID: string;
3061    SavedDocID: string;
3062    Saved: boolean;
3063  begin
3064    inherited;
3065    if not uIDNotesActive then exit;
3066    if lstSumms.ItemIEN = 0 then exit;
3067    SavedDocID := lstSumms.ItemID;
3068    if EditingIndex <> -1 then
3069    begin
3070      SaveCurrentSumm(Saved);
3071      if not Saved then Exit;
3072      LoadSumms;
3073      with tvSumms do Selected := FindPieceNode(SavedDocID, U, Items.GetFirstNode);
3074    end;
3075    if tvSumms.Selected = nil then exit;
3076    AChildNode := TORTreeNode(tvSumms.Selected);
3077    AParentID := SelectParentNodeFromList(tvSumms);
3078    if AParentID = '' then exit;
3079    with tvSumms do Selected := FindPieceNode(AParentID, 1, U, Items.GetFirstNode);
3080    DoAttachIDChild(AChildNode, TORTreeNode(tvSumms.Selected));
3081  end;
3082  
3083  procedure TfrmDCSumm.DoAttachIDChild(AChild, AParent: TORTreeNode);
3084  const
3085    TX_ATTACH_CNF     = 'Confirm Attachment';
3086    TX_ATTACH_FAILURE = 'Attachment failed';
3087  var
3088    ErrMsg, WhyNot: string;
3089    SavedDocID: string;
3090  begin
3091    if (AChild = nil) or (AParent = nil) then exit;
3092    ErrMsg := '';
3093    if not CanBeAttached(PDocTreeObject(AChild.Data)^.DocID, WhyNot) then
3094      ErrMsg := ErrMsg + WhyNot + CRLF + CRLF;
3095    if not CanReceiveAttachment(PDocTreeObject(AParent.Data)^.DocID, WhyNot) then
3096      ErrMsg := ErrMsg + WhyNot;
3097    if ErrMsg <> '' then
3098      begin
3099        InfoBox(ErrMsg, TX_ATTACH_FAILURE, MB_OK);
3100        Exit;
3101      end
3102    else
3103      begin
3104        WhyNot := '';
3105        if (InfoBox('ATTACH:   ' + AChild.Text + CRLF + CRLF +
3106                    '    TO:   ' + AParent.Text + CRLF + CRLF +
3107                    'Are you sure?', TX_ATTACH_CNF, MB_YESNO or MB_DEFBUTTON2 or MB_ICONQUESTION) <> IDYES)
3108            then Exit;
3109        SavedDocID := PDocTreeObject(AParent.Data)^.DocID;
3110      end;
3111    if AChild.ImageIndex in [IMG_ID_CHILD, IMG_ID_CHILD_ADD] then
3112      begin
3113        if DetachEntryFromParent(PDocTreeObject(AChild.Data)^.DocID, WhyNot) then
3114          begin
3115            if AttachEntryToParent(PDocTreeObject(AChild.Data)^.DocID, PDocTreeObject(AParent.Data)^.DocID, WhyNot) then
3116              begin
3117                LoadSumms;
3118                with tvSumms do Selected := FindPieceNode(SavedDocID, U, Items.GetFirstNode);
3119                if tvSumms.Selected <> nil then tvSumms.Selected.Expand(False);
3120              end
3121            else
3122              InfoBox(WhyNot, TX_ATTACH_FAILURE, MB_OK);
3123          end
3124        else
3125          begin
3126            WhyNot := StringReplace(WhyNot, 'ATTACH', 'DETACH', [rfIgnoreCase]);
3127            WhyNot := StringReplace(WhyNot, 'to an ID', 'from an ID', [rfIgnoreCase]);
3128            InfoBox(WhyNot, TX_DETACH_FAILURE, MB_OK);
3129            Exit;
3130          end;
3131      end
3132    else
3133      begin
3134        if AttachEntryToParent(PDocTreeObject(AChild.Data)^.DocID, PDocTreeObject(AParent.Data)^.DocID, WhyNot) then
3135          begin
3136            LoadSumms;
3137            with tvSumms do Selected := FindPieceNode(SavedDocID, U, Items.GetFirstNode);
3138            if tvSumms.Selected <> nil then tvSumms.Selected.Expand(False);
3139          end
3140        else
3141          InfoBox(WhyNot, TX_ATTACH_FAILURE, MB_OK);
3142     end;
3143  end;
3144  
3145  function TfrmDCSumm.SetSummTreeLabel(AContext: TTIUContext): string;
3146  var
3147    x: string;
3148  
3149    function SetDateRangeText(AContext: TTIUContext): string;
3150    var
3151      x1: string;
3152    begin
3153      with AContext do
3154        if BeginDate <> '' then
3155          begin
3156            x1 := ' from ' + UpperCase(BeginDate);
3157            if EndDate <> '' then x1 := x1 + ' to ' + UpperCase(EndDate)
3158            else x1 := x1 + ' to TODAY';
3159          end;
3160      Result := x1;
3161    end;
3162  
3163  begin
3164    with AContext do
3165      begin
3166        if MaxDocs > 0 then x := 'Last ' + IntToStr(MaxDocs) + ' ' else x := 'All ';
3167        case StrToIntDef(Status, 0) of
3168          NC_ALL        : x := x + 'Signed Summaries';
3169          NC_UNSIGNED   : begin
3170                            x := x + 'Unsigned Summaries for ';
3171                            if Author > 0 then x := x + ExternalName(Author, 200)
3172                            else x := x + User.Name;
3173                            x := x + SetDateRangeText(AContext);
3174                          end;
3175          NC_UNCOSIGNED : begin
3176                            x := x + 'Uncosigned Summaries for ';
3177                            if Author > 0 then x := x + ExternalName(Author, 200)
3178                            else x := x + User.Name;
3179                            x := x + SetDateRangeText(AContext);
3180                          end;
3181          NC_BY_AUTHOR  : x := x + 'Signed Summaries for ' + ExternalName(Author, 200) + SetDateRangeText(AContext);
3182          NC_BY_DATE    : x := x + 'Signed Summaries ' + SetDateRangeText(AContext);
3183        else
3184          x := 'Custom List';
3185        end;
3186      end;
3187    Result := x;
3188  end;
3189  
3190  procedure TfrmDCSumm.memNewSummKeyUp(Sender: TObject; var Key: Word;
3191    Shift: TShiftState);
3192  begin
3193    inherited;
3194    if (Key = VK_TAB) then
3195    begin
3196      if ssShift in Shift then
3197      begin
3198        FindNextControl(Sender as TWinControl, False, True, False).SetFocus; //previous control
3199        Key := 0;
3200      end
3201      else if ssCtrl	in Shift then
3202      begin
3203        FindNextControl(Sender as TWinControl, True, True, False).SetFocus; //next control
3204        Key := 0;
3205      end;
3206    end;
3207    if (key = VK_ESCAPE) then begin
3208      FindNextControl(Sender as TWinControl, False, True, False).SetFocus; //previous control
3209      key := 0;
3210    end;
3211  end;
3212  
3213  procedure TfrmDCSumm.sptHorzCanResize(Sender: TObject; var NewSize: Integer;
3214    var Accept: Boolean);
3215  begin
3216    inherited;
3217    if pnlWrite.Visible then
3218       if NewSize > frmDCSumm.ClientWidth - memNewSumm.Constraints.MinWidth - sptHorz.Width then
3219          NewSize := frmDCSumm.ClientWidth - memNewSumm.Constraints.MinWidth - sptHorz.Width;
3220  end;
3221  
3222  procedure TfrmDCSumm.popSummMemoPreviewClick(Sender: TObject);
3223  begin
3224    frmDrawers.mnuPreviewTemplateClick(Sender);
3225  end;
3226  
3227  procedure TfrmDCSumm.popSummMemoInsTemplateClick(Sender: TObject);
3228  begin
3229    frmDrawers.mnuInsertTemplateClick(Sender);
3230  end;
3231  
3232  
3233  {Returns True & Displays a Message if Currently No D/C Summary is Selected,
3234   Otherwise returns false and does not display a message.}
3235  function TfrmDCSumm.NoSummSelected: Boolean;
3236  begin
3237    if lstSumms.ItemIEN <= 0 then
3238    begin
3239      InfoBox(TX_NOSUMM,TX_NOSUMM_CAP,MB_OK or MB_ICONWARNING);
3240      Result := true;
3241    end
3242    else
3243      Result := false;
3244  end;
3245  
3246  procedure TfrmDCSumm.ViewInfo(Sender: TObject);
3247  begin
3248    inherited;
3249    frmFrame.ViewInfo(Sender);
3250  end;
3251  
3252  procedure TfrmDCSumm.mnuViewInformationClick(Sender: TObject);
3253  begin
3254    inherited;
3255    mnuViewDemo.Enabled := frmFrame.pnlPatient.Enabled;
3256    mnuViewVisits.Enabled := frmFrame.pnlVisit.Enabled;
3257    mnuViewPrimaryCare.Enabled := frmFrame.pnlPrimaryCare.Enabled;
3258    mnuViewMyHealtheVet.Enabled := not (Copy(frmFrame.laMHV.Hint, 1, 2) = 'No');
3259    mnuInsurance.Enabled := not (Copy(frmFrame.laVAA2.Hint, 1, 2) = 'No');
3260    mnuViewFlags.Enabled := frmFrame.lblFlag.Enabled;
3261    mnuViewRemoteData.Enabled := frmFrame.lblCirn.Enabled;
3262    mnuViewReminders.Enabled := frmFrame.pnlReminders.Enabled;
3263    mnuViewPostings.Enabled := frmFrame.pnlPostings.Enabled;
3264  end;
3265  
3266  initialization
3267    SpecifyFormIsNotADialog(TfrmDCSumm);
3268    uPCEEdit := TPCEData.Create;
3269    uPCEShow := TPCEData.Create;
3270  
3271  finalization
3272    uPCEEdit.Free;
3273    uPCEShow.Free;
3274  
3275  end.

Module Calls (2 levels)


fDCSumm
 ├fHSplit
 │ └fPage
 ├uConst
 ├uPCE
 │ ├uConst
 │ ├uCore
 │ ├rPCE
 │ ├rCore
 │ ├rTIU
 │ ├fEncounterFrame
 │ ├uVitals
 │ ├fFrame
 │ ├fPCEProvider
 │ └rVitals
 ├fDrawers
 │ ├uTemplates
 │ ├fBase508Form
 │ ├fTemplateView
 │ ├rTemplates
 │ ├fTemplateEditor
 │ ├dShared
 │ ├uReminders
 │ ├fReminderDialog
 │ ├fRptBox
 │ ├fTemplateDialog
 │ ├fIconLegend
 │ ├uVA508CPRSCompatibility
 │ └fFindingTemplates
 ├rDCSumm
 │ ├rCore...
 │ ├uCore...
 │ ├rTIU...
 │ ├uConst
 │ ├uTIU
 │ └uDCSumm
 ├uDocTree
 │ ├rCore...
 │ ├uCore...
 │ ├uConst
 │ ├uTIU
 │ ├rConsults
 │ ├uDCSumm
 │ └uConsults
 ├uDCSumm
 ├uTIU
 ├fPrintList
 │ ├fAutoSz
 │ ├uTIU
 │ ├uConst
 │ ├fNotes
 │ ├fConsults
 │ └fDCSumm...
 ├fFrame...
 ├fEncnt
 │ ├rOptions
 │ ├fBase508Form...
 │ ├fFrame...
 │ ├rCore...
 │ ├uCore...
 │ ├uConst
 │ ├fReview
 │ └rPCE...
 ├rCore...
 ├uCore...
 ├fNoteBA
 │ ├uTIU
 │ ├fBase508Form...
 │ ├rCore...
 │ └uCore...
 ├fNoteBD
 │ ├uTIU
 │ ├fBase508Form...
 │ └rCore...
 ├fSignItem
 │ ├rCore...
 │ └fBase508Form...
 ├fEncounterFrame...
 ├rPCE...
 ├fNotePrt
 │ ├fAutoSz...
 │ ├rCore...
 │ ├rTIU...
 │ ├rReports
 │ ├uCore...
 │ └uReports
 ├fAddlSigners
 │ ├fNoteProps
 │ ├fBase508Form...
 │ ├rCore...
 │ ├rTIU...
 │ ├uConst
 │ ├rPCE...
 │ └fDCSumm...
 ├fNoteDR
 │ ├fAutoSz...
 │ ├rTIU...
 │ └uConst
 ├uSpell
 │ ├rCore...
 │ ├fSpellNotify
 │ └uInit
 ├fTIUView
 │ ├uTIU
 │ ├fBase508Form...
 │ ├rCore...
 │ └uCore...
 ├fTemplateEditor...
 ├rTIU...
 ├fDCSummProps
 │ ├uConst
 │ ├rTIU...
 │ ├rDCSumm...
 │ ├uDCSumm
 │ ├uTIU
 │ ├fBase508Form...
 │ ├uCore...
 │ ├rCore...
 │ ├uPCE...
 │ ├rPCE...
 │ └rMisc
 ├fNotesBP
 │ ├fAutoSz...
 │ └fRptBox...
 ├fTemplateFieldEditor
 │ ├uTemplateFields
 │ ├fBase508Form...
 │ ├rTemplates...
 │ ├fTemplateDialog...
 │ ├uSpell...
 │ ├uConst
 │ └fTemplateFields
 ├uTemplates...
 ├fReminderDialog...
 ├dShared...
 ├rTemplates...
 ├fIconLegend...
 ├fNoteIDParents
 │ ├fAutoSz...
 │ ├uTIU
 │ ├rTIU...
 │ └uConst
 ├fTemplateDialog...
 └uVA508CPRSCompatibility...

Module Called-By (2 levels)


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