Context Navigation

fDCSumm.pas@ 1715

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

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

Context Navigation

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

Download in other formats: