Context Navigation

fDCSumm.pas@ 1727

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

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

Context Navigation

source: cprs/branches/HealthSevak-CPRS/CPRS-Chart/fDCSumm.pas@ 1727

Download in other formats: