Context Navigation

source: cprs/trunk/CPRS-Chart/fDCSumm.pas@ 830

Last change on this file since 830 was 830, checked in by Kevin Toppenberg, 14 years ago
Upgrading to version 27
File size: 119.1 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	VA508AccessibilityManager, fBase508Form, VA508ImageListLabeler;
11
12	type
13	TfrmDCSumm = class(TfrmHSplit)
14	mnuSumms: TMainMenu;
15	mnuView: TMenuItem;
16	mnuViewChart: TMenuItem;
17	mnuChartReports: TMenuItem;
18	mnuChartLabs: TMenuItem;
19	mnuChartDCSumm: TMenuItem;
20	mnuChartCslts: TMenuItem;
21	mnuChartSumms: TMenuItem;
22	mnuChartOrders: TMenuItem;
23	mnuChartMeds: TMenuItem;
24	mnuChartProbs: TMenuItem;
25	mnuChartCover: TMenuItem;
26	Z1: TMenuItem;
27	mnuViewDetail: TMenuItem;
28	mnuAct: TMenuItem;
29	mnuActNew: TMenuItem;
30	Z2: TMenuItem;
31	mnuActSave: TMenuItem;
32	mnuActDelete: TMenuItem;
33	mnuActEdit: TMenuItem;
34	mnuActSign: TMenuItem;
35	mnuActAddend: TMenuItem;
36	lblSumms: TOROffsetLabel;
37	pnlRead: TPanel;
38	lblTitle: TOROffsetLabel;
39	memSumm: TRichEdit;
40	pnlWrite: TPanel;
41	memNewSumm: TRichEdit;
42	Z3: TMenuItem;
43	mnuViewAll: TMenuItem;
44	mnuViewByAuthor: TMenuItem;
45	mnuViewByDate: TMenuItem;
46	mnuViewUncosigned: TMenuItem;
47	mnuViewUnsigned: TMenuItem;
48	mnuActSignList: TMenuItem;
49	cmdNewSumm: TORAlignButton;
50	lblSpace1: TLabel;
51	cmdPCE: TORAlignButton;
52	popSummMemo: TPopupMenu;
53	popSummMemoCut: TMenuItem;
54	popSummMemoCopy: TMenuItem;
55	popSummMemoPaste: TMenuItem;
56	Z10: TMenuItem;
57	popSummMemoSignList: TMenuItem;
58	popSummMemoDelete: TMenuItem;
59	popSummMemoEdit: TMenuItem;
60	popSummMemoSave: TMenuItem;
61	popSummMemoSign: TMenuItem;
62	popSummList: TPopupMenu;
63	popSummListAll: TMenuItem;
64	popSummListByAuthor: TMenuItem;
65	popSummListByDate: TMenuItem;
66	popSummListUncosigned: TMenuItem;
67	popSummListUnsigned: TMenuItem;
68	pnlFields: TORAutoPanel;
69	sptVert: TSplitter;
70	memPCEShow: TRichEdit;
71	mnuActIdentifyAddlSigners: TMenuItem;
72	popSummMemoAddlSign: TMenuItem;
73	Z11: TMenuItem;
74	popSummMemoSpell: TMenuItem;
75	popSummMemoGrammar: TMenuItem;
76	mnuViewCustom: TMenuItem;
77	N1: TMenuItem;
78	mnuViewSaveAsDefault: TMenuItem;
79	mnuViewReturnToDefault: TMenuItem;
80	pnlDrawers: TPanel;
81	lstSumms: TORListBox;
82	N2: TMenuItem;
83	popSummMemoTemplate: TMenuItem;
84	mnuOptions: TMenuItem;
85	mnuEditTemplates: TMenuItem;
86	mnuNewTemplate: TMenuItem;
87	splDrawers: TSplitter;
88	N3: TMenuItem;
89	mnuEditSharedTemplates: TMenuItem;
90	mnuNewSharedTemplate: TMenuItem;
91	timAutoSave: TTimer;
92	cmdChange: TButton;
93	lblNewTitle: TStaticText;
94	lblVisit: TStaticText;
95	lblRefDate: TStaticText;
96	lblCosigner: TStaticText;
97	lblDictator: TStaticText;
98	lblDischarge: TStaticText;
99	popSummMemoPaste2: TMenuItem;
100	popSummMemoReformat: TMenuItem;
101	Z4: TMenuItem;
102	mnuActChange: TMenuItem;
103	mnuActLoadBoiler: TMenuItem;
104	bvlNewTitle: TBevel;
105	popSummMemoSaveContinue: TMenuItem;
106	N4: TMenuItem;
107	mnuEditDialgFields: TMenuItem;
108	lvSumms: TCaptionListView;
109	sptList: TSplitter;
110	N5: TMenuItem;
111	popSummListExpandSelected: TMenuItem;
112	popSummListExpandAll: TMenuItem;
113	popSummListCollapseSelected: TMenuItem;
114	popSummListCollapseAll: TMenuItem;
115	tvSumms: TORTreeView;
116	popSummListCustom: TMenuItem;
117	N6: TMenuItem;
118	popSummListDetachFromIDParent: TMenuItem;
119	mnuActDetachFromIDParent: TMenuItem;
120	popSummListAddIDEntry: TMenuItem;
121	mnuActAddIDEntry: TMenuItem;
122	N7: TMenuItem;
123	mnuIconLegend: TMenuItem;
124	dlgFindText: TFindDialog;
125	popSummMemoFind: TMenuItem;
126	dlgReplaceText: TReplaceDialog;
127	N8: TMenuItem;
128	popSummMemoReplace: TMenuItem;
129	mnuChartSurgery: TMenuItem;
130	mnuActAttachtoIDParent: TMenuItem;
131	popSummListAttachtoIDParent: TMenuItem;
132	popSummMemoAddend: TMenuItem;
133	N9: TMenuItem;
134	popSummMemoPreview: TMenuItem;
135	popSummMemoInsTemplate: TMenuItem;
136	popSummMemoEncounter: TMenuItem;
137	mnuViewInformation: TMenuItem;
138	mnuViewDemo: TMenuItem;
139	mnuViewVisits: TMenuItem;
140	mnuViewPrimaryCare: TMenuItem;
141	mnuViewMyHealtheVet: TMenuItem;
142	mnuInsurance: TMenuItem;
143	mnuViewFlags: TMenuItem;
144	mnuViewReminders: TMenuItem;
145	mnuViewRemoteData: TMenuItem;
146	mnuViewPostings: TMenuItem;
147	imgLblNotes: TVA508ImageListLabeler;
148	imgLblImages: TVA508ImageListLabeler;
149	procedure mnuChartTabClick(Sender: TObject);
150	procedure lstSummsClick(Sender: TObject);
151	procedure pnlRightResize(Sender: TObject);
152	procedure cmdNewSummClick(Sender: TObject);
153	procedure memNewSummChange(Sender: TObject);
154	procedure mnuActNewClick(Sender: TObject);
155	procedure mnuActAddIDEntryClick(Sender: TObject);
156	procedure mnuActSaveClick(Sender: TObject);
157	procedure mnuViewClick(Sender: TObject);
158	procedure mnuActAddendClick(Sender: TObject);
159	procedure mnuActDetachFromIDParentClick(Sender: TObject);
160	procedure mnuActSignListClick(Sender: TObject);
161	procedure mnuActDeleteClick(Sender: TObject);
162	procedure mnuActEditClick(Sender: TObject);
163	procedure mnuActSignClick(Sender: TObject);
164	procedure cmdOrdersClick(Sender: TObject);
165	procedure cmdPCEClick(Sender: TObject);
166	procedure popSummMemoCutClick(Sender: TObject);
167	procedure popSummMemoCopyClick(Sender: TObject);
168	procedure popSummMemoPasteClick(Sender: TObject);
169	procedure popSummMemoPopup(Sender: TObject);
170	procedure pnlWriteResize(Sender: TObject);
171	procedure FormCreate(Sender: TObject);
172	procedure mnuViewDetailClick(Sender: TObject);
173	procedure FormClose(Sender: TObject; var Action: TCloseAction);
174	procedure mnuActIdentifyAddlSignersClick(Sender: TObject);
175	procedure popSummMemoAddlSignClick(Sender: TObject);
176	procedure popSummMemoSpellClick(Sender: TObject);
177	procedure popSummMemoGrammarClick(Sender: TObject);
178	procedure mnuViewSaveAsDefaultClick(Sender: TObject);
179	procedure mnuViewReturntoDefaultClick(Sender: TObject);
180	procedure popSummMemoTemplateClick(Sender: TObject);
181	procedure mnuNewTemplateClick(Sender: TObject);
182	procedure mnuEditTemplatesClick(Sender: TObject);
183	procedure mnuOptionsClick(Sender: TObject);
184	procedure mnuEditSharedTemplatesClick(Sender: TObject);
185	procedure mnuNewSharedTemplateClick(Sender: TObject);
186	procedure FormDestroy(Sender: TObject);
187	procedure timAutoSaveTimer(Sender: TObject);
188	procedure cmdChangeClick(Sender: TObject);
189	procedure popSummMemoReformatClick(Sender: TObject);
190	procedure mnuActChangeClick(Sender: TObject);
191	procedure mnuActLoadBoilerClick(Sender: TObject);
192	procedure popSummMemoSaveContinueClick(Sender: TObject);
193	procedure mnuEditDialgFieldsClick(Sender: TObject);
194	procedure tvSummsChange(Sender: TObject; Node: TTreeNode);
195	procedure tvSummsClick(Sender: TObject);
196	procedure tvSummsCollapsed(Sender: TObject; Node: TTreeNode);
197	procedure tvSummsExpanded(Sender: TObject; Node: TTreeNode);
198	procedure tvSummsStartDrag(Sender: TObject;
199	var DragObject: TDragObject);
200	procedure tvSummsDragDrop(Sender, Source: TObject; X, Y: Integer);
201	procedure tvSummsDragOver(Sender, Source: TObject; X, Y: Integer;
202	State: TDragState; var Accept: Boolean);
203	procedure lvSummsColumnClick(Sender: TObject; Column: TListColumn);
204	procedure lvSummsCompare(Sender: TObject; Item1, Item2: TListItem; Data: Integer; var Compare: Integer);
205	procedure lvSummsSelectItem(Sender: TObject; Item: TListItem; Selected: Boolean);
206	procedure popSummListExpandAllClick(Sender: TObject);
207	procedure popSummListCollapseAllClick(Sender: TObject);
208	procedure popSummListExpandSelectedClick(Sender: TObject);
209	procedure popSummListCollapseSelectedClick(Sender: TObject);
210	procedure popSummListPopup(Sender: TObject);
211	procedure lvSummsResize(Sender: TObject);
212	procedure mnuIconLegendClick(Sender: TObject);
213	procedure popSummMemoFindClick(Sender: TObject);
214	procedure dlgFindTextFind(Sender: TObject);
215	procedure dlgReplaceTextReplace(Sender: TObject);
216	procedure dlgReplaceTextFind(Sender: TObject);
217	procedure popSummMemoReplaceClick(Sender: TObject);
218	procedure mnuActAttachtoIDParentClick(Sender: TObject);
219	procedure memNewSummKeyUp(Sender: TObject; var Key: Word;
220	Shift: TShiftState);
221	procedure sptHorzCanResize(Sender: TObject; var NewSize: Integer; var Accept: Boolean);
222	procedure popSummMemoPreviewClick(Sender: TObject);
223	procedure popSummMemoInsTemplateClick(Sender: TObject);
224	procedure ViewInfo(Sender: TObject);
225	procedure mnuViewInformationClick(Sender: TObject);
226	private
227	FEditingIndex: Integer; // index of Summary being currently edited
228	FChanged: Boolean; // true if any text has changed in the Summary
229	FEditCtrl: TCustomEdit;
230	FDischargeDate: TFMDateTime;
231	FSilent: Boolean;
232	FCurrentContext: TTIUContext;
233	FDefaultContext: TTIUContext;
234	FImageFlag: TBitmap;
235	FEditDCSumm: TEditDCSummRec;
236	FShowAdmissions: Boolean;
237	FVerifySummTitle: Integer;
238	FDocList: TStringList;
239	FConfirmed: boolean;
240	FDeleted: boolean;
241	FLastSummID: string;
242	function NoSummSelected : Boolean;
243	procedure ClearEditControls;
244	function StartNewEdit(NewNoteType: integer): Boolean;
245	procedure DoAutoSave(Suppress: integer = 1);
246	function LacksRequiredForCreate: Boolean;
247	function GetTitleText(AnIndex: Integer): string;
248	//function MakeTitleText(IsAddendum: Boolean = False): string;
249	procedure SetEditingIndex(const Value: Integer);
250	procedure DisplayPCE;
251	function LockSumm(AnIEN: Int64): Boolean;
252	procedure InsertAddendum;
253	procedure InsertNewSumm(IsIDChild: boolean; AnIDParent: integer);
254	procedure LoadForEdit(PreserveValues: Boolean);
255	procedure RemovePCEFromChanges(IEN: Int64; AVisitStr: string = '');
256	procedure SaveEditedSumm(var Saved: Boolean);
257	procedure SaveCurrentSumm(var Saved: Boolean);
258	procedure ShowPCEControls(ShouldShow: Boolean);
259	function TitleText(AnIndex: Integer): string;
260	procedure ProcessNotifications;
261	procedure SetViewContext(AContext: TTIUContext);
262	function GetDrawers: TFrmDrawers;
263	property EditingIndex: Integer read FEditingIndex write SetEditingIndex;
264	function VerifySummTitle: Boolean;
265	// added for treeview - see also uDocTree.pas
266	procedure LoadSumms;
267	procedure UpdateTreeView(DocList: TStringList; Tree: TORTreeView);
268	procedure EnableDisableIDNotes;
269	procedure DoAttachIDChild(AChild, AParent: TORTreeNode);
270	function SetSummTreeLabel(AContext: TTIUContext): string;
271	public
272	function AllowContextChange(var WhyNot: string): Boolean; override;
273	procedure ClearPtData; override;
274	procedure DisplayPage; override;
275	procedure RequestPrint; override;
276	procedure RequestMultiplePrint(AForm: TfrmPrintList);
277	procedure SetFontSize(NewFontSize: Integer); override;
278	procedure SaveSignItem(const ItemID, ESCode: string);
279	procedure LstSummsToPrint;
280	published
281	property Drawers: TFrmDrawers read GetDrawers; // Keep Drawers published
282	end;
283
284	var
285	frmDCSumm: TfrmDCSumm;
286
287	implementation
288
289	{$R *.DFM}
290
291	uses fFrame, fVisit, fEncnt, rCore, uCore, fNoteBA, fNoteBD, fSignItem, fEncounterFrame,
292	rPCE, Clipbrd, fNotePrt, fAddlSigners, fNoteDR, uSpell, rVitals, fTIUView,
293	fTemplateEditor, rTIU, fDCSummProps, fNotesBP, fTemplateFieldEditor, uTemplates,
294	fReminderDialog, dShared, rTemplates, fIconLegend, fNoteIDParents,
295	fTemplateDialog, uVA508CPRSCompatibility, VA508AccessibilityRouter;
296
297	const
298	NA_CREATE = 0; // New Summ action - create new Summ
299	NA_SHOW = 1; // New Summ action - show current
300	NA_SAVECREATE = 2; // New Summ action - save current then create
301
302	TYP_DC_SUMM = 244;
303	DC_NEW_SUMM = -50; // Holder IEN for a new Summary
304	DC_ADDENDUM = -60; // Holder IEN for a new addendum
305
306	DC_ACT_NEW_SUMM = 2;
307	DC_ACT_ADDENDUM = 3;
308	DC_ACT_EDIT_SUMM = 4;
309	DC_ACT_ID_ENTRY = 5;
310
311	TX_NEED_VISIT = 'A visit is required before creating a new Discharge Summary.';
312	TX_NO_VISIT = 'Insufficient Visit Information';
313	TX_BOILERPLT = 'You have modified the text of this Discharge Summary. Changing the title will' +
314	' discard the Discharge Summary text.' + CRLF + 'Do you wish to continue?';
315	TX_NEWTITLE = 'Change Discharge Summary Title';
316	TX_REQD_SUMM = 'The following information is required to save a Discharge Summary - ' + CRLF;
317	TX_REQD_ADDM = 'The following information is required to save an addendum - ' + CRLF;
318	TX_REQD_COSIG = CRLF + 'Attending Physician';
319	TX_REQ2 = CRLF + CRLF +
320	'It is recommended that these fields be entered before continuing' + CRLF +
321	'to prevent losing the summary should the application time out.';
322	TX_CREATE_ERR = 'Error Creating Summary';
323	TX_UPDATE_ERR = 'Error Updating Summary';
324	TX_NO_NOTE = 'No Discharge Summary is currently being edited';
325	TX_SAVE_NOTE = 'Save Discharge Summary';
326	TX_ADDEND_NO = 'Cannot make an addendum to a Summary that is being edited';
327	TX_DEL_OK = CRLF + CRLF + 'Delete this Discharge Summary?';
328	TX_DEL_ERR = 'Unable to Delete Summary';
329	TX_SIGN = 'Sign Summary';
330	TX_COSIGN = 'Cosign Summary';
331	TX_SIGN_ERR = 'Unable to Sign Summary';
332
333	TX_NOSUMM = 'No Discharge Summary is currently selected.';
334	TX_NOSUMM_CAP = 'No Summary Selected';
335	TX_NOPRT_NEW = 'This Discharge Summary may not be printed until it is saved';
336	TX_NOPRT_NEW_CAP = 'Save Discharge Summary';
337	TX_NOT_INPATIENT = 'Discharge Summaries are only applicable to hospital admissions.';
338	TX_NO_ADMISSION_CAP = 'No hospital admission was selected';
339	TX_NO_ALERT = 'There is insufficient information to process this alert.' + CRLF +
340	'Either the alert has already been deleted, or it contained invalid data.' + CRLF + CRLF +
341	'Click the NEXT button if you wish to continue processing more alerts.';
342	TX_CAP_NO_ALERT = 'Unable to Process Alert';
343	TX_NO_FUTURE_DT = 'A Reference Date/Time in the future is not allowed.';
344	TX_RELEASE = 'Do you want to release this summary from DRAFT mode to UNSIGNED' + CRLF +
345	'status? This does not release the summary as the official,' + CRLF +
346	'completed Discharge Summary until it is COSIGNED.';
347	//'Do you want to release this discharge summary?';
348	TC_RELEASE = 'Release Document';
349	TX_NEW_SAVE1 = 'You are currently editing:' + CRLF + CRLF;
350	TX_NEW_SAVE2 = CRLF + CRLF + 'Do you wish to save this summary and begin a new one?';
351	TX_NEW_SAVE3 = CRLF + CRLF + 'Do you wish to save this summary and begin a new addendum?';
352	TX_NEW_SAVE4 = CRLF + CRLF + 'Do you wish to save this summary and edit the one selected?';
353	TX_NEW_SAVE5 = CRLF + CRLF + 'Do you wish to save this summary and begin a new Interdisciplinary entry?';
354	TC_NEW_SAVE2 = 'Create New Summary';
355	TC_NEW_SAVE3 = 'Create New Addendum';
356	TC_NEW_SAVE4 = 'Edit Different Summary';
357	TC_NEW_SAVE5 = 'Create New Interdisciplinary Entry';
358	TC_NO_LOCK = 'Unable to Lock Summary';
359	TX_EMPTY_SUMM = CRLF + CRLF + 'This discharge summary contains no text and will not be saved.' + CRLF +
360	'Do you wish to delete this discharge summary?';
361	TC_EMPTY_SUMM = 'Empty Note';
362	TX_EMPTY_SUMM1 = 'This document contains no text and can not be signed.';
363	TX_ABSAVE = 'It appears the session terminated abnormally when this' + CRLF +
364	'note was last edited. Some text may not have been saved.' + CRLF + CRLF +
365	'Do you wish to continue and sign the note?';
366	TC_ABSAVE = 'Possible Missing Text';
367	TX_NO_BOIL = 'There is no boilerplate text associated with this title.';
368	TC_NO_BOIL = 'Load Boilerplate Text';
369	TX_BLR_CLEAR = 'Do you want to clear the previously loaded boilerplate text?';
370	TC_BLR_CLEAR = 'Clear Previous Boilerplate Text';
371	TX_MISSING_FIELDS = 'This document can not be saved. An ATTENDING must first be entered.';
372	TC_MISSING_FIELDS = 'Unable to save';
373	TX_DETACH_CNF = 'Confirm Detachment';
374	TX_DETACH_FAILURE = 'Detach failed';
375	TX_RETRACT_CAP = 'Retraction Notice';
376	TX_RETRACT = 'This document will now be RETRACTED. As Such, it has been removed' +CRLF +
377	' from public view, and from typical Releases of Information,' +CRLF +
378	' but will remain indefinitely discoverable to HIMS.' +CRLF +CRLF;
379	TX_AUTH_SIGNED = 'Author has not signed, are you SURE you want to sign.' +CRLF;
380
381	var
382	uPCEShow, uPCEEdit: TPCEData;
383	ViewContext: Integer;
384	frmDrawers: TfrmDrawers;
385	uDCSummContext: TTIUContext;
386	ColumnToSort: Integer;
387	ColumnSortForward: Boolean;
388	uChanging: Boolean;
389	uIDNotesActive: Boolean;
390
391	{ TPage common methods --------------------------------------------------------------------- }
392
393	function TfrmDCSumm.AllowContextChange(var WhyNot: string): Boolean;
394	begin
395	dlgFindText.CloseDialog;
396	Result := inherited AllowContextChange(WhyNot); // sets result = true
397	if Assigned(frmTemplateDialog) then
398	if Screen.ActiveForm = frmTemplateDialog then
399	//if (fsModal in frmTemplateDialog.FormState) then
400	case BOOLCHAR[frmFrame.CCOWContextChanging] of
401	'1': begin
402	WhyNot := 'A template in progress will be aborted. ';
403	Result := False;
404	end;
405	'0': begin
406	if WhyNot = 'COMMIT' then
407	begin
408	FSilent := True;
409	frmTemplateDialog.Silent := True;
410	frmTemplateDialog.ModalResult := mrCancel;
411	end;
412	end;
413	end;
414	if EditingIndex <> -1 then
415	case BOOLCHAR[frmFrame.CCOWContextChanging] of
416	'1': begin
417	if memNewSumm.GetTextLen > 0 then
418	WhyNot := WhyNot + 'A discharge summary in progress will be saved as unsigned. '
419	else
420	WhyNot := WhyNot + 'An empty discharge summary in progress will be deleted. ';
421	Result := False;
422	end;
423	'0': begin
424	if WhyNot = 'COMMIT' then FSilent := True;
425	SaveCurrentSumm(Result);
426	end;
427	end;
428	if Assigned(frmEncounterFrame) then
429	if Screen.ActiveForm = frmEncounterFrame then
430	//if (fsModal in frmEncounterFrame.FormState) then
431	case BOOLCHAR[frmFrame.CCOWContextChanging] of
432	'1': begin
433	WhyNot := WhyNot + 'Encounter information being edited will not be saved';
434	Result := False;
435	end;
436	'0': begin
437	if WhyNot = 'COMMIT' then
438	begin
439	FSilent := True;
440	frmEncounterFrame.Abort := False;
441	frmEncounterFrame.Cancel := True;
442	end;
443	end;
444	end;
445	end;
446
447	procedure TfrmDCSumm.LstSummsToPrint;
448	var
449	AParentID: string;
450	SavedDocID: string;
451	Saved: boolean;
452	begin
453	inherited;
454	if lstSumms.ItemIEN = 0 then exit;
455	SavedDocID := lstSumms.ItemID;
456	if EditingIndex <> -1 then
457	begin
458	SaveCurrentSumm(Saved);
459	if not Saved then Exit;
460	LoadSumms;
461	with tvSumms do Selected := FindPieceNode(SavedDocID, U, Items.GetFirstNode);
462	end;
463	if tvSumms.Selected = nil then exit;
464	AParentID := frmPrintList.SelectParentFromList(tvSumms,CT_DCSUMM);
465	if AParentID = '' then exit;
466	with tvSumms do Selected := FindPieceNode(AParentID, 1, U, Items.GetFirstNode);
467	end;
468
469	procedure TfrmDCSumm.ClearPtData;
470	{ clear all controls that contain patient specific information }
471	begin
472	inherited ClearPtData;
473	ClearEditControls;
474	uChanging := True;
475	tvSumms.Items.BeginUpdate;
476	KillDocTreeObjects(tvSumms);
477	tvSumms.Items.Clear;
478	tvSumms.Items.EndUpdate;
479	uChanging := False;
480	lstSumms.Clear;
481	memSumm.Clear;
482	memPCEShow.Clear;
483	uPCEShow.Clear;
484	uPCEEdit.Clear;
485	frmDrawers.ResetTemplates;
486	end;
487
488	procedure TfrmDCSumm.DisplayPage;
489	{ causes page to be visible and conditionally executes initialization code }
490	begin
491	inherited DisplayPage;
492	frmFrame.ShowHideChartTabMenus(mnuViewChart);
493	frmFrame.mnuFilePrint.Tag := CT_DCSUMM;
494	frmFrame.mnuFilePrint.Enabled := True;
495	frmFrame.mnuFilePrintSetup.Enabled := True;
496	frmFrame.mnuFilePrintSelectedItems.Enabled := True;
497	if InitPage then
498	begin
499	EnableDisableIDNotes;
500	FDefaultContext := GetCurrentDCSummContext;
501	FCurrentContext := FDefaultContext;
502	popSummMemoSpell.Visible := SpellCheckAvailable;
503	popSummMemoGrammar.Visible := popSummMemoSpell.Visible;
504	Z11.Visible := popSummMemoSpell.Visible;
505	timAutoSave.Interval := User.AutoSave * 1000; // convert seconds to milliseconds
506	SetEqualTabStops(memNewSumm);
507	end;
508	// to indent the right margin need to set Paragraph.RightIndent for each paragraph?
509	if InitPatient and not (CallingContext = CC_NOTIFICATION) then
510	begin
511	SetViewContext(FDefaultContext);
512	end;
513	case CallingContext of
514	CC_INIT_PATIENT: if not InitPatient then
515	begin
516	SetViewContext(FDefaultContext);
517	end;
518	CC_NOTIFICATION: ProcessNotifications;
519	end;
520	end;
521
522	procedure TfrmDCSumm.RequestPrint;
523	var
524	Saved: Boolean;
525	begin
526	with lstSumms do
527	begin
528	if ItemIndex = EditingIndex then
529	//if ItemIEN < 0 then
530	begin
531	SaveCurrentSumm(Saved);
532	if not Saved then Exit;
533	end;
534	if ItemIEN > 0 then PrintNote(ItemIEN, MakeDCSummDisplayText(Items[ItemIndex])) else
535	begin
536	if ItemIEN = 0 then InfoBox(TX_NO_NOTE, TX_NOSUMM_CAP, MB_OK);
537	if ItemIEN < 0 then InfoBox(TX_NOPRT_NEW, TX_NOPRT_NEW_CAP, MB_OK);
538	end;
539	end;
540	end;
541
542	{for printing multiple notes}
543	procedure TfrmDCSumm.RequestMultiplePrint(AForm: TfrmPrintList);
544	var
545	NoteIEN: int64;
546	i: integer;
547	begin
548	with AForm.lbIDParents do
549	for i := 0 to Items.Count - 1 do
550	if Selected[i] then
551	begin
552	NoteIEN := StrToInt64def(Piece(Items[i], U, 1), 0);
553	if NoteIEN > 0 then PrintNote(NoteIEN, DisplayText[i], TRUE)
554	else if NoteIEN = 0 then InfoBox(TX_NO_NOTE, TX_NOSUMM_CAP, MB_OK)
555	else InfoBox(TX_NOPRT_NEW, TX_NOPRT_NEW_CAP, MB_OK);
556	end;
557	end;
558
559	procedure TfrmDCSumm.SetFontSize(NewFontSize: Integer);
560	{ adjusts the font size of any controls that don't have ParentFont = True }
561	begin
562	inherited SetFontSize(NewFontSize);
563	memSumm.Font.Size := NewFontSize;
564	memNewSumm.Font.Size := NewFontSize;
565	lblTitle.Font.Size := NewFontSize;
566	frmDrawers.Font.Size := NewFontSize;
567	SetEqualTabStops(memNewSumm);
568	// adjust heights of pnlAction, pnlFields, and lstEncntShow
569	end;
570
571	procedure TfrmDCSumm.mnuChartTabClick(Sender: TObject);
572	{ reroute to Chart Tab menu of the parent form: frmFrame }
573	begin
574	inherited;
575	frmFrame.mnuChartTabClick(Sender);
576	end;
577
578	{ General procedures ----------------------------------------------------------------------- }
579
580	procedure TfrmDCSumm.ClearEditControls;
581	{ resets controls used for entering a new Discharge Summary }
582	begin
583	// clear FEditDCSumm (should FEditDCSumm be an object with a clear method?)
584	with FEditDCSumm do
585	begin
586	DocType := 0;
587	EditIEN := 0;
588	Title := 0;
589	TitleName := '';
590	AdmitDateTime := 0;
591	DischargeDateTime := 0;
592	DictDateTime := 0;
593	Dictator := 0;
594	DictatorName := '';
595	Cosigner := 0;
596	CosignerName := '';
597	Transcriptionist := 0;
598	TranscriptionistName := '';
599	Attending := 0;
600	AttendingName := '';
601	Urgency := '';
602	UrgencyName := '';
603	Location := 0;
604	LocationName := '';
605	Addend := 0;
606	VisitStr := '';
607	{LastCosigner & LastCosignerName aren't cleared because they're used as default for next note.}
608	Lines := nil;
609	end;
610	// clear the editing controls (also clear the new labels?)
611	memNewSumm.Clear;
612	timAutoSave.Enabled := False;
613	// clear the PCE object for editing
614	uPCEEdit.Clear;
615	// set the tracking variables to initial state
616	EditingIndex := -1;
617	FChanged := False;
618	end;
619
620	procedure TfrmDCSumm.ShowPCEControls(ShouldShow: Boolean);
621	begin
622	sptVert.Visible := ShouldShow;
623	memPCEShow.Visible := ShouldShow;
624	if(ShouldShow) then
625	sptVert.Top := memPCEShow.Top - sptVert.Height;
626	memSumm.Invalidate;
627	end;
628
629	procedure TfrmDCSumm.DisplayPCE;
630	{ displays PCE information if appropriate & enables/disabled editing of PCE data }
631	var
632	VitalStr: TStringlist;
633	NoPCE: boolean;
634	ActionSts: TActionRec;
635
636	begin
637	memPCEShow.Clear;
638	with lstSumms do if ItemIndex = EditingIndex then
639	begin
640	with uPCEEdit do
641	begin
642	AddStrData(memPCEShow.Lines);
643	NoPCE := (memPCEShow.Lines.Count = 0);
644	VitalStr := TStringList.create;
645	try
646	GetVitalsFromDate(VitalStr, uPCEEdit);
647	AddVitalData(VitalStr, memPCEShow.Lines);
648	finally
649	VitalStr.free;
650	end;
651	cmdPCE.Enabled := CanEditPCE(uPCEEdit);
652	ShowPCEControls(cmdPCE.Enabled or (memPCEShow.Lines.Count > 0));
653	if(NoPCE and memPCEShow.Visible) then
654	memPCEShow.Lines.Insert(0, TX_NOPCE);
655
656	frmDrawers.DisplayDrawers(TRUE, [odTemplates],[odTemplates]);
657	cmdNewSumm.Visible := FALSE;
658	lblSpace1.Top := cmdPCE.Top - lblSpace1.Height;
659	end;
660	end else
661	begin
662	cmdPCE.Enabled := False;
663
664	frmDrawers.DisplayDrawers(FALSE);
665	cmdNewSumm.Visible := TRUE;
666	lblSpace1.Top := cmdNewSumm.Top - lblSpace1.Height;
667
668	ActOnDocument(ActionSts, lstSumms.ItemIEN, 'VIEW');
669	if ActionSts.Success then
670	begin
671	StatusText('Retrieving encounter information...');
672	with uPCEShow do
673	begin
674	NoteDateTime := MakeFMDateTime(Piece(lstSumms.Items[lstSumms.ItemIndex], U, 3));
675	PCEForNote(lstSumms.ItemIEN, uPCEEdit);
676	AddStrData(memPCEShow.Lines);
677	NoPCE := (memPCEShow.Lines.Count = 0);
678	VitalStr := TStringList.create;
679	try
680	GetVitalsFromNote(VitalStr, uPCEShow, lstSumms.ItemIEN);
681	AddVitalData(VitalStr, memPCEShow.Lines);
682	finally
683	VitalStr.free;
684	end;
685	ShowPCEControls(memPCEShow.Lines.Count > 0);
686	if(NoPCE and memPCEShow.Visible) then
687	memPCEShow.Lines.Insert(0, TX_NOPCE);
688	end;
689	StatusText('');
690	end
691	else
692	ShowPCEControls(FALSE);
693	end; {if ItemIndex}
694	memPCEShow.SelStart := 0;
695	popSummMemoEncounter.Enabled := cmdPCE.Enabled;
696	end;
697
698	procedure TfrmDCSumm.InsertNewSumm(IsIDChild: boolean; AnIDParent: integer);
699	{ creates the editing context for a new Discharge Summary & inserts stub into top of view list}
700	const
701	USE_CURRENT_VISITSTR = -2;
702	var
703	EnableAutosave, HaveRequired, Saved: Boolean;
704	CreatedSumm: TCreatedDoc;
705	ListItemForEdit: string;
706	TmpBoilerPlate: TStringList;
707	tmpNode: TTreeNode;
708	x, WhyNot: string;
709	DocInfo: string;
710	begin
711	EnableAutosave := FALSE;
712	TmpBoilerPlate := nil;
713	try
714	ClearEditControls;
715	FShowAdmissions := True;
716	FillChar(FEditDCSumm, SizeOf(FEditDCSumm), 0); //v15.7
717	with FEditDCSumm do
718	begin
719	EditIEN := 0;
720	DocType := TYP_DC_SUMM;
721	Title := DfltDCSummTitle;
722	TitleName := DfltDCSummTitleName;
723	if IsIDChild and (not CanTitleBeIDChild(Title, WhyNot)) then
724	begin
725	Title := 0;
726	TitleName := '';
727	end;
728	DictDateTime := FMNow;
729	Dictator := User.DUZ;
730	DictatorName := User.Name;
731	if IsIDChild then
732	IDParent := AnIDParent
733	else
734	IDParent := 0;
735	end;
736	// check to see if interaction necessary to get required fields
737	if LacksRequiredForCreate or VerifySummTitle
738	then HaveRequired := ExecuteDCSummProperties(FEditDCSumm, ListItemForEdit, FShowAdmissions, IsIDChild)
739	else HaveRequired := True;
740	if HaveRequired then
741	begin
742	if ListItemForEdit <> '' then
743	begin
744	lstSumms.ItemIndex := -1;
745	lstSumms.SelectByID(Piece(ListItemForEdit, U, 1));
746	if lstSumms.ItemIndex < 0 then
747	begin
748	lstSumms.Items.Insert(0, ListItemForEdit);
749	lstSumms.ItemIndex := 0;
750	end;
751	if lstSumms.ItemIndex = EditingIndex then Exit;
752	if EditingIndex > -1 then
753	begin
754	if InfoBox(TX_NEW_SAVE1 + MakeDCSummDisplayText(lstSumms.Items[EditingIndex]) + TX_NEW_SAVE2,
755	TC_NEW_SAVE2, MB_YESNO) = IDNO then exit
756	else
757	begin
758	SaveCurrentSumm(Saved);
759	if not Saved then exit;
760	end;
761	end;
762	//if not StartNewEdit then Exit;
763	lstSummsClick(Self);
764	LoadForEdit(True);
765	Exit;
766	end
767	else
768	begin
769	// set up uPCEEdit for entry of new note
770	uPCEEdit.UseEncounter := True;
771	uPCEEdit.NoteDateTime := FEditDCSumm.DischargeDateTime;
772	uPCEEdit.PCEForNote(USE_CURRENT_VISITSTR, uPCEShow);
773	FEditDCSumm.NeedCPT := uPCEEdit.CPTRequired;
774	// create the note
775	PutNewDCSumm(CreatedSumm, FEditDCSumm);
776	uPCEEdit.NoteIEN := CreatedSumm.IEN;
777	if CreatedSumm.IEN > 0 then LockDocument(CreatedSumm.IEN, CreatedSumm.ErrorText);
778	if CreatedSumm.ErrorText = '' then
779	begin
780	//x := $$RESOLVE^TIUSRVLO formatted string
781	//7348^Discharge Summary^3000913^NERD, YOURA (N0165)^1329;Rich Vertigan;VERTIGAN,RICH^8E REHAB MED^unverified^Adm: 11/05/98;2981105.095547^ ;^^0^^^2
782	with FEditDCSumm do
783	begin
784	x := IntToStr(CreatedSumm.IEN) + U + TitleName + U + FloatToStr(DischargeDateTime) + U +
785	Patient.Name + U + IntToStr(Dictator) + ';' + DictatorName + U + LocationName + U + 'new' + U +
786	'Adm: ' + FormatFMDateTime('mmm dd,yyyy', AdmitDateTime) + ';' + FloatToStr(AdmitDateTime) + U +
787	'Dis: ' + FormatFMDateTime('mmm dd,yyyy', DischargeDateTime) + ';' + FloatToStr(DischargeDateTime) +
788	U + U + U + U + U + U;
789	end;
790	lstSumms.Items.Insert(0, x);
791	uChanging := True;
792	tvSumms.Items.BeginUpdate;
793	if IsIDChild then
794	begin
795	tmpNode := tvSumms.FindPieceNode(IntToStr(AnIDParent), 1, U, tvSumms.Items.GetFirstNode);
796	tmpNode.ImageIndex := IMG_IDNOTE_OPEN;
797	tmpNode.SelectedIndex := IMG_IDNOTE_OPEN;
798	tmpNode := tvSumms.Items.AddChildObjectFirst(tmpNode, MakeDCSummDisplayText(x), MakeDCSummTreeObject(x));
799	tmpNode.ImageIndex := IMG_ID_CHILD;
800	tmpNode.SelectedIndex := IMG_ID_CHILD;
801	end
802	else
803	begin
804	tmpNode := tvSumms.Items.AddObjectFirst(tvSumms.Items.GetFirstNode, 'New Summary in Progress',
805	MakeDCSummTreeObject('NEW^New Summary in Progress^^^^^^^^^^^%^0'));
806	TORTreeNode(tmpNode).StringData := 'NEW^New Summary in Progress^^^^^^^^^^^%^0';
807	tmpNode.ImageIndex := IMG_TOP_LEVEL;
808	tmpNode := tvSumms.Items.AddChildObjectFirst(tmpNode, MakeDCSummDisplayText(x), MakeDCSummTreeObject(x));
809	tmpNode.ImageIndex := IMG_SINGLE;
810	tmpNode.SelectedIndex := IMG_SINGLE;
811	end;
812	TORTreeNode(tmpNode).StringData := x;
813	tvSumms.Selected := tmpNode;
814	tvSumms.Items.EndUpdate;
815	uChanging := False;
816	Changes.Add(CH_SUM, IntToStr(CreatedSumm.IEN), GetTitleText(0), '', CH_SIGN_YES);
817	lstSumms.ItemIndex := 0;
818	EditingIndex := 0;
819	if not assigned(TmpBoilerPlate) then
820	TmpBoilerPlate := TStringList.Create;
821	LoadBoilerPlate(TmpBoilerPlate, FEditDCSumm.Title);
822	FChanged := False;
823	cmdChangeClick(Self); // will set captions, sign state for Changes
824	lstSummsClick(Self); // will make pnlWrite visible
825	if timAutoSave.Interval <> 0 then EnableAutosave := TRUE;
826	memNewSumm.SetFocus;
827	end else
828	begin
829	InfoBox(CreatedSumm.ErrorText, TX_CREATE_ERR, MB_OK);
830	HaveRequired := False;
831	end; {if CreatedSumm.IEN}
832	end; {loaded for edit}
833	end; {if HaveRequired}
834	if not HaveRequired then ClearEditControls;
835	finally
836	if assigned(TmpBoilerPlate) then
837	begin
838	DocInfo := MakeXMLParamTIU(IntToStr(CreatedSumm.IEN), FEditDCSumm);
839	ExecuteTemplateOrBoilerPlate(TmpBoilerPlate, FEditDCSumm.Title, ltTitle, Self, 'Title: ' + FEditDCSumm.TitleName, DocInfo);
840	QuickCopyWith508Msg(TmpBoilerPlate, memNewSumm);
841	TmpBoilerPlate.Free;
842	end;
843	if EnableAutosave then // Don't enable autosave until after dialog fields have been resolved
844	timAutoSave.Enabled := True;
845	end;
846	end;
847
848	procedure TfrmDCSumm.InsertAddendum;
849	{ sets up fields of pnlWrite to write an addendum for the selected Summary}
850	const
851	AS_ADDENDUM = True;
852	IS_ID_CHILD = False;
853	var
854	HaveRequired: Boolean;
855	CreatedSumm: TCreatedDoc;
856	ListItemForEdit: string;
857	tmpNode: TTreeNode;
858	x: string;
859	begin
860	ClearEditControls;
861	FShowAdmissions := False;
862	with FEditDCSumm do
863	begin
864	DocType := TYP_ADDENDUM;
865	Title := TitleForNote(lstSumms.ItemIEN);
866	TitleName := Piece(lstSumms.Items[lstSumms.ItemIndex], U, 2);
867	if Copy(TitleName,1,1) = '+' then TitleName := Copy(TitleName, 3, 199);
868	DictDateTime := FMNow;
869	Dictator := User.DUZ;
870	DictatorName := User.Name;
871	Addend := lstSumms.ItemIEN;
872	end;
873	// check to see if interaction necessary to get required fields
874	if LacksRequiredForCreate
875	then HaveRequired := ExecuteDCSummProperties(FEditDCSumm, ListItemForEdit, FShowAdmissions, IS_ID_CHILD)
876	else HaveRequired := True;
877	if HaveRequired then
878	begin
879	with FEditDCSumm do
880	begin
881	uPCEEdit.NoteDateTime := DischargeDateTime;
882	uPCEEdit.PCEForNote(Addend, uPCEShow);
883	Location := uPCEEdit.Location;
884	LocationName := ExternalName(uPCEEdit.Location, 44);
885	AdmitDateTime := uPCEEdit.DateTime;
886	DischargeDateTime := StrToFMDateTime(GetDischargeDate(Patient.DFN, FloatToStr(AdmitDateTime)));
887	if DischargeDateTime <= 0 then DischargeDateTime := FMNow;
888	end;
889	PutDCAddendum(CreatedSumm, FEditDCSumm, FEditDCSumm.Addend);
890	uPCEEdit.NoteIEN := CreatedSumm.IEN;
891	if CreatedSumm.IEN > 0 then LockDocument(CreatedSumm.IEN, CreatedSumm.ErrorText);
892	if CreatedSumm.ErrorText = '' then
893	begin
894	with FEditDCSumm do
895	begin
896	x := IntToStr(CreatedSumm.IEN) + U + 'Addendum to ' + TitleName + U + FloatToStr(DischargeDateTime) + U +
897	Patient.Name + U + IntToStr(Dictator) + ';' + DictatorName + U + LocationName + U + 'new' + U +
898	'Adm: ' + FormatFMDateTime('mmm dd,yyyy', AdmitDateTime) + ';' + FloatToStr(AdmitDateTime) + U +
899	'Dis: ' + FormatFMDateTime('mmm dd,yyyy', DischargeDateTime) + ';' + FloatToStr(DischargeDateTime) +
900	U + U + U + U + U + U;
901	end;
902	lstSumms.Items.Insert(0, x);
903	uChanging := True;
904	tvSumms.Items.BeginUpdate;
905	tmpNode := tvSumms.Items.AddObjectFirst(tvSumms.Items.GetFirstNode, 'New Addendum in Progress',
906	MakeDCSummTreeObject('ADDENDUM^New Addendum in Progress^^^^^^^^^^^%^0'));
907	TORTreeNode(tmpNode).StringData := 'ADDENDUM^New Addendum in Progress^^^^^^^^^^^%^0';
908	tmpNode.ImageIndex := IMG_TOP_LEVEL;
909	tmpNode := tvSumms.Items.AddChildObjectFirst(tmpNode, MakeDCSummDisplayText(x), MakeDCSummTreeObject(x));
910	TORTreeNode(tmpNode).StringData := x;
911	tmpNode.ImageIndex := IMG_ADDENDUM;
912	tmpNode.SelectedIndex := IMG_ADDENDUM;
913	tvSumms.Selected := tmpNode;
914	tvSumms.Items.EndUpdate;
915	uChanging := False;
916	Changes.Add(CH_SUM, IntToStr(CreatedSumm.IEN), GetTitleText(0), '', CH_SIGN_YES);
917	lstSumms.ItemIndex := 0;
918	EditingIndex := 0;
919	cmdChangeClick(Self); // will set captions, sign state for Changes
920	lstSummsClick(Self); // will make pnlWrite visible
921	if timAutoSave.Interval <> 0 then timAutoSave.Enabled := True;
922	memNewSumm.SetFocus;
923	end else
924	begin
925	InfoBox(CreatedSumm.ErrorText, TX_CREATE_ERR, MB_OK);
926	HaveRequired := False;
927	end; {if CreatedNote.IEN}
928	end; {if HaveRequired}
929	if not HaveRequired then ClearEditControls;
930	end;
931
932	procedure TfrmDCSumm.LoadForEdit(PreserveValues: Boolean);
933	{ retrieves an existing Summ and places the data in the fields of pnlWrite }
934	var
935	tmpNode: TTreeNode;
936	x: string;
937	begin
938	if not PreserveValues then ClearEditControls;
939	if not LockSumm(lstSumms.ItemIEN) then Exit;
940	EditingIndex := lstSumms.ItemIndex;
941	Changes.Add(CH_SUM, lstSumms.ItemID, GetTitleText(EditingIndex), '', CH_SIGN_YES);
942	if not PreserveValues then GetDCSummForEdit(FEditDCSumm, lstSumms.ItemIEN);
943	if FEditDCSumm.Lines <> nil then memNewSumm.Lines.Assign(FEditDCSumm.Lines);
944	FChanged := False;
945	if FEditDCSumm.Title = TYP_ADDENDUM then
946	begin
947	FEditDCSumm.DocType := TYP_ADDENDUM;
948	FEditDCSumm.TitleName := Piece(lstSumms.Items[lstSumms.ItemIndex], U, 2);
949	if Copy(FEditDCSumm.TitleName,1,1) = '+' then FEditDCSumm.TitleName := Copy(FEditDCSumm.TitleName, 3, 199);
950	if CompareText(Copy(FEditDCSumm.TitleName, 1, 8), 'Addendum') <> 0
951	then FEditDCSumm.TitleName := FEditDCSumm.TitleName + 'Addendum to ';
952	end;
953
954	uChanging := True;
955	tvSumms.Items.BeginUpdate;
956	tmpNode := tvSumms.FindPieceNode('EDIT', 1, U, nil);
957	if tmpNode = nil then
958	begin
959	tmpNode := tvSumms.Items.AddObjectFirst(tvSumms.Items.GetFirstNode, 'Summary being edited',
960	MakeDCSummTreeObject('EDIT^Summary being edited^^^^^^^^^^^%^0'));
961	TORTreeNode(tmpNode).StringData := 'EDIT^Summary being edited^^^^^^^^^^^%^0';
962	end
963	else
964	tmpNode.DeleteChildren;
965	x := lstSumms.Items[lstSumms.ItemIndex];
966	tmpNode.ImageIndex := IMG_TOP_LEVEL;
967	tmpNode := tvSumms.Items.AddChildObjectFirst(tmpNode, MakeDCSummDisplayText(x), MakeDCSummTreeObject(x));
968	TORTreeNode(tmpNode).StringData := x;
969	if CompareText(Copy(FEditDCSumm.TitleName, 1, 8), 'Addendum') <> 0 then
970	tmpNode.ImageIndex := IMG_SINGLE
971	else
972	tmpNode.ImageIndex := IMG_ADDENDUM;
973	tmpNode.SelectedIndex := tmpNode.ImageIndex;
974	tvSumms.Selected := tmpNode;
975	tvSumms.Items.EndUpdate;
976	uChanging := False;
977
978	uPCEEdit.NoteDateTime := MakeFMDateTime(Piece(lstSumms.Items[lstSumms.ItemIndex], U, 3));
979	uPCEEdit.PCEForNote(lstSumms.ItemIEN, uPCEShow);
980	FEditDCSumm.NeedCPT := uPCEEdit.CPTRequired;
981	cmdChangeClick(Self); // will set captions, sign state for Changes
982	lstSummsClick(Self); // will make pnlWrite visible
983	if timAutoSave.Interval <> 0 then timAutoSave.Enabled := True;
984	memNewSumm.SetFocus;
985	end;
986
987	function TfrmDCSumm.TitleText(AnIndex: Integer): string;
988	{ returns non-tabbed text for the title of a Summ given the ItemIndex in lstSumms }
989	begin
990	with lstSumms do
991	Result := FormatFMDateTime('mmm dd,yy', MakeFMDateTime(Piece(Items[AnIndex], U, 3))) +
992	' ' + Piece(Items[AnIndex], U, 2);
993	end;
994
995	procedure TfrmDCSumm.SaveEditedSumm(var Saved: Boolean);
996	{ validates fields and sends the updated Summ to the server }
997	var
998	UpdatedSumm: TCreatedDoc;
999	x: string;
1000	begin
1001	Saved := False;
1002	if (memNewSumm.GetTextLen = 0) or (not ContainsVisibleChar(memNewSumm.Text)) then
1003	begin
1004	lstSumms.ItemIndex := EditingIndex;
1005	x := lstSumms.ItemID;
1006	uChanging := True;
1007	tvSumms.Selected := tvSumms.FindPieceNode(x, 1, U, tvSumms.Items.GetFirstNode);
1008	uChanging := False;
1009	tvSummsChange(Self, tvSumms.Selected);
1010	if FSilent or
1011	((not FSilent) and
1012	(InfoBox(GetTitleText(EditingIndex) + TX_EMPTY_SUMM, TC_EMPTY_SUMM, MB_YESNO) = IDYES))
1013	then
1014	begin
1015	FConfirmed := True;
1016	mnuActDeleteClick(Self);
1017	Saved := True;
1018	FDeleted := True;
1019	end
1020	else
1021	FConfirmed := False;
1022	Exit;
1023	end;
1024	//ExpandTabsFilter(memNewSumm.Lines, TAB_STOP_CHARS);
1025	with FEditDCSumm do
1026	begin
1027	if (Attending = 0) and (not FSilent) then
1028	begin
1029	InfoBox(TX_MISSING_FIELDS, TC_MISSING_FIELDS,MB_OK);
1030	cmdChangeClick(mnuActSave);
1031	Exit;
1032	end;
1033	NeedCPT := uPCEEdit.CPTRequired; {RAB}
1034	Lines := memNewSumm.Lines;
1035	if RequireMASVerification(lstSumms.GetIEN(EditingIndex), TYP_DC_SUMM) then
1036	Status := TIU_ST_UNVER;
1037	(if (User.DUZ <> Dictator) and (User.DUZ <> Attending) and) //ALL USERS??
1038	if RequireRelease(lstSumms.GetIEN(EditingIndex), TYP_DC_SUMM) then
1039	begin
1040	if not FSilent then
1041	begin
1042	if InfoBox(TX_RELEASE, TC_RELEASE, MB_YESNO) = IDNO then
1043	Status := TIU_ST_UNREL;
1044	end
1045	else // always save as unreleased on timeout
1046	Status := TIU_ST_UNREL;
1047	end;
1048	end;
1049	timAutoSave.Enabled := False;
1050	try
1051	PutEditedDCSumm(UpdatedSumm, FEditDCSumm, lstSumms.GetIEN(EditingIndex));
1052	finally
1053	timAutoSave.Enabled := True;
1054	end;
1055	if UpdatedSumm.IEN > 0 then
1056	begin
1057	if (FEditDCSumm.Status in [TIU_ST_UNREL, TIU_ST_UNVER]) then
1058	begin
1059	Changes.Remove(CH_SUM, IntToStr(UpdatedSumm.IEN)); // DON'T REPROMPT ON PATIENT CHANGE
1060	UnlockDocument(UpdatedSumm.IEN); // Unlock only if UNRELEASED or UNVERIFIED
1061	end;
1062	// otherwise, there's no unlocking here since the note is still in Changes after a save
1063	if lstSumms.ItemIndex = EditingIndex then
1064	begin
1065	EditingIndex := -1;
1066	lstSummsClick(Self);
1067	end;
1068	EditingIndex := -1; // make sure EditingIndex reset even if not viewing edited note
1069	Saved := True;
1070	FChanged := False;
1071	end else
1072	begin
1073	if not FSilent then
1074	InfoBox(TX_SAVE_ERROR1 + UpdatedSumm.ErrorText + TX_SAVE_ERROR2, TC_SAVE_ERROR, MB_OK or MB_ICONWARNING);
1075	end;
1076	end;
1077
1078	procedure TfrmDCSumm.SaveCurrentSumm(var Saved: Boolean);
1079	{ called whenever a Summ should be saved - uses IEN to call appropriate save logic }
1080	begin
1081	if EditingIndex < 0 then Exit;
1082	SaveEditedSumm(Saved);
1083	end;
1084
1085	{ Form events ------------------------------------------------------------------------------ }
1086
1087	procedure TfrmDCSumm.pnlRightResize(Sender: TObject);
1088	{ memSumm (TRichEdit) doesn't repaint appropriately unless its parent panel is refreshed }
1089	begin
1090	inherited;
1091	pnlRight.Refresh;
1092	memSumm.Repaint;
1093	end;
1094
1095	procedure TfrmDCSumm.pnlWriteResize(Sender: TObject);
1096	const
1097	LEFT_MARGIN = 4;
1098	begin
1099	inherited;
1100	LimitEditWidth(memNewSumm, MAX_ENTRY_WIDTH - 1);
1101	memNewSumm.Constraints.MinWidth := TextWidthByFont(memNewSumm.Font.Handle, StringOfChar('X', MAX_ENTRY_WIDTH)) + (LEFT_MARGIN * 2) + ScrollBarWidth;
1102	pnlLeft.Width := self.ClientWidth - pnlWrite.Width - sptHorz.Width;
1103	end;
1104
1105	{ Left panel (selector) events ------------------------------------------------------------- }
1106
1107	procedure TfrmDCSumm.lstSummsClick(Sender: TObject);
1108	{ loads the text for the selected Summ or displays the editing panel for the selected Summ }
1109	var
1110	x: string;
1111	begin
1112	inherited;
1113	with lstSumms do if ItemIndex = -1 then Exit
1114	else if ItemIndex = EditingIndex then
1115	begin
1116	pnlWrite.Visible := True;
1117	pnlRead.Visible := False;
1118	mnuViewDetail.Enabled := False;
1119	mnuActChange.Enabled := True;
1120	mnuActLoadBoiler.Enabled := True;
1121	end else
1122	begin
1123	StatusText('Retrieving selected Discharge Summary...');
1124	Screen.Cursor := crHourGlass;
1125	pnlRead.Visible := True;
1126	pnlWrite.Visible := False;
1127	lblTitle.Caption := MakeDCSummDisplayText(Items[ItemIndex]);
1128	lvSumms.Caption := lblTitle.Caption;
1129	lblTitle.Hint := lblTitle.Caption;
1130	//lblTitle.Caption := Piece(DisplayText[ItemIndex], #9, 1) + ' ' + Piece(DisplayText[ItemIndex], #9, 2);
1131	LoadDocumentText(memSumm.Lines, ItemIEN);
1132	memSumm.SelStart := 0;
1133	mnuViewDetail.Enabled := True;
1134	mnuViewDetail.Checked := False;
1135	mnuActChange.Enabled := False;
1136	mnuActLoadBoiler.Enabled := False;
1137	Screen.Cursor := crDefault;
1138	StatusText('');
1139	end;
1140	DisplayPCE;
1141	pnlRight.Refresh;
1142	memNewSumm.Repaint;
1143	memSumm.Repaint;
1144	x := 'TIU^' + lstSumms.ItemID;
1145	SetPiece(x, U, 10, Piece(lstSumms.Items[lstSumms.ItemIndex], U, 11));
1146	NotifyOtherApps(NAE_REPORT, x);
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	FDischargeDate := FMNow;
1972	EditingIndex := -1;
1973	FEditDCSumm.LastCosigner := 0;
1974	FEditDCSumm.LastCosignerName := '';
1975	FLastSummID := '';
1976	frmDrawers := TfrmDrawers.CreateDrawers(Self, pnlDrawers, [],[]);
1977	frmDrawers.Align := alBottom;
1978	frmDrawers.RichEditControl := memNewSumm;
1979	frmDrawers.Splitter := splDrawers;
1980	frmDrawers.DefTempPiece := 3;
1981	FImageFlag := TBitmap.Create;
1982	FDocList := TStringList.Create;
1983	end;
1984
1985	procedure TfrmDCSumm.mnuViewDetailClick(Sender: TObject);
1986	begin
1987	inherited;
1988	if lstSumms.ItemIEN <= 0 then Exit;
1989	mnuViewDetail.Checked := not mnuViewDetail.Checked;
1990	if mnuViewDetail.Checked then
1991	begin
1992	StatusText('Retrieving discharge summary details...');
1993	Screen.Cursor := crHourGlass;
1994	LoadDetailText(memSumm.Lines, lstSumms.ItemIEN);
1995	Screen.Cursor := crDefault;
1996	StatusText('');
1997	memSumm.SelStart := 0;
1998	memSumm.Repaint;
1999	end
2000	else
2001	lstSummsClick(Self);
2002	SendMessage(memSumm.Handle, WM_VSCROLL, SB_TOP, 0);
2003	end;
2004
2005	procedure TfrmDCSumm.FormClose(Sender: TObject; var Action: TCloseAction);
2006	var
2007	Saved: Boolean;
2008	IEN: Int64;
2009	ErrMsg: string;
2010	DeleteSts: TActionRec;
2011	begin
2012	inherited;
2013	if frmFrame.TimedOut and (EditingIndex <> -1) then
2014	begin
2015	FSilent := True;
2016	if memNewSumm.GetTextLen > 0 then SaveCurrentSumm(Saved)
2017	else
2018	begin
2019	IEN := lstSumms.GetIEN(EditingIndex);
2020	if not LastSaveClean(IEN) then // means note hasn't been committed yet
2021	begin
2022	LockDocument(IEN, ErrMsg);
2023	if ErrMsg = '' then
2024	begin
2025	DeleteDocument(DeleteSts, IEN, '');
2026	UnlockDocument(IEN);
2027	end; {if ErrMsg}
2028	end; {if not LastSaveClean}
2029	end; {else}
2030	end; {if frmFrame}
2031	end;
2032
2033	procedure TfrmDCSumm.mnuActIdentifyAddlSignersClick(Sender: TObject);
2034	var
2035	Exclusions: TStrings;
2036	Saved, x, y: boolean;
2037	SignerList: TSignerList;
2038	ActionSts: TActionRec;
2039	SigAction: integer;
2040	SavedDocID: string;
2041	ARefDate: TFMDateTime;
2042	begin
2043	inherited;
2044	if NoSummSelected() then Exit;
2045	if lstSumms.ItemIndex = EditingIndex then
2046	begin
2047	SaveCurrentSumm(Saved);
2048	if not Saved then Exit;
2049	LoadSumms;
2050	with tvSumms do Selected := FindPieceNode(SavedDocID, U, Items.GetFirstNode);
2051	end;
2052	x := CanChangeCosigner(lstSumms.ItemIEN);
2053	ActOnDocument(ActionSts, lstSumms.ItemIEN, 'IDENTIFY SIGNERS');
2054	y := ActionSts.Success;
2055	if x and not y then
2056	begin
2057	if InfoBox(ActionSts.Reason + CRLF + CRLF +
2058	'Would you like to change the cosigner?',
2059	TX_IN_AUTH, MB_YESNO or MB_DEFBUTTON2 or MB_ICONQUESTION) = ID_YES then
2060	SigAction := SG_COSIGNER
2061	else
2062	Exit;
2063	end
2064	else if y and not x then SigAction := SG_ADDITIONAL
2065	else if x and y then SigAction := SG_BOTH
2066	else
2067	begin
2068	InfoBox(ActionSts.Reason, TX_IN_AUTH, MB_OK);
2069	Exit;
2070	end;
2071
2072	// NEED TO PREVENT CHANGE OF COSIGNER ON DC SUMMARIES?
2073	{ if y then SigAction := SG_ADDITIONAL
2074	else
2075	begin
2076	InfoBox(ActionSts.Reason, TX_IN_AUTH, MB_OK);
2077	Exit;
2078	end; }
2079
2080	Exclusions := GetCurrentSigners(lstSumms.ItemIEN);
2081	ARefDate := ExtractFloat(Piece(Piece(lstSumms.Items[lstSumms.ItemIndex], U, 9), ';', 2));
2082	if ARefDate = 0 then //no discharge date, so use note date
2083	ARefDate := StrToFloat(Piece(lstSumms.Items[lstSumms.ItemIndex], U, 3));
2084	SelectAdditionalSigners(Font.Size, lstSumms.ItemIEN, SigAction, Exclusions, SignerList, CT_DCSUMM, ARefDate);
2085	with SignerList do
2086	begin
2087	case SigAction of
2088	SG_ADDITIONAL: if Changed and (Signers <> nil) and (Signers.Count > 0) then
2089	UpdateAdditionalSigners(lstSumms.ItemIEN, Signers);
2090	SG_COSIGNER: if Changed then ChangeAttending(lstSumms.ItemIEN, Cosigner);
2091	SG_BOTH: if Changed then
2092	begin
2093	if (Signers <> nil) and (Signers.Count > 0) then
2094	UpdateAdditionalSigners(lstSumms.ItemIEN, Signers);
2095	ChangeAttending(lstSumms.ItemIEN, Cosigner);
2096	end;
2097	end;
2098	lstSummsClick(Self);
2099	end;
2100	end;
2101
2102	procedure TfrmDCSumm.popSummMemoAddlSignClick(Sender: TObject);
2103	begin
2104	inherited;
2105	mnuActIdentifyAddlSignersClick(Self);
2106	end;
2107
2108	procedure TfrmDCSumm.ProcessNotifications;
2109	var
2110	x: string;
2111	Saved: boolean;
2112	tmpNode: TTreeNode;
2113	AnObject: PDocTreeObject;
2114	begin
2115	if EditingIndex <> -1 then
2116	begin
2117	SaveCurrentSumm(Saved);
2118	if not Saved then Exit;
2119	end;
2120	lblSumms.Caption := Notifications.Text;
2121	tvSumms.Caption := Notifications.Text;
2122	EditingIndex := -1;
2123	lstSumms.Enabled := True ;
2124	pnlRead.BringToFront ;
2125	x := Notifications.AlertData;
2126	//x := MakeDCSummListItem(Notifications.AlertData);
2127	if StrToIntDef(Piece(x, U, 1), 0) = 0 then
2128	begin
2129	InfoBox(TX_NO_ALERT, TX_CAP_NO_ALERT, MB_OK);
2130	Exit;
2131	end;
2132	uChanging := True;
2133	tvSumms.Items.BeginUpdate;
2134	lstSumms.Clear;
2135	KillDocTreeObjects(tvSumms);
2136	tvSumms.Items.Clear;
2137	lstSumms.Items.Add(x);
2138	AnObject := MakeDCSummTreeObject('ALERT^Alerted Note^^^^^^^^^^^%^0');
2139	tmpNode := tvSumms.Items.AddObjectFirst(tvSumms.Items.GetFirstNode, AnObject.NodeText, AnObject);
2140	TORTreeNode(tmpNode).StringData := 'ALERT^Alerted Note^^^^^^^^^^^%^0';
2141	tmpNode.ImageIndex := IMG_TOP_LEVEL;
2142	AnObject := MakeDCSummTreeObject(x);
2143	tmpNode := tvSumms.Items.AddChildObjectFirst(tmpNode, AnObject.NodeText, AnObject);
2144	TORTreeNode(tmpNode).StringData := x;
2145	SetTreeNodeImagesAndFormatting(TORTreeNode(tmpNode), FCurrentContext, CT_DCSUMM);
2146	tvSumms.Selected := tmpNode;
2147	tvSumms.Items.EndUpdate;
2148	uChanging := False;
2149	tvSummsChange(Self, tvSumms.Selected);
2150	case Notifications.Followup of
2151	NF_DCSUMM_UNSIGNED_NOTE: ; //Automatically deleted by sig action!!!
2152	end;
2153	if Copy(Piece(Notifications.RecordID, U, 2), 1, 6) = 'TIUADD' then Notifications.Delete;
2154	if Copy(Piece(Notifications.RecordID, U, 2), 1, 5) = 'TIUID' then Notifications.Delete;
2155	end;
2156
2157	procedure TfrmDCSumm.SetViewContext(AContext: TTIUContext);
2158	var
2159	Saved: boolean;
2160	begin
2161	if EditingIndex <> -1 then
2162	begin
2163	SaveCurrentSumm(Saved);
2164	if not Saved then Exit;
2165	end;
2166	EditingIndex := -1;
2167	tvSumms.Enabled := True ;
2168	pnlRead.BringToFront ;
2169	if FCurrentContext.Status <> '' then with uDCSummContext do
2170	begin
2171	BeginDate := FCurrentContext.BeginDate;
2172	EndDate := FCurrentContext.EndDate;
2173	FMBeginDate := FCurrentContext.FMBeginDate;
2174	FMEndDate := FCurrentContext.FMEndDate;
2175	Status := FCurrentContext.Status;
2176	Author := FCurrentContext.Author;
2177	MaxDocs := FCurrentContext.MaxDocs;
2178	ShowSubject := FCurrentContext.ShowSubject;
2179	GroupBy := FCurrentContext.GroupBy;
2180	SortBy := FCurrentContext.SortBy;
2181	ListAscending := FCurrentContext.ListAscending;
2182	TreeAscending := FCurrentContext.TreeAscending;
2183	Keyword := FCurrentContext.Keyword;
2184	SearchField := FCurrentContext.SearchField;
2185	Filtered := FCurrentContext.Filtered;
2186	Changed := True;
2187	mnuViewClick(Self);
2188	end
2189	else
2190	begin
2191	ViewContext := NC_RECENT ;
2192	mnuViewClick(Self);
2193	end;
2194	end;
2195
2196	procedure TfrmDCSumm.mnuViewSaveAsDefaultClick(Sender: TObject);
2197	const
2198	TX_NO_MAX = 'You have not specified a maximum number of summaries to be returned.' + CRLF +
2199	'If you save this preference, the result will be that ALL summaries for every' + CRLF +
2200	'patient will be saved as your default view.' + CRLF + CRLF +
2201	'For patients with large numbers of summaries, this could result in some lengthy' + CRLF +
2202	'delays in loading the list of summaries.' + CRLF + CRLF +
2203	'Are you sure you mean to do this?';
2204	TX_REPLACE = 'Replace current defaults?';
2205	begin
2206	inherited;
2207	if FCurrentContext.MaxDocs = 0 then
2208	if InfoBox(TX_NO_MAX,'Warning', MB_YESNO or MB_ICONWARNING) = IDNO then
2209	begin
2210	mnuViewClick(mnuViewCustom);
2211	Exit;
2212	end;
2213	if InfoBox(TX_REPLACE,'Confirmation', MB_YESNO or MB_ICONQUESTION) = IDYES then
2214	begin
2215	SaveCurrentDCSummContext(FCurrentContext);
2216	FDefaultContext := FCurrentContext;
2217	//lblSumms.Caption := 'Default List';
2218	end;
2219	end;
2220
2221	procedure TfrmDCSumm.mnuViewReturntoDefaultClick(Sender: TObject);
2222	begin
2223	inherited;
2224	SetViewContext(FDefaultContext);
2225	end;
2226
2227	procedure TfrmDCSumm.popSummMemoTemplateClick(Sender: TObject);
2228	begin
2229	inherited;
2230	EditTemplates(Self, True, FEditCtrl.SelText);
2231	end;
2232
2233	procedure TfrmDCSumm.popSummListPopup(Sender: TObject);
2234	begin
2235	inherited;
2236	N5.Visible := (popSummList.PopupComponent is TORTreeView);
2237	popSummListExpandAll.Visible := N5.Visible;
2238	popSummListExpandSelected.Visible := N5.Visible;
2239	popSummListCollapseAll.Visible := N5.Visible;
2240	popSummListCollapseSelected.Visible := N5.Visible;
2241	end;
2242
2243	procedure TfrmDCSumm.popSummListExpandAllClick(Sender: TObject);
2244	begin
2245	inherited;
2246	tvSumms.FullExpand;
2247	end;
2248
2249	procedure TfrmDCSumm.popSummListCollapseAllClick(Sender: TObject);
2250	begin
2251	inherited;
2252	tvSumms.Selected := nil;
2253	lvSumms.Items.Clear;
2254	memSumm.Clear;
2255	tvSumms.FullCollapse;
2256	tvSumms.Selected := tvSumms.TopItem;
2257	end;
2258
2259	procedure TfrmDCSumm.popSummListExpandSelectedClick(Sender: TObject);
2260	begin
2261	inherited;
2262	if tvSumms.Selected = nil then exit;
2263	with tvSumms.Selected do if HasChildren then Expand(True);
2264	end;
2265
2266	procedure TfrmDCSumm.popSummListCollapseSelectedClick(Sender: TObject);
2267	begin
2268	inherited;
2269	if tvSumms.Selected = nil then exit;
2270	with tvSumms.Selected do if HasChildren then Collapse(True);
2271	end;
2272
2273	procedure TfrmDCSumm.mnuNewTemplateClick(Sender: TObject);
2274	begin
2275	inherited;
2276	EditTemplates(Self, True);
2277	end;
2278
2279	procedure TfrmDCSumm.mnuEditTemplatesClick(Sender: TObject);
2280	begin
2281	inherited;
2282	EditTemplates(Self);
2283	end;
2284
2285	procedure TfrmDCSumm.mnuOptionsClick(Sender: TObject);
2286	begin
2287	inherited;
2288	mnuEditTemplates.Enabled := frmDrawers.CanEditTemplates;
2289	mnuNewTemplate.Enabled := frmDrawers.CanEditTemplates;
2290	mnuEditSharedTemplates.Enabled := frmDrawers.CanEditShared;
2291	mnuNewSharedTemplate.Enabled := frmDrawers.CanEditShared;
2292	mnuEditDialgFields.Enabled := CanEditTemplateFields;
2293	end;
2294
2295	procedure TfrmDCSumm.mnuEditSharedTemplatesClick(Sender: TObject);
2296	begin
2297	inherited;
2298	EditTemplates(Self, FALSE, '', TRUE);
2299	end;
2300
2301	procedure TfrmDCSumm.mnuNewSharedTemplateClick(Sender: TObject);
2302	begin
2303	inherited;
2304	EditTemplates(Self, TRUE, '', TRUE);
2305	end;
2306
2307	procedure TfrmDCSumm.FormDestroy(Sender: TObject);
2308	begin
2309	FImageFlag.Free;
2310	FDocList.Free;
2311	KillDocTreeObjects(tvSumms);
2312	inherited;
2313	end;
2314
2315	function TfrmDCSumm.GetDrawers: TFrmDrawers;
2316	begin
2317	Result := frmDrawers;
2318	end;
2319
2320	procedure TfrmDCSumm.SetEditingIndex(const Value: Integer);
2321	begin
2322	FEditingIndex := Value;
2323	end;
2324
2325	(*function TfrmDCSumm.MakeTitleText(IsAddendum: Boolean = False): string;
2326	{ returns display text for list box based on FEditNote }
2327	begin
2328	Result := FormatFMDateTime('mmm dd,yy', FEditDCSumm.DischargeDateTime) + U;
2329	if IsAddendum and (CompareText(Copy(FEditDCSumm.TitleName, 1, 8), 'Addendum') <> 0)
2330	then Result := Result + 'Addendum to ';
2331	Result := Result + FEditDCSumm.TitleName + ', ' + FEditDCSumm.LocationName + ', ' +
2332	FEditDCSumm.DictatorName;
2333	end;*)
2334
2335	function TfrmDCSumm.LacksRequiredForCreate: Boolean;
2336	{ determines if the fields required to create the note are present }
2337	var
2338	CurTitle: Integer;
2339	ADateTime: TFMDateTime;
2340	begin
2341	Result := False;
2342	with FEditDCSumm do
2343	begin
2344	if Title <= 0 then Result := True;
2345	if Dictator <= 0 then Result := True;
2346	if AdmitDateTime <= 0 then Result := True;
2347	if DischargeDateTime > 0 then
2348	ADateTime := DischargeDateTime
2349	else
2350	ADateTime := DictDateTime;
2351	if (DocType = TYP_ADDENDUM) then
2352	begin
2353	if AskCosignerForDocument(Addend, Dictator, ADateTime) and (Cosigner <= 0) then Result := True;
2354	end else
2355	begin
2356	if Title > 0 then CurTitle := Title else CurTitle := DocType;
2357	if AskCosignerForTitle(CurTitle, Dictator, ADateTime) and (Cosigner <= 0) then Result := True;
2358	end;
2359	end;
2360	end;
2361
2362	function TfrmDCSumm.VerifySummTitle: Boolean;
2363	const
2364	VNT_UNKNOWN = 0;
2365	VNT_NO = 1;
2366	VNT_YES = 2;
2367	var
2368	AParam: string;
2369	begin
2370	if FVerifySummTitle = VNT_UNKNOWN then
2371	begin
2372	AParam := GetUserParam('ORWOR VERIFY NOTE TITLE');
2373	if AParam = '1' then FVerifySummTitle := VNT_YES else FVerifySummTitle := VNT_NO;
2374	end;
2375	Result := FVerifySummTitle = VNT_YES;
2376	end;
2377
2378	function TfrmDCSumm.LockSumm(AnIEN: Int64): Boolean;
2379	{ returns true if summ successfully locked }
2380	var
2381	LockMsg: string;
2382	begin
2383	Result := True;
2384	if Changes.Exist(CH_SUM, IntToStr(AnIEN)) then Exit; // already locked
2385	LockDocument(AnIEN, LockMsg);
2386	if LockMsg <> '' then
2387	begin
2388	Result := False;
2389	InfoBox(LockMsg, TC_NO_LOCK, MB_OK);
2390	end;
2391	end;
2392
2393	procedure TfrmDCSumm.DoAutoSave(Suppress: integer = 1);
2394	var
2395	ErrMsg: string;
2396	begin
2397	if fFrame.frmFrame.DLLActive = True then Exit;
2398	if (EditingIndex > -1) and FChanged then
2399	begin
2400	StatusText('Autosaving note...');
2401	//PutTextOnly(ErrMsg, memNewNote.Lines, lstNotes.GetIEN(EditingIndex));
2402	timAutoSave.Enabled := False;
2403	try
2404	SetText(ErrMsg, memNewSumm.Lines, lstSumms.GetIEN(EditingIndex), Suppress);
2405	finally
2406	timAutoSave.Enabled := True;
2407	end;
2408	FChanged := False;
2409	StatusText('');
2410	end;
2411	if ErrMsg <> '' then
2412	InfoBox(TX_SAVE_ERROR1 + ErrMsg + TX_SAVE_ERROR2, TC_SAVE_ERROR, MB_OK or MB_ICONWARNING);
2413	//Assert(ErrMsg = '', 'AutoSave: ' + ErrMsg);
2414	end;
2415
2416	procedure TfrmDCSumm.timAutoSaveTimer(Sender: TObject);
2417	begin
2418	inherited;
2419	DoAutoSave;
2420	end;
2421
2422	function TfrmDCSumm.GetTitleText(AnIndex: Integer): string;
2423	{ returns non-tabbed text for the title of a note given the ItemIndex in lstSumms }
2424	begin
2425	with lstSumms do
2426	Result := FormatFMDateTime('mmm dd,yy', MakeFMDateTime(Piece(Items[AnIndex], U, 3))) +
2427	' ' + Piece(Items[AnIndex], U, 2) + ', ' + Piece(Items[AnIndex], U, 6) + ', ' +
2428	Piece(Piece(Items[AnIndex], U, 5), ';', 2)
2429	end;
2430
2431	procedure TfrmDCSumm.cmdChangeClick(Sender: TObject);
2432	var
2433	LastTitle: Integer;
2434	OKPressed, IsIDChild: Boolean;
2435	x: string;
2436	ListItemForEdit: string;
2437	begin
2438	inherited;
2439	IsIDChild := uIDNotesActive and (FEditDCSumm.IDParent > 0);
2440	LastTitle := FEditDCSumm.Title;
2441	if Sender <> Self then
2442	begin
2443	FShowAdmissions := False;
2444	OKPressed := ExecuteDCSummProperties(FEditDCSumm, ListItemForEdit, FShowAdmissions, IsIDChild);
2445	end
2446	else
2447	OKPressed := True;
2448	if not OKPressed then Exit;
2449	// update display fields & uPCEEdit
2450	lblNewTitle.Caption := ' ' + FEditDCSumm.TitleName + ' ';
2451	if (FEditDCSumm.Addend > 0) and (CompareText(Copy(lblNewTitle.Caption, 2, 8), 'Addendum') <> 0) then
2452	lblNewTitle.Caption := 'Addendum to: ' + lblNewTitle.Caption;
2453	with lblNewTitle do bvlNewTitle.SetBounds(Left - 1, Top - 1, Width + 2, Height + 2);
2454	lblRefDate.Caption := FormatFMDateTime('mmm dd,yyyy@hh:nn', FEditDCSumm.DischargeDateTime);
2455	lblDictator.Caption := FEditDCSumm.DictatorName;
2456	x := 'Adm: ' + FormatFMDateTime('mm/dd/yy', FEditDCSumm.AdmitDateTime) + ' ' + FEditDCSumm.LocationName;
2457	lblVisit.Caption := x;
2458	x := ' Dis: ' + FormatFMDateTime('mm/dd/yy', FEditDCSumm.DischargeDateTime);
2459	lblDischarge.Caption := x;
2460	if Length(FEditDCSumm.AttendingName) > 0
2461	then lblCosigner.Caption := 'Attending: ' + FEditDCSumm.AttendingName
2462	else lblCosigner.Caption := '';
2463	uPCEEdit.NoteTitle := FEditDCSumm.Title;
2464	// modify signature requirements if author or cosigner changed
2465	if (User.DUZ <> FEditDCSumm.Dictator) and (User.DUZ <> FEditDCSumm.Attending)
2466	then Changes.ReplaceSignState(CH_SUM, lstSumms.ItemID, CH_SIGN_NA)
2467	else Changes.ReplaceSignState(CH_SUM, lstSumms.ItemID, CH_SIGN_YES);
2468	x := lstSumms.Items[EditingIndex];
2469	SetPiece(x, U, 2, lblNewTitle.Caption);
2470	SetPiece(x, U, 3, FloatToStr(FEditDCSumm.DischargeDateTime));
2471	tvSumms.Selected.Text := MakeDCSummDisplayText(x);
2472	TORTreeNode(tvSumms.Selected).StringData := x;
2473	lstSumms.Items[EditingIndex] := x;
2474	Changes.ReplaceText(CH_SUM, lstSumms.ItemID, GetTitleText(EditingIndex));
2475	if LastTitle <> FEditDCSumm.Title then mnuActLoadBoilerClick(Self);
2476	end;
2477
2478	procedure TfrmDCSumm.mnuActChangeClick(Sender: TObject);
2479	begin
2480	inherited;
2481	if NoSummSelected() then Exit;
2482	if (FEditingIndex < 0) or (lstSumms.ItemIndex <> FEditingIndex) then Exit;
2483	cmdChangeClick(Sender);
2484	end;
2485
2486	procedure TfrmDCSumm.mnuActLoadBoilerClick(Sender: TObject);
2487	var
2488	NoteEmpty: Boolean;
2489	BoilerText: TStringList;
2490	DocInfo: string;
2491
2492	procedure AssignBoilerText;
2493	begin
2494	ExecuteTemplateOrBoilerPlate(BoilerText, FEditDCSumm.Title, ltTitle, Self, 'Title: ' + FEditDCSumm.TitleName, DocInfo);
2495	QuickCopyWith508Msg(BoilerText, memNewSumm);
2496	FChanged := False;
2497	end;
2498
2499	begin
2500	inherited;
2501	if NoSummSelected() then Exit;
2502	if (FEditingIndex < 0) or (lstSumms.ItemIndex <> FEditingIndex) then Exit;
2503	BoilerText := TStringList.Create;
2504	try
2505	NoteEmpty := memNewSumm.Text = '';
2506	LoadBoilerPlate(BoilerText, FEditDCSumm.Title);
2507	if (BoilerText.Text <> '') or
2508	assigned(GetLinkedTemplate(IntToStr(FEditDCSumm.Title), ltTitle)) then
2509	begin
2510	DocInfo := MakeXMLParamTIU(IntToStr(lstSumms.ItemIEN), FEditDCSumm);
2511	if NoteEmpty then AssignBoilerText else
2512	begin
2513	case QueryBoilerPlate(BoilerText) of
2514	0: { do nothing } ; // ignore
2515	1: begin
2516	ExecuteTemplateOrBoilerPlate(BoilerText, FEditDCSumm.Title, ltTitle, Self, 'Title: ' + FEditDCSumm.TitleName, DocInfo);
2517	QuickAddWith508Msg(BoilerText, memNewSumm); // append
2518	end;
2519	2: AssignBoilerText // replace
2520	end;
2521	end;
2522	end else
2523	begin
2524	if Sender = mnuActLoadBoiler
2525	then InfoBox(TX_NO_BOIL, TC_NO_BOIL, MB_OK)
2526	else
2527	begin
2528	if not NoteEmpty then
2529	if not FChanged and (InfoBox(TX_BLR_CLEAR, TC_BLR_CLEAR, MB_YESNO) = ID_YES)
2530	then memNewSumm.Lines.Clear;
2531	end;
2532	end; {if BoilerText.Text <> ''}
2533	finally
2534	BoilerText.Free;
2535	end;
2536	end;
2537
2538	procedure TfrmDCSumm.popSummMemoSaveContinueClick(Sender: TObject);
2539	begin
2540	inherited;
2541	FChanged := True;
2542	DoAutoSave;
2543	end;
2544
2545	procedure TfrmDCSumm.mnuEditDialgFieldsClick(Sender: TObject);
2546	begin
2547	inherited;
2548	EditDialogFields;
2549	end;
2550
2551	//=================== Added for sort/search enhancements ======================
2552	procedure TfrmDCSumm.LoadSumms;
2553	var
2554	tmpList: TStringList;
2555	ANode: TORTreeNode;
2556
2557	begin
2558	tmpList := TStringList.Create;
2559	try
2560	FDocList.Clear;
2561	uChanging := True;
2562	RedrawSuspend(memSumm.Handle);
2563	RedrawSuspend(lvSumms.Handle);
2564	tvSumms.Items.BeginUpdate;
2565	lstSumms.Items.Clear;
2566	KillDocTreeObjects(tvSumms);
2567	tvSumms.Items.Clear;
2568	tvSumms.Items.EndUpdate;
2569	lvSumms.Items.Clear;
2570	memSumm.Clear;
2571	memSumm.Invalidate;
2572	lblTitle.Caption := '';
2573	lvSumms.Caption := lblTitle.Caption;
2574	lblTitle.Hint := lblTitle.Caption;
2575	with FCurrentContext do
2576	begin
2577	if Status <> IntToStr(NC_UNSIGNED) then
2578	begin
2579	ListSummsForTree(tmpList, NC_UNSIGNED, 0, 0, 0, 0, TreeAscending);
2580	if tmpList.Count > 0 then
2581	begin
2582	CreateListItemsForDocumentTree(FDocList, tmpList, NC_UNSIGNED, GroupBy, TreeAscending, CT_DCSUMM);
2583	UpdateTreeView(FDocList, tvSumms);
2584	end;
2585	tmpList.Clear;
2586	FDocList.Clear;
2587	end;
2588	if Status <> IntToStr(NC_UNCOSIGNED) then
2589	begin
2590	ListSummsForTree(tmpList, NC_UNCOSIGNED, 0, 0, 0, 0, TreeAscending);
2591	if tmpList.Count > 0 then
2592	begin
2593	CreateListItemsForDocumentTree(FDocList, tmpList, NC_UNCOSIGNED, GroupBy, TreeAscending, CT_DCSUMM);
2594	UpdateTreeView(FDocList, tvSumms);
2595	end;
2596	tmpList.Clear;
2597	FDocList.Clear;
2598	end;
2599	ListSummsForTree(tmpList, StrToIntDef(Status, 0), FMBeginDate, FMEndDate, Author, MaxDocs, TreeAscending);
2600	CreateListItemsForDocumentTree(FDocList, tmpList, StrToIntDef(Status, 0), GroupBy, TreeAscending, CT_DCSUMM);
2601	UpdateTreeView(FDocList, tvSumms);
2602	end;
2603	with tvSumms do
2604	begin
2605	uChanging := True;
2606	tvSumms.Items.BeginUpdate;
2607	RemoveParentsWithNoChildren(tvSumms, FCurrentContext); // moved TO here in v15.9 (RV)
2608	if FLastSummID <> '' then
2609	Selected := FindPieceNode(FLastSummID, 1, U, nil);
2610	if Selected = nil then
2611	begin
2612	if (FCurrentContext.GroupBy <> '') or (FCurrentContext.Filtered) then
2613	begin
2614	ANode := TORTreeNode(Items.GetFirstNode);
2615	while ANode <> nil do
2616	begin
2617	ANode.Expand(False);
2618	Selected := ANode;
2619	ANode := TORTreeNode(ANode.GetNextSibling);
2620	end;
2621	end
2622	else
2623	begin
2624	ANode := tvSumms.FindPieceNode(FCurrentContext.Status, 1, U, nil);
2625	if ANode <> nil then ANode.Expand(False);
2626	ANode := tvSumms.FindPieceNode(IntToStr(NC_UNSIGNED), 1, U, nil);
2627	if ANode = nil then
2628	ANode := tvSumms.FindPieceNode(IntToStr(NC_UNCOSIGNED), 1, U, nil);
2629	if ANode = nil then
2630	ANode := tvSumms.FindPieceNode(FCurrentContext.Status, 1, U, nil);
2631	if ANode <> nil then
2632	begin
2633	if ANode.getFirstChild <> nil then
2634	Selected := ANode.getFirstChild
2635	else
2636	Selected := ANode;
2637	end;
2638	end;
2639	end;
2640	memSumm.Clear;
2641	with lvSumms do
2642	begin
2643	Selected := nil;
2644	if FCurrentContext.SortBy <> '' then
2645	ColumnToSort := Pos(FCurrentContext.SortBy, 'RDSAL') - 1;
2646	if not FCurrentContext.ShowSubject then
2647	begin
2648	Columns[1].Width := 2 * (Width div 5);
2649	Columns[2].Width := 0;
2650	end
2651	else
2652	begin
2653	Columns[1].Width := Width div 5;
2654	Columns[2].Width := Columns[1].Width;
2655	end;
2656	end;
2657	//RemoveParentsWithNoChildren(tvSumms, FCurrentContext); //moved FROM here in v15.9 (RV)
2658	tvSumms.Items.EndUpdate;
2659	uChanging := False;
2660	SendMessage(tvSumms.Handle, WM_VSCROLL, SB_TOP, 0);
2661	if Selected <> nil then tvSummsChange(Self, Selected);
2662	end;
2663	finally
2664	RedrawActivate(memSumm.Handle);
2665	RedrawActivate(lvSumms.Handle);
2666	tmpList.Free;
2667	end;
2668	end;
2669
2670	procedure TfrmDCSumm.UpdateTreeView(DocList: TStringList; Tree: TORTreeView);
2671	begin
2672	with Tree do
2673	begin
2674	uChanging := True;
2675	Items.BeginUpdate;
2676	FastAddStrings(DocList, lstSumms.Items);
2677	BuildDocumentTree(DocList, '0', Tree, nil, FCurrentContext, CT_DCSUMM);
2678	Items.EndUpdate;
2679	uChanging := False;
2680	end;
2681	end;
2682
2683	procedure TfrmDCSumm.tvSummsChange(Sender: TObject; Node: TTreeNode);
2684	var
2685	x, MySearch, MyNodeID: string;
2686	i: integer;
2687	WhyNot: string;
2688	begin
2689	if uChanging then Exit;
2690	//This gives the change a chance to occur when keyboarding, so that WindowEyes
2691	//doesn't use the old value.
2692	Application.ProcessMessages;
2693	with tvSumms do
2694	begin
2695	memSumm.Clear;
2696	if Selected = nil then Exit;
2697	if uIDNotesActive then
2698	begin
2699	mnuActDetachFromIDParent.Enabled := (Selected.ImageIndex in [IMG_ID_CHILD, IMG_ID_CHILD_ADD]);
2700	popSummListDetachFromIDParent.Enabled := (Selected.ImageIndex in [IMG_ID_CHILD, IMG_ID_CHILD_ADD]);
2701	if (Selected.ImageIndex in [IMG_SINGLE, IMG_PARENT, IMG_ID_CHILD, IMG_ID_CHILD_ADD]) then
2702	mnuActAttachtoIDParent.Enabled := CanBeAttached(PDocTreeObject(Selected.Data)^.DocID, WhyNot)
2703	else
2704	mnuActAttachtoIDParent.Enabled := False;
2705	popSummListAttachtoIDParent.Enabled := mnuActAttachtoIDParent.Enabled;
2706	if (Selected.ImageIndex in [IMG_SINGLE, IMG_PARENT,
2707	IMG_IDNOTE_OPEN, IMG_IDNOTE_SHUT,
2708	IMG_IDPAR_ADDENDA_OPEN, IMG_IDPAR_ADDENDA_SHUT]) then
2709	mnuActAddIDEntry.Enabled := CanReceiveAttachment(PDocTreeObject(Selected.Data)^.DocID, WhyNot)
2710	else
2711	mnuActAddIDEntry.Enabled := False;
2712	popSummListAddIDEntry.Enabled := mnuActAddIDEntry.Enabled
2713	end;
2714	RedrawSuspend(lvSumms.Handle);
2715	RedrawSuspend(memSumm.Handle);
2716	popSummListExpandSelected.Enabled := Selected.HasChildren;
2717	popSummListCollapseSelected.Enabled := Selected.HasChildren;
2718	x := TORTreeNode(Selected).StringData;
2719	if (Selected.ImageIndex in [IMG_TOP_LEVEL, IMG_GROUP_OPEN, IMG_GROUP_SHUT]) then
2720	begin
2721	lvSumms.Visible := True;
2722	lvSumms.Items.Clear;
2723	lvSumms.Height := (2 * lvSumms.Parent.Height) div 5;
2724	with lblTitle do
2725	begin
2726	Caption := Trim(Selected.Text);
2727	if (FCurrentContext.SearchField <> '') and (FCurrentContext.Filtered) then
2728	begin
2729	case FCurrentContext.SearchField[1] of
2730	'T': MySearch := 'TITLE';
2731	'S': MySearch := 'SUBJECT';
2732	'B': MySearch := 'TITLE or SUBJECT';
2733	end;
2734	Caption := Caption + ' where ' + MySearch + ' contains "' + UpperCase(FCurrentContext.Keyword) + '"';
2735	end;
2736	Hint := Caption;
2737	lvSumms.Caption := Caption;
2738	end;
2739
2740	if Selected.ImageIndex = IMG_TOP_LEVEL then
2741	MyNodeID := Piece(TORTreeNode(Selected).StringData, U, 1)
2742	else if Selected.Parent.ImageIndex = IMG_TOP_LEVEL then
2743	MyNodeID := Piece(TORTreeNode(Selected.Parent).StringData, U, 1)
2744	else if Selected.Parent.Parent.ImageIndex = IMG_TOP_LEVEL then
2745	MyNodeID := Piece(TORTreeNode(Selected.Parent.Parent).StringData, U, 1);
2746
2747	uChanging := True;
2748	TraverseTree(tvSumms, lvSumms, Selected.GetFirstChild, MyNodeID, FCurrentContext);
2749	with lvSumms do
2750	begin
2751	for i := 0 to Columns.Count - 1 do
2752	Columns[i].ImageIndex := IMG_NONE;
2753	ColumnSortForward := FCurrentContext.ListAscending;
2754	if ColumnToSort = 5 then ColumnToSort := 0;
2755	if ColumnSortForward then
2756	Columns[ColumnToSort].ImageIndex := IMG_ASCENDING
2757	else
2758	Columns[ColumnToSort].ImageIndex := IMG_DESCENDING;
2759	if ColumnToSort = 0 then ColumnToSort := 5;
2760	AlphaSort;
2761	Columns[5].Width := 0;
2762	Columns[6].Width := 0;
2763	end;
2764	uChanging := False;
2765	with lvSumms do
2766	if Items.Count > 0 then
2767	begin
2768	Selected := Items[0];
2769	lvSummsSelectItem(Self, Selected, True);
2770	end
2771	else
2772	begin
2773	Selected := nil;
2774	lstSumms.ItemIndex := -1;
2775	memPCEShow.Clear;
2776	ShowPCEControls(False);
2777	end;
2778	pnlWrite.Visible := False;
2779	pnlRead.Visible := True;
2780	(* UpdateReminderFinish;
2781	ShowPCEControls(False);
2782	frmDrawers.DisplayDrawers(FALSE);
2783	cmdNewSumm.Visible := TRUE;
2784	cmdPCE.Visible := FALSE;
2785	lblSpace1.Top := cmdNewSumm.Top - lblSpace1.Height;*)
2786	//memSumm.Clear;
2787	end
2788	else if StrToIntDef(Piece(x, U, 1), 0) > 0 then
2789	begin
2790	memSumm.Clear;
2791	lvSumms.Visible := False;
2792	lstSumms.SelectByID(Piece(x, U, 1));
2793	lstSummsClick(Self);
2794	SendMessage(memSumm.Handle, WM_VSCROLL, SB_TOP, 0);
2795	end;
2796	SendMessage(tvSumms.Handle, WM_HSCROLL, SB_THUMBTRACK, 0);
2797	RedrawActivate(lvSumms.Handle);
2798	RedrawActivate(memSumm.Handle);
2799	end;
2800	end;
2801
2802	procedure TfrmDCSumm.tvSummsCollapsed(Sender: TObject; Node: TTreeNode);
2803	begin
2804	with Node do
2805	begin
2806	if (ImageIndex in [IMG_GROUP_OPEN, IMG_IDNOTE_OPEN, IMG_IDPAR_ADDENDA_OPEN]) then
2807	ImageIndex := ImageIndex - 1;
2808	if (SelectedIndex in [IMG_GROUP_OPEN, IMG_IDNOTE_OPEN, IMG_IDPAR_ADDENDA_OPEN]) then
2809	SelectedIndex := SelectedIndex - 1;
2810	end;
2811	end;
2812
2813	procedure TfrmDCSumm.tvSummsExpanded(Sender: TObject; Node: TTreeNode);
2814
2815	function SortByTitle(Node1, Node2: TTreeNode; Data: Longint): Integer; stdcall;
2816	begin
2817	{ Within an ID parent node, sorts in ascending order by title
2818	BUT - addenda to parent document are always at the top of the sort, in date order}
2819	if (Copy(PDocTreeObject(Node1.Data)^.DocTitle, 1, 8) = 'Addendum') and
2820	(Copy(PDocTreeObject(Node2.Data)^.DocTitle, 1, 8) = 'Addendum') then
2821	begin
2822	Result := AnsiStrIComp(PChar(PDocTreeObject(Node1.Data)^.DocFMDate),
2823	PChar(PDocTreeObject(Node2.Data)^.DocFMDate));
2824	end
2825	else if Copy(PDocTreeObject(Node1.Data)^.DocTitle, 1, 8) = 'Addendum' then Result := -1
2826	else if Copy(PDocTreeObject(Node2.Data)^.DocTitle, 1, 8) = 'Addendum' then Result := 1
2827	else
2828	begin
2829	if Data = 0 then
2830	Result := AnsiStrIComp(PChar(PDocTreeObject(Node1.Data)^.DocTitle),
2831	PChar(PDocTreeObject(Node2.Data)^.DocTitle))
2832	else
2833	Result := -AnsiStrIComp(PChar(PDocTreeObject(Node1.Data)^.DocTitle),
2834	PChar(PDocTreeObject(Node2.Data)^.DocTitle));
2835	end
2836	end;
2837
2838	function SortByDate(Node1, Node2: TTreeNode; Data: Longint): Integer; stdcall;
2839	begin
2840	{ Within an ID parent node, sorts in ascending order by document date
2841	BUT - addenda to parent document are always at the top of the sort, in date order}
2842	if (Copy(PDocTreeObject(Node1.Data)^.DocTitle, 1, 8) = 'Addendum') and
2843	(Copy(PDocTreeObject(Node2.Data)^.DocTitle, 1, 8) = 'Addendum') then
2844	begin
2845	Result := AnsiStrIComp(PChar(PDocTreeObject(Node1.Data)^.DocFMDate),
2846	PChar(PDocTreeObject(Node2.Data)^.DocFMDate));
2847	end
2848	else if Copy(PDocTreeObject(Node1.Data)^.DocTitle, 1, 8) = 'Addendum' then Result := -1
2849	else if Copy(PDocTreeObject(Node2.Data)^.DocTitle, 1, 8) = 'Addendum' then Result := 1
2850	else
2851	begin
2852	if Data = 0 then
2853	Result := AnsiStrIComp(PChar(PDocTreeObject(Node1.Data)^.DocFMDate),
2854	PChar(PDocTreeObject(Node2.Data)^.DocFMDate))
2855	else
2856	Result := -AnsiStrIComp(PChar(PDocTreeObject(Node1.Data)^.DocFMDate),
2857	PChar(PDocTreeObject(Node2.Data)^.DocFMDate));
2858	end;
2859	end;
2860
2861	begin
2862	with Node do
2863	begin
2864	if Assigned(Data) then
2865	if (Pos('<', PDocTreeObject(Data)^.DocHasChildren) > 0) then
2866	begin
2867	if (PDocTreeObject(Node.Data)^.OrderByTitle) then
2868	CustomSort(@SortByTitle, 0)
2869	else
2870	CustomSort(@SortByDate, 0);
2871	end;
2872	if (ImageIndex in [IMG_GROUP_SHUT, IMG_IDNOTE_SHUT, IMG_IDPAR_ADDENDA_SHUT]) then
2873	ImageIndex := ImageIndex + 1;
2874	if (SelectedIndex in [IMG_GROUP_SHUT, IMG_IDNOTE_SHUT, IMG_IDPAR_ADDENDA_SHUT]) then
2875	SelectedIndex := SelectedIndex + 1;
2876	end;
2877	end;
2878
2879	procedure TfrmDCSumm.tvSummsClick(Sender: TObject);
2880	begin
2881	(* if tvSumms.Selected = nil then exit;
2882	if (tvSumms.Selected.ImageIndex in [IMG_TOP_LEVEL, IMG_GROUP_OPEN, IMG_GROUP_SHUT]) then
2883	begin
2884	uChanging := True;
2885	lvSumms.Selected := nil;
2886	uChanging := False;
2887	memSumm.Clear;
2888	end;*)
2889	end;
2890
2891	procedure TfrmDCSumm.tvSummsDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
2892	var
2893	AnItem: TORTreeNode;
2894	begin
2895	Accept := False;
2896	if not uIDNotesActive then exit;
2897	AnItem := TORTreeNode(tvSumms.GetNodeAt(X, Y));
2898	if (AnItem = nil) or (AnItem.ImageIndex in [IMG_GROUP_OPEN, IMG_GROUP_SHUT, IMG_TOP_LEVEL]) then Exit;
2899	with tvSumms.Selected do
2900	if (ImageIndex in [IMG_SINGLE, IMG_PARENT, IMG_ID_CHILD, IMG_ID_CHILD_ADD]) then
2901	Accept := (AnItem.ImageIndex in [IMG_SINGLE, IMG_PARENT,
2902	IMG_IDNOTE_OPEN, IMG_IDNOTE_SHUT,
2903	IMG_IDPAR_ADDENDA_OPEN, IMG_IDPAR_ADDENDA_SHUT])
2904	else if (ImageIndex in [IMG_IDNOTE_OPEN, IMG_IDNOTE_SHUT, IMG_IDPAR_ADDENDA_OPEN, IMG_IDPAR_ADDENDA_SHUT]) then
2905	Accept := (AnItem.ImageIndex in [IMG_GROUP_OPEN, IMG_GROUP_SHUT, IMG_TOP_LEVEL])
2906	else if (ImageIndex in [IMG_ADDENDUM, IMG_GROUP_OPEN, IMG_GROUP_SHUT, IMG_TOP_LEVEL]) then
2907	Accept := False;
2908	end;
2909
2910	procedure TfrmDCSumm.tvSummsDragDrop(Sender, Source: TObject; X, Y: Integer);
2911	var
2912	HT: THitTests;
2913	Saved: boolean;
2914	ADestNode: TORTreeNode;
2915	begin
2916	if not uIDNotesActive then
2917	begin
2918	CancelDrag;
2919	exit;
2920	end;
2921	if tvSumms.Selected = nil then exit;
2922	if EditingIndex <> -1 then
2923	begin
2924	SaveCurrentSumm(Saved);
2925	if not Saved then Exit;
2926	end;
2927	HT := tvSumms.GetHitTestInfoAt(X, Y);
2928	ADestNode := TORTreeNode(tvSumms.GetNodeAt(X, Y));
2929	DoAttachIDChild(TORTreeNode(tvSumms.Selected), ADestNode);
2930	end;
2931
2932	procedure TfrmDCSumm.tvSummsStartDrag(Sender: TObject;
2933	var DragObject: TDragObject);
2934	const
2935	TX_CAP_NO_DRAG = 'Item cannot be moved';
2936	var
2937	WhyNot: string;
2938	Saved: boolean;
2939	begin
2940	if (tvSumms.Selected.ImageIndex in [IMG_ADDENDUM, IMG_GROUP_OPEN, IMG_GROUP_SHUT, IMG_TOP_LEVEL]) or
2941	(not uIDNotesActive) or
2942	(lstSumms.ItemIEN = 0) then
2943	begin
2944	CancelDrag;
2945	Exit;
2946	end;
2947	if EditingIndex <> -1 then
2948	begin
2949	SaveCurrentSumm(Saved);
2950	if not Saved then Exit;
2951	end;
2952	if not CanBeAttached(PDocTreeObject(tvSumms.Selected.Data)^.DocID, WhyNot) then
2953	begin
2954	InfoBox(WhyNot, TX_CAP_NO_DRAG, MB_OK);
2955	CancelDrag;
2956	end;
2957	end;
2958
2959	procedure TfrmDCSumm.lvSummsColumnClick(Sender: TObject; Column: TListColumn);
2960	var
2961	i, ClickedColumn: Integer;
2962	begin
2963	if Column.Index = 0 then ClickedColumn := 5 else ClickedColumn := Column.Index;
2964	if ClickedColumn = ColumnToSort then
2965	ColumnSortForward := not ColumnSortForward
2966	else
2967	ColumnSortForward := True;
2968	for i := 0 to lvSumms.Columns.Count - 1 do
2969	lvSumms.Columns[i].ImageIndex := IMG_NONE;
2970	if ColumnSortForward then lvSumms.Columns[Column.Index].ImageIndex := IMG_ASCENDING
2971	else lvSumms.Columns[Column.Index].ImageIndex := IMG_DESCENDING;
2972	ColumnToSort := ClickedColumn;
2973	case ColumnToSort of
2974	5: FCurrentContext.SortBy := 'R';
2975	1: FCurrentContext.SortBy := 'D';
2976	2: FCurrentContext.SortBy := 'S';
2977	3: FCurrentContext.SortBy := 'A';
2978	4: FCurrentContext.SortBy := 'L';
2979	else
2980	FCurrentContext.SortBy := 'R';
2981	end;
2982	FCurrentContext.ListAscending := ColumnSortForward;
2983	(Sender as TCustomListView).AlphaSort;
2984	//with lvSumms do if Selected <> nil then Scroll(0, Selected.Top - TopItem.Top);
2985	end;
2986
2987	procedure TfrmDCSumm.lvSummsCompare(Sender: TObject; Item1, Item2: TListItem; Data: Integer; var Compare: Integer);
2988	var
2989	ix: Integer;
2990	begin
2991	if ColumnToSort = 0 then
2992	Compare := CompareText(Item1.Caption,Item2.Caption)
2993	else begin
2994	ix := ColumnToSort - 1;
2995	Compare := CompareText(Item1.SubItems[ix],Item2.SubItems[ix]);
2996	end;
2997	if not ColumnSortForward then Compare := -Compare;
2998	end;
2999
3000	procedure TfrmDCSumm.lvSummsSelectItem(Sender: TObject; Item: TListItem;
3001	Selected: Boolean);
3002	begin
3003	if uChanging or (not Selected) then Exit;
3004	with lvSumms do
3005	begin
3006	StatusText('Retrieving selected discharge summary...');
3007	lstSumms.SelectByID(Item.SubItems[5]);
3008	lstSummsClick(Self);
3009	SendMessage(memSumm.Handle, WM_VSCROLL, SB_TOP, 0);
3010	end;
3011	end;
3012
3013	procedure TfrmDCSumm.lvSummsResize(Sender: TObject);
3014	begin
3015	inherited;
3016	with lvSumms do
3017	begin
3018	if not FCurrentContext.ShowSubject then
3019	begin
3020	Columns[1].Width := 2 * (Width div 5);
3021	Columns[2].Width := 0;
3022	end
3023	else
3024	begin
3025	Columns[1].Width := Width div 5;
3026	Columns[2].Width := Columns[1].Width;
3027	end;
3028	end;
3029	end;
3030
3031	procedure TfrmDCSumm.EnableDisableIDNotes;
3032	begin
3033	uIDNotesActive := False; // := IDNotesInstalled; Not yet on this tab
3034	mnuActDetachFromIDParent.Visible := uIDNotesActive;
3035	popSummListDetachFromIDParent.Visible := uIDNotesActive;
3036	mnuActAddIDEntry.Visible := uIDNotesActive;
3037	popSummListAddIDEntry.Visible := uIDNotesActive;
3038	mnuActAttachtoIDParent.Visible := uIDNotesActive;
3039	popSummListAttachtoIDParent.Visible := uIDNotesActive;
3040	if uIDNotesActive then
3041	tvSumms.DragMode := dmAutomatic
3042	else
3043	tvSumms.DragMode := dmManual;
3044	end;
3045
3046	procedure TfrmDCSumm.mnuIconLegendClick(Sender: TObject);
3047	begin
3048	inherited;
3049	ShowIconLegend(ilNotes);
3050	end;
3051
3052	procedure TfrmDCSumm.mnuActAttachtoIDParentClick(Sender: TObject);
3053	var
3054	AChildNode: TORTreeNode;
3055	AParentID: string;
3056	SavedDocID: string;
3057	Saved: boolean;
3058	begin
3059	inherited;
3060	if not uIDNotesActive then exit;
3061	if lstSumms.ItemIEN = 0 then exit;
3062	SavedDocID := lstSumms.ItemID;
3063	if EditingIndex <> -1 then
3064	begin
3065	SaveCurrentSumm(Saved);
3066	if not Saved then Exit;
3067	LoadSumms;
3068	with tvSumms do Selected := FindPieceNode(SavedDocID, U, Items.GetFirstNode);
3069	end;
3070	if tvSumms.Selected = nil then exit;
3071	AChildNode := TORTreeNode(tvSumms.Selected);
3072	AParentID := SelectParentNodeFromList(tvSumms);
3073	if AParentID = '' then exit;
3074	with tvSumms do Selected := FindPieceNode(AParentID, 1, U, Items.GetFirstNode);
3075	DoAttachIDChild(AChildNode, TORTreeNode(tvSumms.Selected));
3076	end;
3077
3078	procedure TfrmDCSumm.DoAttachIDChild(AChild, AParent: TORTreeNode);
3079	const
3080	TX_ATTACH_CNF = 'Confirm Attachment';
3081	TX_ATTACH_FAILURE = 'Attachment failed';
3082	var
3083	ErrMsg, WhyNot: string;
3084	SavedDocID: string;
3085	begin
3086	if (AChild = nil) or (AParent = nil) then exit;
3087	ErrMsg := '';
3088	if not CanBeAttached(PDocTreeObject(AChild.Data)^.DocID, WhyNot) then
3089	ErrMsg := ErrMsg + WhyNot + CRLF + CRLF;
3090	if not CanReceiveAttachment(PDocTreeObject(AParent.Data)^.DocID, WhyNot) then
3091	ErrMsg := ErrMsg + WhyNot;
3092	if ErrMsg <> '' then
3093	begin
3094	InfoBox(ErrMsg, TX_ATTACH_FAILURE, MB_OK);
3095	Exit;
3096	end
3097	else
3098	begin
3099	WhyNot := '';
3100	if (InfoBox('ATTACH: ' + AChild.Text + CRLF + CRLF +
3101	' TO: ' + AParent.Text + CRLF + CRLF +
3102	'Are you sure?', TX_ATTACH_CNF, MB_YESNO or MB_DEFBUTTON2 or MB_ICONQUESTION) <> IDYES)
3103	then Exit;
3104	SavedDocID := PDocTreeObject(AParent.Data)^.DocID;
3105	end;
3106	if AChild.ImageIndex in [IMG_ID_CHILD, IMG_ID_CHILD_ADD] then
3107	begin
3108	if DetachEntryFromParent(PDocTreeObject(AChild.Data)^.DocID, WhyNot) then
3109	begin
3110	if AttachEntryToParent(PDocTreeObject(AChild.Data)^.DocID, PDocTreeObject(AParent.Data)^.DocID, WhyNot) then
3111	begin
3112	LoadSumms;
3113	with tvSumms do Selected := FindPieceNode(SavedDocID, U, Items.GetFirstNode);
3114	if tvSumms.Selected <> nil then tvSumms.Selected.Expand(False);
3115	end
3116	else
3117	InfoBox(WhyNot, TX_ATTACH_FAILURE, MB_OK);
3118	end
3119	else
3120	begin
3121	WhyNot := StringReplace(WhyNot, 'ATTACH', 'DETACH', [rfIgnoreCase]);
3122	WhyNot := StringReplace(WhyNot, 'to an ID', 'from an ID', [rfIgnoreCase]);
3123	InfoBox(WhyNot, TX_DETACH_FAILURE, MB_OK);
3124	Exit;
3125	end;
3126	end
3127	else
3128	begin
3129	if AttachEntryToParent(PDocTreeObject(AChild.Data)^.DocID, PDocTreeObject(AParent.Data)^.DocID, WhyNot) then
3130	begin
3131	LoadSumms;
3132	with tvSumms do Selected := FindPieceNode(SavedDocID, U, Items.GetFirstNode);
3133	if tvSumms.Selected <> nil then tvSumms.Selected.Expand(False);
3134	end
3135	else
3136	InfoBox(WhyNot, TX_ATTACH_FAILURE, MB_OK);
3137	end;
3138	end;
3139
3140	function TfrmDCSumm.SetSummTreeLabel(AContext: TTIUContext): string;
3141	var
3142	x: string;
3143
3144	function SetDateRangeText(AContext: TTIUContext): string;
3145	var
3146	x1: string;
3147	begin
3148	with AContext do
3149	if BeginDate <> '' then
3150	begin
3151	x1 := ' from ' + UpperCase(BeginDate);
3152	if EndDate <> '' then x1 := x1 + ' to ' + UpperCase(EndDate)
3153	else x1 := x1 + ' to TODAY';
3154	end;
3155	Result := x1;
3156	end;
3157
3158	begin
3159	with AContext do
3160	begin
3161	if MaxDocs > 0 then x := 'Last ' + IntToStr(MaxDocs) + ' ' else x := 'All ';
3162	case StrToIntDef(Status, 0) of
3163	NC_ALL : x := x + 'Signed Summaries';
3164	NC_UNSIGNED : begin
3165	x := x + 'Unsigned Summaries for ';
3166	if Author > 0 then x := x + ExternalName(Author, 200)
3167	else x := x + User.Name;
3168	x := x + SetDateRangeText(AContext);
3169	end;
3170	NC_UNCOSIGNED : begin
3171	x := x + 'Uncosigned Summaries for ';
3172	if Author > 0 then x := x + ExternalName(Author, 200)
3173	else x := x + User.Name;
3174	x := x + SetDateRangeText(AContext);
3175	end;
3176	NC_BY_AUTHOR : x := x + 'Signed Summaries for ' + ExternalName(Author, 200) + SetDateRangeText(AContext);
3177	NC_BY_DATE : x := x + 'Signed Summaries ' + SetDateRangeText(AContext);
3178	else
3179	x := 'Custom List';
3180	end;
3181	end;
3182	Result := x;
3183	end;
3184
3185	procedure TfrmDCSumm.memNewSummKeyUp(Sender: TObject; var Key: Word;
3186	Shift: TShiftState);
3187	begin
3188	inherited;
3189	if (Key = VK_TAB) then
3190	begin
3191	if ssShift in Shift then
3192	begin
3193	FindNextControl(Sender as TWinControl, False, True, False).SetFocus; //previous control
3194	Key := 0;
3195	end
3196	else if ssCtrl in Shift then
3197	begin
3198	FindNextControl(Sender as TWinControl, True, True, False).SetFocus; //next control
3199	Key := 0;
3200	end;
3201	end;
3202	if (key = VK_ESCAPE) then begin
3203	FindNextControl(Sender as TWinControl, False, True, False).SetFocus; //previous control
3204	key := 0;
3205	end;
3206	end;
3207
3208	procedure TfrmDCSumm.sptHorzCanResize(Sender: TObject; var NewSize: Integer;
3209	var Accept: Boolean);
3210	begin
3211	inherited;
3212	if pnlWrite.Visible then
3213	if NewSize > frmDCSumm.ClientWidth - memNewSumm.Constraints.MinWidth - sptHorz.Width then
3214	NewSize := frmDCSumm.ClientWidth - memNewSumm.Constraints.MinWidth - sptHorz.Width;
3215	end;
3216
3217	procedure TfrmDCSumm.popSummMemoPreviewClick(Sender: TObject);
3218	begin
3219	frmDrawers.mnuPreviewTemplateClick(Sender);
3220	end;
3221
3222	procedure TfrmDCSumm.popSummMemoInsTemplateClick(Sender: TObject);
3223	begin
3224	frmDrawers.mnuInsertTemplateClick(Sender);
3225	end;
3226
3227
3228	{Returns True & Displays a Message if Currently No D/C Summary is Selected,
3229	Otherwise returns false and does not display a message.}
3230	function TfrmDCSumm.NoSummSelected: Boolean;
3231	begin
3232	if lstSumms.ItemIEN <= 0 then
3233	begin
3234	InfoBox(TX_NOSUMM,TX_NOSUMM_CAP,MB_OK or MB_ICONWARNING);
3235	Result := true;
3236	end
3237	else
3238	Result := false;
3239	end;
3240
3241	procedure TfrmDCSumm.ViewInfo(Sender: TObject);
3242	begin
3243	inherited;
3244	frmFrame.ViewInfo(Sender);
3245	end;
3246
3247	procedure TfrmDCSumm.mnuViewInformationClick(Sender: TObject);
3248	begin
3249	inherited;
3250	mnuViewDemo.Enabled := frmFrame.pnlPatient.Enabled;
3251	mnuViewVisits.Enabled := frmFrame.pnlVisit.Enabled;
3252	mnuViewPrimaryCare.Enabled := frmFrame.pnlPrimaryCare.Enabled;
3253	mnuViewMyHealtheVet.Enabled := not (Copy(frmFrame.laMHV.Hint, 1, 2) = 'No');
3254	mnuInsurance.Enabled := not (Copy(frmFrame.laVAA2.Hint, 1, 2) = 'No');
3255	mnuViewFlags.Enabled := frmFrame.lblFlag.Enabled;
3256	mnuViewRemoteData.Enabled := frmFrame.lblCirn.Enabled;
3257	mnuViewReminders.Enabled := frmFrame.pnlReminders.Enabled;
3258	mnuViewPostings.Enabled := frmFrame.pnlPostings.Enabled;
3259	end;
3260
3261	initialization
3262	SpecifyFormIsNotADialog(TfrmDCSumm);
3263	uPCEEdit := TPCEData.Create;
3264	uPCEShow := TPCEData.Create;
3265
3266	finalization
3267	uPCEEdit.Free;
3268	uPCEShow.Free;
3269
3270	end.

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

Download in other formats: