Context Navigation

fDCSumm.pas@ 1035

Last change on this file since 1035 was 460, checked in by Kevin Toppenberg, 16 years ago
Uploading from OR_30_258
File size: 119.7 KB

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

Note: See TracBrowser for help on using the repository browser.

Context Navigation

source: cprs/branches/foia-cprs/CPRS-Chart/fDCSumm.pas@ 1035

Download in other formats: