Context Navigation

source: cprs/branches/HealthSevak-CPRS/CPRS-Chart/Consults/fConsults.pas@ 1679

Last change on this file since 1679 was 829, checked in by Kevin Toppenberg, 14 years ago
Upgrade to version 27
File size: 176.8 KB

Line
1	unit fConsults;
2	{Notes of Intent:
3	Tab Order:
4	The tab order has been custom coded to place the pnlRight in the Tab order
5	right after the tvConsults.
6	}
7
8	interface
9
10	uses
11	Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ORDtTm,
12	fHSplit, stdCtrls, ExtCtrls, Menus, ComCtrls, ORCtrls, ORFn, uConsults, rOrders, uPCE,
13	ORClasses, uConst, fDrawers, rTIU, uTIU, uDocTree, RichEdit, fPrintList,
14	VA508AccessibilityManager, fBase508Form, VA508ImageListLabeler;
15
16	type
17	TfrmConsults = class(TfrmHSplit)
18	mnuConsults: TMainMenu;
19	mnuView: TMenuItem;
20	mnuViewChart: TMenuItem;
21	mnuChartReports: TMenuItem;
22	mnuChartLabs: TMenuItem;
23	mnuChartDCSumm: TMenuItem;
24	mnuChartCslts: TMenuItem;
25	mnuChartNotes: TMenuItem;
26	mnuChartOrders: TMenuItem;
27	mnuChartMeds: TMenuItem;
28	mnuChartProbs: TMenuItem;
29	mnuChartCover: TMenuItem;
30	mnuAct: TMenuItem;
31	Z2: TMenuItem;
32	pnlRead: TPanel;
33	lblTitle: TOROffsetLabel;
34	memConsult: TRichEdit;
35	pnlAction: TPanel;
36	cmdNewConsult: TORAlignButton;
37	Z3: TMenuItem;
38	mnuViewAll: TMenuItem;
39	mnuViewByService: TMenuItem;
40	mnuViewByDate: TMenuItem;
41	mnuViewByStatus: TMenuItem;
42	cmdNewProc: TORAlignButton;
43	N1: TMenuItem;
44	mnuActConsultRequest: TMenuItem;
45	mnuActReceive: TMenuItem;
46	mnuActDeny: TMenuItem;
47	mnuActForward: TMenuItem;
48	mnuActDiscontinue: TMenuItem;
49	mnuActAddComment: TMenuItem;
50	mnuActComplete: TMenuItem;
51	mnuActNew: TMenuItem;
52	mnuActNewConsultRequest: TMenuItem;
53	mnuActNewProcedure: TMenuItem;
54	mnuActSignatureList: TMenuItem;
55	mnuActSignatureSave: TMenuItem;
56	mnuActSignatureSign: TMenuItem;
57	mnuActMakeAddendum: TMenuItem;
58	mnuViewCustom: TMenuItem;
59	pnlResults: TPanel;
60	memResults: TRichEdit;
61	mnuActNoteEdit: TMenuItem;
62	mnuActNoteDelete: TMenuItem;
63	sptVert: TSplitter;
64	memPCEShow: TRichEdit;
65	cmdEditResubmit: TORAlignButton;
66	cmdPCE: TORAlignButton;
67	mnuActConsultResults: TMenuItem;
68	N2: TMenuItem;
69	lstNotes: TORListBox;
70	popNoteMemo: TPopupMenu;
71	popNoteMemoCut: TMenuItem;
72	popNoteMemoCopy: TMenuItem;
73	popNoteMemoPaste: TMenuItem;
74	Z10: TMenuItem;
75	popNoteMemoSignList: TMenuItem;
76	popNoteMemoDelete: TMenuItem;
77	popNoteMemoEdit: TMenuItem;
78	popNoteMemoSave: TMenuItem;
79	popNoteMemoSign: TMenuItem;
80	popConsultList: TPopupMenu;
81	popConsultAll: TMenuItem;
82	popConsultStatus: TMenuItem;
83	popConsultService: TMenuItem;
84	popConsultDates: TMenuItem;
85	popConsultCustom: TMenuItem;
86	mnuActPrintSF513: TMenuItem;
87	N3: TMenuItem;
88	mnuActDisplayDetails: TMenuItem;
89	mnuActDisplayResults: TMenuItem;
90	mnuActDisplaySF513: TMenuItem;
91	mnuActSigFindings: TMenuItem;
92	mnuActAdminComplete: TMenuItem;
93	mnuActIdentifyAddlSigners: TMenuItem;
94	popNoteMemoAddlSign: TMenuItem;
95	Z11: TMenuItem;
96	popNoteMemoSpell: TMenuItem;
97	popNoteMemoGrammar: TMenuItem;
98	mnuActEditResubmit: TMenuItem;
99	N4: TMenuItem;
100	mnuViewSaveAsDefault: TMenuItem;
101	mnuViewReturntoDefault: TMenuItem;
102	splDrawers: TSplitter;
103	N5: TMenuItem;
104	popNoteMemoTemplate: TMenuItem;
105	mnuOptions: TMenuItem;
106	mnuEditTemplates: TMenuItem;
107	mnuNewTemplate: TMenuItem;
108	splConsults: TSplitter;
109	pnlConsultList: TPanel;
110	lblConsults: TOROffsetLabel;
111	lstConsults: TORListBox;
112	N6: TMenuItem;
113	mnuEditSharedTemplates: TMenuItem;
114	mnuNewSharedTemplate: TMenuItem;
115	popNoteMemoPrint: TMenuItem;
116	N7: TMenuItem;
117	N8: TMenuItem;
118	mnuActNotePrint: TMenuItem;
119	timAutoSave: TTimer;
120	pnlFields: TPanel;
121	lblNewTitle: TStaticText;
122	lblRefDate: TStaticText;
123	lblAuthor: TStaticText;
124	lblVisit: TStaticText;
125	lblCosigner: TStaticText;
126	lblSubject: TStaticText;
127	cmdChange: TButton;
128	txtSubject: TCaptionEdit;
129	mnuActSchedule: TMenuItem;
130	popNoteMemoPaste2: TMenuItem;
131	popNoteMemoReformat: TMenuItem;
132	N9: TMenuItem;
133	mnuActChange: TMenuItem;
134	mnuActLoadBoiler: TMenuItem;
135	bvlNewTitle: TBevel;
136	popNoteMemoSaveContinue: TMenuItem;
137	mnuActAttachMed: TMenuItem;
138	mnuActRemoveMed: TMenuItem;
139	N10: TMenuItem;
140	mnuEditDialgFields: TMenuItem;
141	tvCsltNotes: TORTreeView;
142	popNoteList: TPopupMenu;
143	popNoteListExpandSelected: TMenuItem;
144	popNoteListExpandAll: TMenuItem;
145	popNoteListCollapseSelected: TMenuItem;
146	popNoteListCollapseAll: TMenuItem;
147	N11: TMenuItem;
148	popNoteListDetachFromIDParent: TMenuItem;
149	N12: TMenuItem;
150	mnuActDetachFromIDParent: TMenuItem;
151	mnuActAddIDEntry: TMenuItem;
152	tvConsults: TORTreeView;
153	popNoteListAddIDEntry: TMenuItem;
154	N13: TMenuItem;
155	mnuIconLegend: TMenuItem;
156	dlgFindText: TFindDialog;
157	popNoteMemoFind: TMenuItem;
158	dlgReplaceText: TReplaceDialog;
159	N14: TMenuItem;
160	popNoteMemoReplace: TMenuItem;
161	mnuChartSurgery: TMenuItem;
162	mnuActAttachtoIDParent: TMenuItem;
163	popNoteListAttachtoIDParent: TMenuItem;
164	popNoteMemoAddend: TMenuItem;
165	N15: TMenuItem;
166	popNoteMemoPreview: TMenuItem;
167	popNoteMemoInsTemplate: TMenuItem;
168	popNoteMemoEncounter: TMenuItem;
169	mnuViewInformation: TMenuItem;
170	mnuViewDemo: TMenuItem;
171	mnuViewVisits: TMenuItem;
172	mnuViewPrimaryCare: TMenuItem;
173	mnuViewMyHealtheVet: TMenuItem;
174	mnuInsurance: TMenuItem;
175	mnuViewFlags: TMenuItem;
176	mnuViewReminders: TMenuItem;
177	mnuViewRemoteData: TMenuItem;
178	mnuViewPostings: TMenuItem;
179	imgLblNotes: TVA508ImageListLabeler;
180	imgLblImages: TVA508ImageListLabeler;
181	imgLblConsults: TVA508ImageListLabeler;
182	procedure mnuChartTabClick(Sender: TObject);
183	procedure lstConsultsClick(Sender: TObject);
184	procedure pnlRightResize(Sender: TObject);
185	procedure cmdNewConsultClick(Sender: TObject);
186	procedure memResultChange(Sender: TObject);
187	procedure mnuActCompleteClick(Sender: TObject);
188	procedure mnuActAddIDEntryClick(Sender: TObject);
189	procedure mnuActSignatureSaveClick(Sender: TObject);
190	procedure mnuViewClick(Sender: TObject);
191	procedure mnuActSignatureListClick(Sender: TObject);
192	procedure mnuActSignatureSignClick(Sender: TObject);
193	procedure mnuActMakeAddendumClick(Sender: TObject);
194	procedure mnuActDetachFromIDParentClick(Sender: TObject);
195	procedure mnuActAttachtoIDParentClick(Sender: TObject);
196	procedure cmdPCEClick(Sender: TObject);
197	procedure mnuActConsultClick(Sender: TObject);
198	procedure mnuActNewConsultRequestClick(Sender: TObject);
199	procedure mnuActNoteEditClick(Sender: TObject);
200	procedure mnuActNoteDeleteClick(Sender: TObject);
201	procedure lstNotesClick(Sender: TObject);
202	procedure popNoteMemoCutClick(Sender: TObject);
203	procedure popNoteMemoCopyClick(Sender: TObject);
204	procedure popNoteMemoPasteClick(Sender: TObject);
205	procedure popNoteMemoPopup(Sender: TObject);
206	procedure NewPersonNeedData(Sender: TObject; const StartFrom: string;
207	Direction, InsertAt: Integer);
208	procedure cmdNewProcClick(Sender: TObject);
209	procedure mnuActNewProcedureClick(Sender: TObject);
210	procedure mnuActDisplayResultsClick(Sender: TObject);
211	procedure mnuActDisplaySF513Click(Sender: TObject);
212	procedure pnlResultsResize(Sender: TObject);
213	procedure mnuActPrintSF513Click(Sender: TObject);
214	procedure FormCreate(Sender: TObject);
215	procedure mnuActDisplayDetailsClick(Sender: TObject);
216	procedure FormClose(Sender: TObject; var Action: TCloseAction);
217	procedure mnuActIdentifyAddlSignersClick(Sender: TObject);
218	procedure popNoteMemoAddlSignClick(Sender: TObject);
219	procedure mnuActEditResubmitClick(Sender: TObject);
220	procedure EnableDisableOrdering;
221	procedure cmdEditResubmitClick(Sender: TObject);
222	procedure popNoteMemoSpellClick(Sender: TObject);
223	procedure popNoteMemoGrammarClick(Sender: TObject);
224	procedure mnuViewSaveAsDefaultClick(Sender: TObject);
225	procedure mnuViewReturntoDefaultClick(Sender: TObject);
226	procedure popNoteMemoTemplateClick(Sender: TObject);
227	procedure mnuEditTemplatesClick(Sender: TObject);
228	procedure mnuNewTemplateClick(Sender: TObject);
229	procedure pnlLeftResize(Sender: TObject);
230	procedure mnuOptionsClick(Sender: TObject);
231	procedure mnuEditSharedTemplatesClick(Sender: TObject);
232	procedure mnuNewSharedTemplateClick(Sender: TObject);
233	procedure popNoteMemoPrintClick(Sender: TObject);
234	procedure mnuActNotePrintClick(Sender: TObject);
235	procedure FormDestroy(Sender: TObject);
236	procedure timAutoSaveTimer(Sender: TObject);
237	procedure cmdChangeClick(Sender: TObject);
238	procedure pnlFieldsResize(Sender: TObject);
239	procedure popNoteMemoReformatClick(Sender: TObject);
240	procedure mnuActChangeClick(Sender: TObject);
241	procedure mnuActLoadBoilerClick(Sender: TObject);
242	procedure popNoteMemoSaveContinueClick(Sender: TObject);
243	procedure ProcessMedResults(ActionType: string);
244	procedure mnuActAttachMedClick(Sender: TObject);
245	procedure mnuActRemoveMedClick(Sender: TObject);
246	procedure mnuEditDialgFieldsClick(Sender: TObject);
247	procedure tvCsltNotesChange(Sender: TObject; Node: TTreeNode);
248	procedure tvCsltNotesCollapsed(Sender: TObject; Node: TTreeNode);
249	procedure tvCsltNotesExpanded(Sender: TObject; Node: TTreeNode);
250	procedure tvCsltNotesStartDrag(Sender: TObject;
251	var DragObject: TDragObject);
252	procedure tvCsltNotesDragDrop(Sender, Source: TObject; X, Y: Integer);
253	procedure tvCsltNotesDragOver(Sender, Source: TObject; X, Y: Integer;
254	State: TDragState; var Accept: Boolean);
255	procedure popNoteListExpandSelectedClick(Sender: TObject);
256	procedure popNoteListExpandAllClick(Sender: TObject);
257	procedure popNoteListCollapseSelectedClick(Sender: TObject);
258	procedure popNoteListCollapseAllClick(Sender: TObject);
259	procedure tvCsltNotesClick(Sender: TObject);
260	procedure tvConsultsExpanded(Sender: TObject; Node: TTreeNode);
261	procedure tvConsultsCollapsed(Sender: TObject; Node: TTreeNode);
262	procedure tvConsultsClick(Sender: TObject);
263	procedure tvConsultsChange(Sender: TObject; Node: TTreeNode);
264	procedure popNoteListPopup(Sender: TObject);
265	procedure mnuIconLegendClick(Sender: TObject);
266	procedure popNoteMemoFindClick(Sender: TObject);
267	procedure dlgFindTextFind(Sender: TObject);
268	procedure dlgReplaceTextFind(Sender: TObject);
269	procedure dlgReplaceTextReplace(Sender: TObject);
270	procedure popNoteMemoReplaceClick(Sender: TObject);
271	procedure tvConsultsKeyUp(Sender: TObject; var Key: Word;
272	Shift: TShiftState);
273	procedure memResultsKeyDown(Sender: TObject; var Key: Word;
274	Shift: TShiftState);
275	procedure sptHorzCanResize(Sender: TObject; var NewSize: Integer; var Accept: Boolean);
276	procedure popNoteMemoPreviewClick(Sender: TObject);
277	procedure popNoteMemoInsTemplateClick(Sender: TObject);
278	procedure tvConsultsExit(Sender: TObject);
279	procedure FormHide(Sender: TObject);
280	procedure FormShow(Sender: TObject);
281	procedure ViewInfo(Sender: TObject);
282	procedure mnuViewInformationClick(Sender: TObject);
283	procedure pnlLeftExit(Sender: TObject);
284	procedure pnlRightExit(Sender: TObject);
285	procedure cmdEditResubmitExit(Sender: TObject);
286	procedure cmdNewConsultExit(Sender: TObject);
287	private
288	FocusToRightPanel : Boolean;
289	FEditingIndex: Integer; // TIU index of document being currently edited
290	FChanged: Boolean;
291	FActionType: integer ;
292	FEditCtrl: TCustomEdit;
293	FSilent: Boolean;
294	FCurrentContext: TSelectContext;
295	FDefaultContext: TSelectContext;
296	FCurrentNoteContext: TTIUContext;
297	FOrderID: string;
298	FImageFlag: TBitmap;
299	FEditNote: TEditNoteRec;
300	FVerifyNoteTitle: Integer;
301	FDocList: TStringList;
302	FConfirmed: boolean;
303	FCsltList: TStringList;
304	FDeleted: boolean;
305	FLastNoteID: string;
306	FcmdChangeOKPressed: boolean;
307	FNotifPending: boolean;
308	FOldFramePnlPatientExit: TNotifyEvent;
309	//FMousing: TDateTime;
310	procedure DoLeftPanelCustomShiftTab;
311	procedure frmFramePnlPatientExit(Sender: TObject);
312	procedure DoAutoSave(Suppress: integer = 1);
313	function GetTitleText(AnIndex: Integer): string;
314	//function MakeTitleText(IsAddendum: Boolean = False): string;
315	procedure ClearEditControls;
316	procedure LoadForEdit ;
317	function LacksRequiredForCreate: Boolean;
318	function LacksClinProcFields(AnEditRec: TEditNoteRec; AMenuAccessRec: TMenuAccessRec; var ErrMsg: string): boolean;
319	function LacksClinProcFieldsForSignature(NoteIEN: int64; var ErrMsg: string): boolean;
320	procedure UpdateList;
321	procedure DisplayPCE;
322	procedure CompleteConsult(IsIDChild: boolean; AnIDParent: integer; UseClinProcTitles: boolean);
323	procedure InsertAddendum;
324	procedure SetSubjectVisible(ShouldShow: Boolean);
325	procedure SaveCurrentNote(var Saved: Boolean);
326	procedure SaveEditedConsult(var Saved: Boolean);
327	procedure SetEditingIndex(const Value: Integer);
328	procedure ShowPCEControls(ShouldShow: Boolean);
329	procedure SetActionMenus ;
330	procedure SetResultMenus ;
331	procedure RemovePCEFromChanges(IEN: Integer; AVisitStr: string = '');
332	procedure ProcessNotifications;
333	procedure UMNewOrder(var Message: TMessage); message UM_NEWORDER;
334	procedure SetViewContext(AContext: TSelectContext);
335	function GetDrawers: TFrmDrawers;
336	function LockConsultRequest(AConsult: Integer): Boolean;
337	function LockConsultRequestAndNote(AnIEN: Int64): Boolean;
338	function StartNewEdit(NewNoteType: integer): Boolean;
339	procedure UnlockConsultRequest(ANote: Int64; AConsult: Integer = 0);
340	function CanFinishReminder: boolean;
341	property EditingIndex: Integer read FEditingIndex write SetEditingIndex;
342	function VerifyNoteTitle: Boolean;
343	procedure UpdateNoteTreeView(DocList: TStringList; Tree: TORTreeView; AContext: integer);
344	procedure EnableDisableIDNotes;
345	procedure LoadConsults;
346	procedure UpdateConsultsTreeView(DocList: TStringList; Tree: TORTreeView);
347	procedure DoAttachIDChild(AChild, AParent: TORTreeNode);
348	function UserIsSigner(NoteIEN: integer): boolean;
349	public
350	function ActiveEditOf(AnIEN: Int64): Boolean;
351	function AllowContextChange(var WhyNot: string): Boolean; override;
352	procedure ClearPtData; override;
353	procedure DisplayPage; override;
354	procedure SetFontSize(NewFontSize: Integer); override;
355	procedure SaveSignItem(const ItemID, ESCode: string);
356	procedure RequestPrint; override;
357	procedure RequestMultiplePrint(AForm: TfrmPrintList);
358	procedure NotifyOrder(OrderAction: Integer; AnOrder: TOrder); override;
359	function AuthorizedUser: Boolean;
360	procedure AssignRemForm;
361	property OrderID: string read FOrderID;
362	procedure LstConsultsToPrint;
363	published
364	property Drawers: TFrmDrawers read GetDrawers; // Keep Drawers published
365	end;
366
367	var
368	frmConsults: TfrmConsults;
369
370	const
371	CN_ACT_RECEIVE = 1 ;
372	CN_ACT_DENY = 2 ;
373	CN_ACT_DISCONTINUE = 3 ;
374	CN_ACT_FORWARD = 4 ;
375	CN_ACT_ADD_CMT = 5 ;
376	CN_ACT_COMPLETE = 6 ;
377	CN_ACT_ADDENDUM = 7 ;
378	CN_ACT_SIGFIND = 8 ;
379	CN_ACT_ADMIN_COMPLETE = 9 ;
380	CN_ACT_SCHEDULE = 10;
381	CN_ACT_CP_COMPLETE = 11;
382
383	ActionType: array[1..11] of string = ('Receive Consult','Cancel (Deny) Consult',
384	'Discontinue Consult','Forward Consult','Add Comment to Consult',
385	'Complete Consult', 'Make Addendum to Consult', 'Update Significant Findings',
386	'Administratively Complete', 'Schedule Consult', 'Complete Clinical Procedure') ;
387
388	implementation
389
390	{$R *.DFM}
391
392	uses fVisit, rCore, uCore, rConsults, fConsultBS, fConsultBD, fSignItem,
393	fConsultBSt, fConsultsView, fConsultAct, fEncnt, rPCE, fEncounterFrame,
394	Clipbrd, rReports, fRptBox, fConsult513Prt, fODConsult, fODProc, fCsltNote, fAddlSigners,
395	fOrders, rVitals, fFrame, fNoteDR, fEditProc, fEditConsult, uOrders, rODBase, uSpell, {KCM}
396	fTemplateEditor, fNotePrt, fNotes, fNoteProps, fNotesBP, fReminderTree,
397	fReminderDialog, uReminders, fConsMedRslt, fTemplateFieldEditor,
398	dShared, rTemplates, fIconLegend, fNoteIDParents, fNoteCPFields,
399	uTemplates, fTemplateDialog, DateUtils, uVA508CPRSCompatibility, VA508AccessibilityRouter;
400
401	const
402	CT_ORDERS = 4; // ID for orders tab used by frmFrame
403	EF_VISIT_TYPE = 10;
404	EF_VITALS = 200;
405	EF_DIAGNOSES = 20;
406	EF_PROCEDURES = 30;
407	EF_ORDERS = 100;
408
409	CA_CREATE = 0; // create new consult result
410	CA_SHOW = 1; // show current note
411	CA_SAVECREATE = 2; // save current then create
412	CA_EDIT = 3; // save current note, then edit an existing note
413	CA_SAVEEDIT = 4;
414
415	CN_NEW_RESULT = -30; // Holder IEN for a new Consult Result
416	CN_ADDENDUM = -40; // Holder IEN for a new addendum
417
418	NT_ACT_NEW_NOTE = 2;
419	NT_ACT_ADDENDUM = 3;
420	NT_ACT_EDIT_NOTE = 4;
421	NT_ACT_ID_ENTRY = 5;
422
423	ST_DISCONTINUED = 1 ;
424	ST_COMPLETE = 2 ;
425	ST_HOLD = 3 ;
426	ST_FLAGGED = 4 ;
427	ST_PENDING = 5 ;
428	ST_ACTIVE = 6 ;
429	ST_EXPIRED = 7 ;
430	ST_SCHEDULED = 8 ;
431	ST_PARTIAL_RESULTS = 9 ;
432	ST_DELAYED = 10 ;
433	ST_UNRELEASED = 11 ;
434	ST_CHANGED = 12 ;
435	ST_CANCELLED = 13 ;
436	ST_LAPSED = 14 ;
437	ST_RENEWED = 15 ;
438	ST_NO_STATUS = 99 ;
439
440	TYP_PROGRESS_NOTE = 3;
441	TYP_ADDENDUM = 81;
442	TX_PROV_LOC = 'A provider and location must be selected before entering orders.';
443	TC_PROV_LOC = 'Incomplete Information';
444
445	TX_NEED_VISIT = 'A visit is required before creating a new consult result.';
446	TX_NO_VISIT = 'Insufficient Visit Information';
447	TX_BOILERPLT = 'You have modified the text of this note. Changing the title will' +
448	' discard the note text.' + CRLF + 'Do you wish to continue?';
449	TX_NEWTITLE = 'Change Consult Title';
450	TX_REQD_CONSULT = 'The following information is required to save a Consult Result - ' + CRLF;
451	TX_REQD_ADDM = 'The following information is required to save an addendum - ' + CRLF;
452	TX_REQ2 = CRLF + CRLF +
453	'It is recommended that these fields be entered before continuing' + CRLF +
454	'to prevent losing the note should the application time out.';
455	TX_CREATE_ERR = 'Error Creating Note';
456	TX_UPDATE_ERR = 'Error Updating Note';
457	TX_NO_CONSULT = 'No note is currently being edited';
458	TX_SAVE_CONSULT = 'Save Note';
459	TX_ADDEND_NO = 'Cannot make an addendum to a note that is being edited';
460	TX_DEL_OK = CRLF + CRLF + 'Delete this note?';
461	TX_DEL_ERR = 'Unable to Delete note';
462	TX_SIGN = 'Sign Note';
463	TX_COSIGN = 'Cosign Note';
464	TX_REQD_COSIG = CRLF + 'Expected Cosigner';
465	TX_REQ_COSIGNER = 'A cosigner must be identified.';
466	TX_SIGN_ERR = 'Unable to Sign Note';
467	TX_INVALID_CONSULT_CAP = 'Invalid consult record' ;
468	TX_INVALID_CONSULT_TEXT = 'Unable to retrieve the information for this consult.' ;
469	TX_SCREQD = 'This progress note title requires the service connected questions to be '+
470	'answered. The Encounter form will now be opened. Please answer all '+
471	'service connected questions.';
472	TX_SCREQD_T = 'Response required for SC questions.';
473	TX_NOPRT_NEW = 'This consult may not be printed until the current note is saved';
474	TX_NOPRT_NEW_CAP = 'Save Consult Result';
475	TX_NOCONSULT = 'No consult is currently selected.';
476	TX_NOCSLT_CAP = 'No Consult Selected';
477	TX_NONOTE = 'No note is currently selected.';
478	TX_NONOTE_CAP = 'No Note Selected';
479	TX_NO_ORDER = 'Ordering has been disabled.';
480	TX_NO_ORDER_CAP = 'Unable to place order';
481	TX_PROV_KEY = 'The provider selected for this encounter must' + CRLF +
482	'hold the PROVIDER key to enter orders.';
483	TC_PROV_KEY = 'PROVIDER Key Required';
484	TX_NOKEY = 'You do not have the keys required to take this action.';
485	TC_NOKEY = 'Insufficient Authority';
486	TX_BADKEYS = 'You have mutually exclusive order entry keys (ORES, ORELSE, or OREMAS).' +
487	CRLF + 'This must be resolved before you can enter orders.';
488	TC_BADKEYS = 'Multiple Keys';
489	TX_NO_FUTURE_DT = 'A Reference Date/Time in the future is not allowed.';
490	TX_ORDER_LOCKED = 'This record is locked by an action underway on the Notes tab';
491	TC_ORDER_LOCKED = 'Unable to access record';
492	TC_NO_RESUBMIT = 'Unable to resubmit';
493	TX_NO_ORD_CHG = 'The note is still associated with the previously selected request.' + CRLF +
494	'Finish the pending action, then try again.';
495	TC_NO_ORD_CHG = 'Locked Consult Request';
496	TX_NEW_SAVE1 = 'You are currently editing:' + CRLF + CRLF;
497	TX_NEW_SAVE2 = CRLF + CRLF + 'Do you wish to save this note and begin a new one?';
498	TX_NEW_SAVE3 = CRLF + CRLF + 'Do you wish to save this note and begin a new addendum?';
499	TX_NEW_SAVE4 = CRLF + CRLF + 'Do you wish to save this note and edit the one selected?';
500	TX_NEW_SAVE5 = CRLF + CRLF + 'Do you wish to save this note and begin a new Interdisciplinary entry?';
501	TC_NEW_SAVE2 = 'Create New Note';
502	TC_NEW_SAVE3 = 'Create New Addendum';
503	TC_NEW_SAVE4 = 'Edit Different Note';
504	TC_NEW_SAVE5 = 'Create New Interdisciplinary Entry';
505	TX_EMPTY_NOTE = CRLF + CRLF + 'This note contains no text and will not be saved.' + CRLF +
506	'Do you wish to delete this note?';
507	TC_EMPTY_NOTE = 'Empty Note';
508	TX_EMPTY_NOTE1 = 'This note contains no text and can not be signed.';
509	TC_NO_LOCK = 'Unable to Lock Note';
510	TX_ABSAVE = 'It appears the session terminated abnormally when this' + CRLF +
511	'note was last edited. Some text may not have been saved.' + CRLF + CRLF +
512	'Do you wish to continue and sign the note?';
513	TC_ABSAVE = 'Possible Missing Text';
514	TX_NO_BOIL = 'There is no boilerplate text associated with this title.';
515	TC_NO_BOIL = 'Load Boilerplate Text';
516	TX_BLR_CLEAR = 'Do you want to clear the previously loaded boilerplate text?';
517	TC_BLR_CLEAR = 'Clear Previous Boilerplate Text';
518	TX_CP_NO_RESULTS = 'This Clinical Procedure cannot be completed yet.' + CRLF +
519	'No results are available for interpretation.';
520	TC_CP_NO_RESULTS = 'No Results Available';
521	TX_CLIN_PROC = 'A procedure summary code and valid date/time for the procedure must be entered.';
522	TX_NO_AUTHOR = 'An author must be entered for the note.';
523	TC_CLIN_PROC = 'Missing Information for Clinical Procedures Document';
524	TX_DETACH_CNF = 'Confirm Detachment';
525	TX_DETACH_FAILURE = 'Detach failed';
526
527	DLG_CONSULT = 'C';
528	DLG_PROC = 'P';
529	TX_RETRACT_CAP = 'Retraction Notice';
530	TX_RETRACT = 'This document will now be RETRACTED. As Such, it has been removed' +CRLF +
531	' from public view, and from typical Releases of Information,' +CRLF +
532	' but will remain indefinitely discoverable to HIMS.' +CRLF +CRLF;
533	TX_AUTH_SIGNED = 'Author has not signed, are you SURE you want to sign.' +CRLF;
534
535	var
536	ViewContext, CurrNotifIEN: integer ;
537	SvcCtxt: TServiceContext;
538	StsCtxt: TStatusContext ;
539	DateRange: TConsultDateRange;
540	uSelectContext: TSelectContext ;
541	uPCEShow, uPCEEdit: TPCEData;
542	frmDrawers: TfrmDrawers;
543	MenuAccessRec: TMenuAccessRec;
544	MedResult: TMedResultRec;
545	uChanging: Boolean;
546	uIDNotesActive: boolean;
547
548	{ TPage common methods --------------------------------------------------------------------- }
549
550	function TfrmConsults.AllowContextChange(var WhyNot: string): Boolean;
551	begin
552	dlgFindText.CloseDialog;
553	Result := inherited AllowContextChange(WhyNot); // sets result = true
554	if Assigned(frmTemplateDialog) then
555	if Screen.ActiveForm = frmTemplateDialog then
556	//if (fsModal in frmTemplateDialog.FormState) then
557	case BOOLCHAR[frmFrame.CCOWContextChanging] of
558	'1': begin
559	WhyNot := 'A template in progress will be aborted. ';
560	Result := False;
561	end;
562	'0': begin
563	if WhyNot = 'COMMIT' then
564	begin
565	FSilent := True;
566	frmTemplateDialog.Silent := True;
567	frmTemplateDialog.ModalResult := mrCancel;
568	end;
569	end;
570	end;
571	if EditingIndex <> -1 then
572	case BOOLCHAR[frmFrame.CCOWContextChanging] of
573	'1': begin
574	if memResults.GetTextLen > 0 then
575	WhyNot := WhyNot + 'A note in progress will be saved as unsigned. '
576	else
577	WhyNot := WhyNot + 'An empty note in progress will be deleted. ';
578	Result := False;
579	end;
580	'0': begin
581	if WhyNot = 'COMMIT' then FSilent := True;
582	SaveCurrentNote(Result);
583	end;
584	end;
585	if Assigned(frmEncounterFrame) then
586	if Screen.ActiveForm = frmEncounterFrame then
587	//if (fsModal in frmEncounterFrame.FormState) then
588	case BOOLCHAR[frmFrame.CCOWContextChanging] of
589	'1': begin
590	WhyNot := WhyNot + 'Encounter information being edited will not be saved';
591	Result := False;
592	end;
593	'0': begin
594	if WhyNot = 'COMMIT' then
595	begin
596	FSilent := True;
597	frmEncounterFrame.Abort := False;
598	frmEncounterFrame.Cancel := True;
599	end;
600	end;
601	end;
602	end;
603
604	procedure TfrmConsults.ClearPtData;
605	{ clear all controls that contain patient specific information }
606	begin
607	inherited ClearPtData;
608	ClearEditControls;
609	lstConsults.Clear;
610	memConsult.Clear;
611	memResults.Clear;
612	uChanging := True;
613	tvCsltNotes.Items.BeginUpdate;
614	KillDocTreeObjects(tvCsltNotes);
615	tvCsltNotes.Items.Clear;
616	tvCsltNotes.Items.EndUpdate;
617	tvConsults.Items.BeginUpdate;
618	tvConsults.Items.Clear;
619	tvConsults.Items.EndUpdate;
620	uChanging := False;
621	lstNotes.Clear ;
622	memPCEShow.Clear;
623	uPCEShow.Clear;
624	frmDrawers.ResetTemplates;
625	FOrderID := '';
626	end;
627
628	procedure TfrmConsults.SetViewContext(AContext: TSelectContext);
629	var
630	Saved: boolean;
631	begin
632	if EditingIndex <> -1 then
633	begin
634	SaveCurrentNote(Saved);
635	if not Saved then Exit;
636	end;
637	FCurrentContext := AContext;
638	CurrNotifIEN := 0;
639	EditingIndex := -1;
640	tvConsults.Enabled := True;
641	lstConsults.Enabled := True ;
642	lstNotes.Enabled := True ;
643	pnlRead.BringToFront ;
644	memConsult.TabStop := True;
645	with uSelectContext do
646	begin
647	BeginDate := FCurrentContext.BeginDate;
648	EndDate := FCurrentContext.EndDate;
649	Status := FCurrentContext.Status;
650	Service := FCurrentContext.Service;
651	Ascending := FCurrentContext.Ascending;
652	GroupBy := FCurrentContext.GroupBy;
653	Changed := True;
654	mnuViewClick(Self);
655	end;
656	end;
657
658	procedure TfrmConsults.DisplayPage;
659	{ causes page to be visible and conditionally executes initialization code }
660	begin
661	inherited DisplayPage;
662	frmFrame.ShowHideChartTabMenus(mnuViewChart);
663	frmFrame.mnuFilePrint.Tag := CT_CONSULTS;
664	frmFrame.mnuFilePrint.Enabled := True;
665	frmFrame.mnuFilePrintSetup.Enabled := True;
666	frmFrame.mnuFilePrintSelectedItems.Enabled := True;
667	FNotifPending := False;
668	if InitPage then
669	begin
670	FDefaultContext := GetCurrentContext;
671	FCurrentContext := FDefaultContext;
672	popNoteMemoSpell.Visible := SpellCheckAvailable;
673	popNoteMemoGrammar.Visible := popNoteMemoSpell.Visible;
674	Z11.Visible := popNoteMemoSpell.Visible;
675	timAutoSave.Interval := User.AutoSave * 1000; // convert seconds to milliseconds
676	SetEqualTabStops(memResults);
677	end;
678	cmdEditResubmit.Visible := False;
679	EnableDisableIDNotes;
680	EnableDisableOrdering;
681	if InitPage then SendMessage(memConsult.Handle, EM_SETMARGINS, EC_LEFTMARGIN, 4);
682	if InitPatient and not (CallingContext = CC_NOTIFICATION) then
683	begin
684	SetViewContext(FDefaultContext);
685	end;
686	case CallingContext of
687	CC_INIT_PATIENT: if not InitPatient then
688	begin
689	SetViewContext(FDefaultContext);
690	end;
691	CC_NOTIFICATION: ProcessNotifications;
692	end;
693	//with tvConsults do if Selected <> nil then tvConsultsChange(Self, Selected);
694	end;
695
696	procedure TfrmConsults.SetFontSize(NewFontSize: Integer);
697	{ adjusts the font size of any controls that don't have ParentFont = True }
698	begin
699	inherited SetFontSize(NewFontSize);
700	memConsult.Font.Size := NewFontSize;
701	memResults.Font.Size := NewFontSize;
702	lblTitle.Font.Size := NewFontSize;
703	frmDrawers.Font.Size := NewFontSize;
704	SetEqualTabStops(memResults);
705	// adjust heights of pnlAction, pnlFields, and memPCEShow
706	end;
707
708	procedure TfrmConsults.mnuChartTabClick(Sender: TObject);
709	{ reroute to Chart Tab menu of the parent form: frmFrame }
710	begin
711	inherited;
712	frmFrame.mnuChartTabClick(Sender);
713	end;
714
715	{ General procedures ----------------------------------------------------------------------- }
716
717	procedure TfrmConsults.ClearEditControls;
718	begin
719	// clear FEditNote (should FEditNote be an object with a clear method?)
720	with FEditNote do
721	begin
722	DocType := 0;
723	Title := 0;
724	TitleName := '';
725	DateTime := 0;
726	Author := 0;
727	AuthorName := '';
728	Cosigner := 0;
729	CosignerName := '';
730	Subject := '';
731	Location := 0;
732	LocationName := '';
733	//Consult := 0;
734	PkgRef := '';
735	PkgIEN := 0;
736	PkgPtr := '';
737	NeedCPT := False;
738	Addend := 0;
739	Lines := nil;
740	end;
741	// clear the editing controls (also clear the new labels?)
742	txtSubject.Text := '';
743	memResults.Clear;
744	timAutoSave.Enabled := False;
745	// clear the PCE object for editing
746	uPCEEdit.Clear;
747	// set the tracking variables to initial state
748	EditingIndex := -1;
749	frmConsults.ActiveControl := nil;
750	ShowPCEControls(FALSE);
751	FChanged := False;
752	end;
753
754	procedure TfrmConsults.CompleteConsult(IsIDChild: boolean; AnIDParent: integer; UseClinProcTitles: boolean);
755	{ creates the editing context for a new progress note & inserts stub into top of view list }
756	const
757	USE_CURRENT_VISITSTR = -2;
758	var
759	EnableAutosave, HaveRequired: Boolean;
760	CreatedNote: TCreatedDoc;
761	TmpBoilerPlate: TStringList;
762	x, WhyNot: string;
763	tmpNode: TTreeNode;
764	AClassName: string;
765	DocInfo: string;
766	begin
767	EnableAutosave := FALSE;
768	TmpBoilerPlate := nil;
769	try
770	ClearEditControls;
771	tvConsults.Enabled := False;
772	lstConsults.Enabled := False ;
773	FillChar(FEditNote, SizeOf(FEditNote), 0); //v15.7
774	with FEditNote do
775	begin
776	if UseClinProcTitles then
777	begin
778	DocType := IdentifyClinProcClass;
779	Title := DfltClinProcTitle;
780	TitleName := DfltClinProcTitleName;
781	AClassName := DCL_CLINPROC;
782	end
783	else
784	begin
785	DocType := TYP_PROGRESS_NOTE;
786	Title := DfltConsultTitle;
787	TitleName := DfltConsultTitleName;
788	AClassName := DCL_CONSULTS
789	end;
790	if IsIDChild and (not CanTitleBeIDChild(Title, WhyNot)) then
791	begin
792	Title := 0;
793	TitleName := '';
794	end;
795	DateTime := FMNow;
796	Author := User.DUZ;
797	AuthorName := User.Name;
798	Location := Encounter.Location;
799	LocationName := Encounter.LocationName;
800	VisitDate := Encounter.DateTime;
801	if IsIDChild then
802	IDParent := AnIDParent
803	else
804	IDParent := 0;
805	PkgRef := lstConsults.ItemID + ';' + PKG_CONSULTS;
806	PkgIEN := lstConsults.ItemIEN;
807	PkgPtr := PKG_CONSULTS;
808	// Cosigner, if needed, will be set by fNoteProps
809	end;
810	// check to see if interaction necessary to get required fields
811	if LacksRequiredForCreate or VerifyNoteTitle
812	then HaveRequired := ExecuteNoteProperties(FEditNote, CT_CONSULTS, IsIDChild, False, AClassName,
813	MenuAccessRec.ClinProcFlag)
814	else HaveRequired := True;
815	// lock the consult request if there is a consult
816	if FEditNote.PkgIEN > 0 then HaveRequired := HaveRequired and LockConsultRequest(FEditNote.PkgIEN);
817	if HaveRequired then
818	begin
819	// set up uPCEEdit for entry of new note
820	uPCEEdit.UseEncounter := True;
821	uPCEEdit.NoteDateTime := FEditNote.DateTime;
822	uPCEEdit.PCEForNote(USE_CURRENT_VISITSTR, uPCEShow);
823	FEditNote.NeedCPT := uPCEEdit.CPTRequired;
824	// create the note
825	PutNewNote(CreatedNote, FEditNote);
826	uPCEEdit.NoteIEN := CreatedNote.IEN;
827	if CreatedNote.IEN > 0 then LockDocument(CreatedNote.IEN, CreatedNote.ErrorText);
828	if CreatedNote.ErrorText = '' then
829	begin
830	if lstNotes.DisplayText[0] = 'None' then
831	begin
832	uChanging := True;
833	tvCsltNotes.Items.BeginUpdate;
834	lstNotes.Items.Clear;
835	KillDocTreeObjects(tvCsltNotes);
836	tvCsltNotes.Items.Clear;
837	tvCsltNotes.Items.EndUpdate;
838	uChanging := False;
839	end;
840	with FEditNote do
841	begin
842	x := IntToStr(CreatedNote.IEN) + U + TitleName + U + FloatToStr(DateTime) + U +
843	Patient.Name + U + IntToStr(Author) + ';' + AuthorName + U + LocationName + U + 'new' + U +
844	'Adm: ' + FormatFMDateTime('mmm dd,yyyy', VisitDate) + ';' + FloatToStr(VisitDate) + U + U +
845	U + U + U + U + U + U;
846	end;
847	lstNotes.Items.Insert(0, x);
848	uChanging := True;
849	tvCsltNotes.Items.BeginUpdate;
850	if IsIDChild then
851	begin
852	tmpNode := tvCsltNotes.FindPieceNode(IntToStr(AnIDParent), 1, U, tvCsltNotes.Items.GetFirstNode);
853	tmpNode.ImageIndex := IMG_IDNOTE_OPEN;
854	tmpNode.SelectedIndex := IMG_IDNOTE_OPEN;
855	tmpNode := tvCsltNotes.Items.AddChildObjectFirst(tmpNode, MakeConsultNoteDisplayText(x), MakeNoteTreeObject(x));
856	tmpNode.ImageIndex := IMG_ID_CHILD;
857	tmpNode.SelectedIndex := IMG_ID_CHILD;
858	end
859	else
860	begin
861	tmpNode := tvCsltNotes.Items.AddObjectFirst(tvCsltNotes.Items.GetFirstNode, 'New Note in Progress',
862	MakeNoteTreeObject('NEW^New Note in Progress^^^^^^^^^^^%^0'));
863	TORTreeNode(tmpNode).StringData := 'NEW^New Note in Progress^^^^^^^^^^^%^0';
864	tmpNode.ImageIndex := IMG_TOP_LEVEL;
865	tmpNode := tvCsltNotes.Items.AddChildObjectFirst(tmpNode, MakeConsultNoteDisplayText(x), MakeNoteTreeObject(x));
866	tmpNode.ImageIndex := IMG_SINGLE;
867	tmpNode.SelectedIndex := IMG_SINGLE;
868	end;
869	tmpNode.StateIndex := IMG_NO_IMAGES;
870	TORTreeNode(tmpNode).StringData := x;
871	tvCsltNotes.Selected := tmpNode;
872	tvCsltNotes.Items.EndUpdate;
873	uChanging := False;
874
875	Changes.Add(CH_CON, IntToStr(CreatedNote.IEN), GetTitleText(0), '', CH_SIGN_YES);
876	lstNotes.ItemIndex := 0;
877	EditingIndex := 0;
878	SetSubjectVisible(AskSubjectForNotes);
879	if not assigned(TmpBoilerPlate) then
880	TmpBoilerPlate := TStringList.Create;
881	LoadBoilerPlate(TmpBoilerPlate, FEditNote.Title);
882	FChanged := False;
883	cmdChangeClick(Self); // will set captions, sign state for Changes
884	lstNotesClick(Self); // will make pnlWrite visible
885	if timAutoSave.Interval <> 0 then EnableAutosave := TRUE;
886	if txtSubject.Visible then txtSubject.SetFocus else memResults.SetFocus;
887	end
888	else // CreatedNote.ErrorText <> ''
889	begin
890	// if note creation failed or failed to get note lock (both unlikely), unlock consult
891	if FEditNote.PkgIEN > 0 then UnlockConsultRequest(0, FEditNote.PkgIEN);
892	//if FEditNote.Consult > 0 then UnlockConsultRequest(0, FEditNote.Consult);
893	if CreatedNote.ErrorText <> '' then
894	InfoBox(CreatedNote.ErrorText, TX_CREATE_ERR, MB_OK);
895	HaveRequired := False;
896	end; {if CreatedNote.IEN}
897	end; {if HaveRequired}
898	if not HaveRequired then
899	begin
900	ClearEditControls;
901	lstConsults.Enabled := True;
902	tvConsults.Enabled := True;
903	end;
904	SetResultMenus ;
905	finally
906	if assigned(TmpBoilerPlate) then
907	begin
908	DocInfo := MakeXMLParamTIU(IntToStr(CreatedNote.IEN), FEditNote);
909	ExecuteTemplateOrBoilerPlate(TmpBoilerPlate, FEditNote.Title, ltTitle, Self, 'Title: ' + FEditNote.TitleName, DocInfo);
910	QuickCopyWith508Msg(TmpBoilerPlate, memResults);
911	TmpBoilerPlate.Free;
912	end;
913	if EnableAutosave then // Don't enable autosave until after dialog fields have been resolved
914	timAutoSave.Enabled := True;
915	end;
916	end;
917
918	procedure TfrmConsults.InsertAddendum;
919	{ sets up fields of pnlWrite to write an addendum for the selected note }
920	const
921	AS_ADDENDUM = True;
922	IS_ID_CHILD = False;
923	var
924	HaveRequired: Boolean;
925	CreatedNote: TCreatedDoc;
926	x: string;
927	tmpNode: TTreeNode;
928	AClassName: string;
929	begin
930	AClassName := DCL_CONSULTS;
931	ClearEditControls;
932	lstConsults.Enabled := False ;
933	tvConsults.Enabled := False;
934	with FEditNote do
935	begin
936	DocType := TYP_ADDENDUM;
937	Title := TitleForNote(lstNotes.ItemIEN);
938	TitleName := Piece(lstNotes.Items[lstNotes.ItemIndex], U, 2);
939	DateTime := FMNow;
940	Author := User.DUZ;
941	AuthorName := User.Name;
942	x := GetPackageRefForNote(lstNotes.ItemIEN);
943	if Piece(x, U, 1) <> '-1' then
944	begin
945	PkgRef := GetPackageRefForNote(lstNotes.ItemIEN);
946	PkgIEN := StrToIntDef(Piece(PkgRef, ';', 1), 0);
947	PkgPtr := Piece(PkgRef, ';', 2);
948	end;
949	Addend := lstNotes.ItemIEN;
950	// Cosigner, if needed, will be set by fNoteProps
951	// Location info will be set after the encounter is loaded
952	end;
953	// check to see if interaction necessary to get required fields
954	if LacksRequiredForCreate
955	then HaveRequired := ExecuteNoteProperties(FEditNote, CT_CONSULTS, IS_ID_CHILD,
956	False, AClassName, MenuAccessRec.ClinProcFlag)
957	else HaveRequired := True;
958	// lock the consult request if there is a consult
959	if HaveRequired and (FEditNote.PkgIEN > 0) then
960	HaveRequired := LockConsultRequest(FEditNote.PkgIEN);
961	if HaveRequired then
962	begin
963	uPCEEdit.NoteDateTime := FEditNote.DateTime;
964	uPCEEdit.PCEForNote(FEditNote.Addend, uPCEShow);
965	FEditNote.Location := uPCEEdit.Location;
966	FEditNote.LocationName := ExternalName(uPCEEdit.Location, 44);
967	FEditNote.VisitDate := uPCEEdit.DateTime;
968	PutAddendum(CreatedNote, FEditNote, FEditNote.Addend);
969	uPCEEdit.NoteIEN := CreatedNote.IEN;
970	if CreatedNote.IEN > 0 then LockDocument(CreatedNote.IEN, CreatedNote.ErrorText);
971	if CreatedNote.ErrorText = '' then
972	begin
973	with FEditNote do
974	begin
975	x := IntToStr(CreatedNote.IEN) + U + 'Addendum to ' + TitleName + U + FloatToStr(DateTime) + U +
976	Patient.Name + U + IntToStr(Author) + ';' + AuthorName + U + LocationName + U + 'new' + U +
977	U + U + U + U + U + U + U + U;
978	end;
979	lstNotes.Items.Insert(0, x);
980
981	uChanging := True;
982	tvCsltNotes.Items.BeginUpdate;
983	tmpNode := tvCsltNotes.Items.AddObjectFirst(tvCsltNotes.Items.GetFirstNode, 'New Addendum in Progress',
984	MakeConsultsNoteTreeObject('ADDENDUM^New Addendum in Progress^^^^^^^^^^^%^0'));
985	TORTreeNode(tmpNode).StringData := 'ADDENDUM^New Addendum in Progress^^^^^^^^^^^%^0';
986	tmpNode.ImageIndex := IMG_TOP_LEVEL;
987	tmpNode := tvCsltNotes.Items.AddChildObjectFirst(tmpNode, MakeConsultNoteDisplayText(x), MakeConsultsNoteTreeObject(x));
988	TORTreeNode(tmpNode).StringData := x;
989	tmpNode.ImageIndex := IMG_ADDENDUM;
990	tmpNode.SelectedIndex := IMG_ADDENDUM;
991	tvCsltNotes.Selected := tmpNode;
992	tvCsltNotes.Items.EndUpdate;
993	uChanging := False;
994
995	Changes.Add(CH_CON, IntToStr(CreatedNote.IEN), GetTitleText(0), '', CH_SIGN_YES);
996	lstNotes.ItemIndex := 0;
997	EditingIndex := 0;
998	SetSubjectVisible(AskSubjectForNotes);
999	cmdChangeClick(Self); // will set captions, sign state for Changes
1000	lstNotesClick(Self); // will make pnlWrite visible
1001	if timAutoSave.Interval <> 0 then timAutoSave.Enabled := True;
1002	memResults.SetFocus;
1003	end else
1004	begin
1005	// if note creation failed or failed to get note lock (both unlikely), unlock consult
1006	if FEditNote.PkgIEN > 0 then UnlockConsultRequest(0, FEditNote.PkgIEN);
1007	//if FEditNote.Consult > 0 then UnlockConsultRequest(0, FEditNote.Consult);
1008	InfoBox(CreatedNote.ErrorText, TX_CREATE_ERR, MB_OK);
1009	HaveRequired := False;
1010	lstConsults.Enabled := True;
1011	tvConsults.Enabled := True;
1012	end; {if CreatedNote.IEN}
1013	end; {if HaveRequired}
1014	if not HaveRequired then ClearEditControls;
1015	SetResultMenus ;
1016	end;
1017
1018	procedure TfrmConsults.LoadForEdit;
1019	{ retrieves an existing note and places the data in the fields of pnlWrite }
1020	var
1021	tmpNode: TTreeNode;
1022	x: string;
1023	ErrMsg: string;
1024	AnAuthor: int64;
1025	AProcSummCode: integer;
1026	AProcDate: TFMDateTime;
1027	tmpBoilerplate: TStringList;
1028	EnableAutoSave: boolean;
1029	DocInfo: string;
1030	begin
1031	ClearEditControls;
1032	if not LockConsultRequestAndNote(lstNotes.ItemIEN) then Exit;
1033	EnableAutosave := FALSE;
1034	tmpBoilerplate := nil;
1035	try
1036	EditingIndex := lstNotes.ItemIndex;
1037	Changes.Add(CH_CON, lstNotes.ItemID, GetTitleText(EditingIndex), '', CH_SIGN_YES);
1038	GetNoteForEdit(FEditNote, lstNotes.ItemIEN);
1039	memResults.Lines.Assign(FEditNote.Lines);
1040	FChanged := False;
1041	if FEditNote.Title = TYP_ADDENDUM then
1042	begin
1043	FEditNote.DocType := TYP_ADDENDUM;
1044	FEditNote.TitleName := Piece(lstNotes.Items[lstNotes.ItemIndex], U, 2);
1045	if Copy(FEditNote.TitleName,1,1) = '+' then FEditNote.TitleName := Copy(FEditNote.TitleName, 3, 199);
1046	if CompareText(Copy(FEditNote.TitleName, 1, 8), 'Addendum') <> 0
1047	then FEditNote.TitleName := FEditNote.TitleName + 'Addendum to ';
1048	end;
1049	uChanging := True;
1050	tvCsltNotes.Items.BeginUpdate;
1051	tmpNode := tvCsltNotes.FindPieceNode('EDIT', 1, U, nil);
1052	if tmpNode = nil then
1053	begin
1054	tmpNode := tvCsltNotes.Items.AddObjectFirst(tvCsltNotes.Items.GetFirstNode, 'Note being edited',
1055	MakeConsultsNoteTreeObject('EDIT^Note being edited^^^^^^^^^^^%^0'));
1056	TORTreeNode(tmpNode).StringData := 'EDIT^Note being edited^^^^^^^^^^^%^0';
1057	end
1058	else
1059	tmpNode.DeleteChildren;
1060	x := lstNotes.Items[lstNotes.ItemIndex];
1061	tmpNode.ImageIndex := IMG_TOP_LEVEL;
1062	tmpNode := tvCsltNotes.Items.AddChildObjectFirst(tmpNode, MakeConsultNoteDisplayText(x), MakeConsultsNoteTreeObject(x));
1063	TORTreeNode(tmpNode).StringData := x;
1064	if CompareText(Copy(FEditNote.TitleName, 1, 8), 'Addendum') <> 0 then
1065	tmpNode.ImageIndex := IMG_SINGLE
1066	else
1067	tmpNode.ImageIndex := IMG_ADDENDUM;
1068	tmpNode.SelectedIndex := tmpNode.ImageIndex;
1069	tvCsltNotes.Selected := tmpNode;
1070	tvCsltNotes.Items.EndUpdate;
1071	uChanging := False;
1072
1073	uPCEEdit.NoteDateTime := MakeFMDateTime(Piece(lstNotes.Items[lstNotes.ItemIndex], U, 3));
1074	uPCEEdit.PCEForNote(lstNotes.ItemIEN, uPCEShow);
1075	FEditNote.NeedCPT := uPCEEdit.CPTRequired;
1076	txtSubject.Text := FEditNote.Subject;
1077	SetSubjectVisible(AskSubjectForNotes);
1078	if MenuAccessRec.IsClinicalProcedure and LacksClinProcFields(FEditNote, MenuAccessRec, ErrMsg) then
1079	begin
1080	// ** Collect Author, ClinProcSummCode, and ClinProcDate **
1081	AnAuthor := FEditNote.Author;
1082	AProcSummCode := FEditNote.ClinProcSummCode;
1083	AProcDate := FEditNote.ClinProcDateTime;
1084	EnterClinProcFields(MenuAccessRec.ClinProcFlag, ErrMsg, AProcSummCode, AProcDate, AnAuthor);
1085	// ** set values into FEditNote **
1086	FEditNote.Author := AnAuthor;
1087	FEditNote.ClinProcSummCode := AProcSummCode;
1088	FEditNote.ClinProcDateTime := AProcDate;
1089	end;
1090	(* if LacksClinProcFields(ErrMsg) then
1091	begin
1092	// ** Collect Author, Cosigner (if required), ClinProcSummCode, and ClinProcDate **
1093	EnterClinProcFields(MenuAccessRec.ClinProcFlag, ErrMsg, FEditNote);
1094	end;*)
1095	if MenuAccessRec.IsClinicalProcedure and (memResults.Lines.Text = '') then
1096	begin
1097	if not assigned(TmpBoilerPlate) then
1098	TmpBoilerPlate := TStringList.Create;
1099	LoadBoilerPlate(TmpBoilerPlate, FEditNote.Title);
1100	end;
1101	if frmFrame.Closing then exit;
1102	cmdChangeClick(Self); // will set captions, sign state for Changes
1103	lstNotesClick(Self); // will make pnlWrite visible
1104	if timAutoSave.Interval <> 0 then EnableAutosave := TRUE;
1105	memResults.SetFocus;
1106	finally
1107	if assigned(TmpBoilerPlate) then
1108	begin
1109	DocInfo := MakeXMLParamTIU(IntToStr(lstNotes.ItemIEN), FEditNote);
1110	ExecuteTemplateOrBoilerPlate(TmpBoilerPlate, FEditNote.Title, ltTitle, Self, 'Title: ' + FEditNote.TitleName, DocInfo);
1111	QuickCopyWith508Msg(TmpBoilerPlate, memResults);
1112	TmpBoilerPlate.Free;
1113	end;
1114	if EnableAutosave then // Don't enable autosave until after dialog fields have been resolved
1115	timAutoSave.Enabled := True;
1116	end;
1117	end;
1118
1119	procedure TfrmConsults.SaveEditedConsult(var Saved: Boolean);
1120	{ validates fields and sends the updated consult result to the server }
1121	var
1122	UpdatedNote: TCreatedDoc;
1123	x, ErrMsg: string;
1124	ContinueSave: boolean;
1125
1126	// this block executes for Clinical Procedures documents ONLY!!
1127	procedure SaveOrAbort(var AllowSave: boolean);
1128	begin
1129	// if no text, leave as undictated, saving nothing
1130	if (memResults.GetTextLen = 0) or (not ContainsVisibleChar(memResults.Text)) then
1131	begin
1132	if lstNotes.ItemIndex = EditingIndex then
1133	begin
1134	EditingIndex := -1;
1135	lstNotesClick(Self);
1136	end;
1137	EditingIndex := -1;
1138	Saved := True; // (yes, though not actually saving, this is correct and necessary (RV))
1139	AllowSave := False;
1140	end
1141	// if text, stuff user as author, and allow save as unsigned
1142	else
1143	begin
1144	if FEditNote.Author <= 0 then FEditNote.Author := User.DUZ;
1145	AllowSave := True;
1146	end;
1147	end;
1148
1149	begin
1150	Saved := False;
1151	ContinueSave := True;
1152	if MenuAccessRec.IsClinicalProcedure and LacksClinProcFields(FEditNote, MenuAccessRec, ErrMsg) then
1153	// this block will execute for Clinical Procedures documents ONLY!!
1154	begin
1155	if not FSilent then // if not timing out, then prompt for required fields
1156	begin
1157	InfoBox(ErrMsg, TC_CLIN_PROC, MB_OK);
1158	cmdChangeClick(mnuActConsultResults);
1159	if frmFrame.TimedOut then exit;
1160	if MenuAccessRec.IsClinicalProcedure and LacksClinProcFields(FEditNote, MenuAccessRec, ErrMsg) then // if still not entered, action depends on presence of text
1161	SaveOrAbort(ContinueSave);
1162	end
1163	else SaveOrAbort(ContinueSave); // if timing out, action depends on presence of text
1164	if not ContinueSave then exit;
1165	end
1166	else if (memResults.GetTextLen = 0) or (not ContainsVisibleChar(memResults.Text)) then
1167	// this block will NOT execute for Clinical Procedures documents!!
1168	begin
1169	lstNotes.ItemIndex := EditingIndex;
1170	x := lstNotes.ItemID;
1171	uChanging := True;
1172	tvCsltNotes.Selected := tvCsltNotes.FindPieceNode(x, 1, U, tvCsltNotes.Items.GetFirstNode);
1173	uChanging := False;
1174	tvCsltNotesChange(Self, tvCsltNotes.Selected);
1175	if FSilent or
1176	((not FSilent) and
1177	(InfoBox(GetTitleText(EditingIndex) + TX_EMPTY_NOTE, TC_EMPTY_NOTE, MB_YESNO) = IDYES))
1178	then
1179	begin
1180	FConfirmed := True;
1181	mnuActNoteDeleteClick(Self);
1182	Saved := True;
1183	FDeleted := True;
1184	end
1185	else
1186	FConfirmed := False;
1187	Exit;
1188	end;
1189	//ExpandTabsFilter(memResults.Lines, TAB_STOP_CHARS);
1190	FEditNote.Lines := memResults.Lines;
1191	FEditNote.Subject := txtSubject.Text;
1192	FEditNote.NeedCPT := uPCEEdit.CPTRequired;
1193	timAutoSave.Enabled := False;
1194	try
1195	PutEditedNote(UpdatedNote, FEditNote, lstNotes.GetIEN(EditingIndex));
1196	finally
1197	timAutoSave.Enabled := True;
1198	end;
1199	// there's no unlocking here since the note is still in Changes after a save
1200	if UpdatedNote.IEN > 0 then
1201	begin
1202	if lstNotes.ItemIndex = EditingIndex then
1203	begin
1204	EditingIndex := -1;
1205	lstNotesClick(Self);
1206	end;
1207	EditingIndex := -1;
1208	Saved := True;
1209	FChanged := False;
1210	end else
1211	begin
1212	if not FSilent then
1213	InfoBox(TX_SAVE_ERROR1 + UpdatedNote.ErrorText + TX_SAVE_ERROR2, TC_SAVE_ERROR, MB_OK or MB_ICONWARNING);
1214	end;
1215	end;
1216
1217	procedure TfrmConsults.SaveCurrentNote(var Saved: Boolean);
1218	begin
1219	if EditingIndex < 0 then Exit;
1220	SaveEditedConsult(Saved);
1221	end;
1222
1223
1224	{ Form events -----------------------------------------------------------------}
1225
1226	procedure TfrmConsults.pnlRightExit(Sender: TObject);
1227	begin
1228	inherited;
1229	if TabIsPressed then
1230	FindNextControl(tvConsults, True, True, False).SetFocus
1231	else if ShiftTabIsPressed then
1232	FindNextControl(pnlLeft, True, True, False).SetFocus;
1233	end;
1234
1235	procedure TfrmConsults.pnlRightResize(Sender: TObject);
1236	{ TRichEdit doesn't repaint appropriately unless its parent panel is refreshed }
1237	begin
1238	inherited;
1239	pnlRight.Refresh;
1240	pnlAction.Invalidate;
1241	memConsult.Repaint;
1242	pnlResults.Invalidate;
1243	memResults.Repaint;
1244	end;
1245
1246	{ Left panel (selector) events ------------------------------------------------------------- }
1247
1248	procedure TfrmConsults.lstConsultsClick(Sender: TObject);
1249	{ loads the text for the selected Consult}
1250	const
1251	RSLT_TIU_DOC = 1;
1252	RSLT_MED_RPT = 2;
1253	var
1254	ANode: TTreeNode;
1255	begin
1256	inherited;
1257	lstNotes.Items.Clear ;
1258	memConsult.Clear ;
1259	ClearEditControls ;
1260	if lstConsults.ItemIEN <= 0 then
1261	begin
1262	memConsult.Lines.Add('No consults were found which met the criteria specified: '
1263	+ #13#10#13#10 + lblConsults.Caption) ;
1264	memConsult.SelStart := 0;
1265	mnuAct.Enabled := False ;
1266	exit ;
1267	end
1268	else mnuAct.Enabled := True;
1269	pnlResults.Visible := False;
1270	pnlResults.SendToBack;
1271	Screen.Cursor := crHourglass ;
1272	StatusText('Retrieving selected consult...');
1273	cmdPCE.Enabled := False;
1274	popNoteMemoEncounter.Enabled := False;
1275	GetConsultRec(lstConsults.ItemIEN) ;
1276	FOrderID := '';
1277	//FOrderID := Piece(lstConsults.Items[lstConsults.ItemIndex], U, 6);
1278	if ConsultRec.EntryDate = -1 then
1279	begin
1280	memConsult.Lines.Add(TX_INVALID_CONSULT_TEXT) ;
1281	lblTitle.Caption := TX_INVALID_CONSULT_CAP ;
1282	lblTitle.Hint := lblTitle.Caption;
1283	end
1284	else
1285	begin
1286	lblTitle.Caption := lstConsults.DisplayText[lstConsults.ItemIndex] ;
1287	lblTitle.Hint := lblTitle.Caption;
1288	LoadConsultDetail(memConsult.Lines, lstConsults.ItemIEN) ;
1289	FDocList.Clear;
1290	lstNotes.Items.Clear;
1291	uChanging := True;
1292	tvCsltNotes.Items.BeginUpdate;
1293	KillDocTreeObjects(tvCsltNotes);
1294	tvCsltNotes.Items.Clear;
1295	if (ConsultRec.TIUDocuments.Count + ConsultRec.MedResults.Count) > 0 then
1296	begin
1297	with FCurrentNoteContext do
1298	begin
1299	if ConsultRec.TIUDocuments.Count > 0 then
1300	begin
1301	CreateListItemsForDocumentTree(FDocList, ConsultRec.TIUDocuments, RSLT_TIU_DOC, GroupBy, TreeAscending, CT_CONSULTS);
1302	UpdateNoteTreeView(FDocList, tvCsltNotes, RSLT_TIU_DOC);
1303	end;
1304	FDocList.Clear;
1305	if ConsultRec.MedResults.Count > 0 then
1306	begin
1307	CreateListItemsForDocumentTree(FDocList, ConsultRec.MedResults, RSLT_MED_RPT, GroupBy, TreeAscending, CT_CONSULTS);
1308	UpdateNoteTreeView(FDocList, tvCsltNotes, RSLT_MED_RPT);
1309	end;
1310	end;
1311	with tvCsltNotes do
1312	begin
1313	FullExpand;
1314	if Notifications.Active and FNotifPending then
1315	Selected := FindPieceNode(Piece(Notifications.AlertData, U, 1), 1, U, nil)
1316	else if FLastNoteID <> '' then
1317	Selected := FindPieceNode(FLastNoteID, 1, U, nil);
1318	if Selected <> nil then
1319	if Piece(PDocTreeObject(Selected)^.DocID, ';', 1) <> 'MCAR' then DisplayPCE ;
1320	end;
1321	end
1322	else
1323	begin
1324	ANode := tvCsltNotes.Items.AddFirst(tvCsltNotes.Items.GetFirstNode, 'No related documents found');
1325	TORTreeNode(ANode).StringData := '-1^No related documents found';
1326	lstNotes.Items.Add('-1^None') ;
1327	ShowPCEControls(False) ;
1328	end ;
1329	tvCsltNotes.Items.EndUpdate;
1330	uChanging := False;
1331	FLastNoteID := '';
1332	//FLastNoteID := lstNotes.ItemID;
1333	end ;
1334	SetActionMenus ;
1335	SetResultMenus ;
1336	StatusText('');
1337	pnlRight.Repaint ;
1338	memConsult.SelStart := 0;
1339	memConsult.Repaint;
1340	Screen.Cursor := crDefault ;
1341	end;
1342
1343	procedure TfrmConsults.mnuActNewConsultRequestClick(Sender: TObject);
1344	var
1345	DialogInfo: string;
1346	DelayEvent: TOrderDelayEvent;
1347	begin
1348	inherited;
1349	DelayEvent.EventType := 'C'; // temporary, so can pass to CopyOrders
1350	DelayEvent.Specialty := 0;
1351	DelayEvent.Effective := 0;
1352	DelayEvent.EventIFN := 0;
1353	DelayEvent.PtEventIFN := 0;
1354	if not ReadyForNewOrder(DelayEvent) then Exit;
1355	{ get appropriate form, create the dialog form and show it }
1356	DialogInfo := GetNewDialog(DLG_CONSULT); // DialogInfo = DlgIEN;FormID;DGroup
1357	case CharAt(Piece(DialogInfo, ';', 4), 1) of
1358	'A': ActivateAction( Piece(DialogInfo, ';', 1), Self, 0);
1359	'D', 'Q': ActivateOrderDialog(Piece(DialogInfo, ';', 1), DelayEvent, Self, 0);
1360	'M': ActivateOrderMenu( Piece(DialogInfo, ';', 1), DelayEvent, Self, 0);
1361	'O': ActivateOrderSet( Piece(DialogInfo, ';', 1), DelayEvent, Self, 0);
1362	else InfoBox('Unsupported dialog type', 'Error', MB_OK);
1363	end; {case}
1364	end;
1365
1366	procedure TfrmConsults.mnuActNewProcedureClick(Sender: TObject);
1367	var
1368	DialogInfo: string;
1369	DelayEvent: TOrderDelayEvent;
1370	begin
1371	inherited;
1372	DelayEvent.EventType := 'C'; // temporary, so can pass to CopyOrders
1373	DelayEvent.Specialty := 0;
1374	DelayEvent.Effective := 0;
1375	DelayEvent.EventIFN := 0;
1376	DelayEvent.PtEventIFN := 0;
1377
1378	if not ReadyForNewOrder(DelayEvent) then Exit;
1379	{ get appropriate form, create the dialog form and show it }
1380	DialogInfo := GetNewDialog(DLG_PROC); // DialogInfo = DlgIEN;FormID;DGroup
1381	case CharAt(Piece(DialogInfo, ';', 4), 1) of
1382	'D', 'Q': ActivateOrderDialog(Piece(DialogInfo, ';', 1), DelayEvent, Self, 0);
1383	'M': ActivateOrderMenu( Piece(DialogInfo, ';', 1), DelayEvent, Self, 0);
1384	'O': ActivateOrderSet( Piece(DialogInfo, ';', 1), DelayEvent, Self, 0);
1385	else InfoBox('Unsupported dialog type', 'Error', MB_OK);
1386	end; {case}
1387	end;
1388
1389	procedure TfrmConsults.cmdNewConsultClick(Sender: TObject);
1390	{ maps 'New Consult' button to the New Consult menu item }
1391	begin
1392	inherited;
1393	mnuActNewConsultRequestClick(Self);
1394	end;
1395
1396	procedure TfrmConsults.cmdNewConsultExit(Sender: TObject);
1397	begin
1398	inherited;
1399	if Not cmdEditResubmit.Visible then
1400	DoLeftPanelCustomShiftTab;
1401	end;
1402
1403	procedure TfrmConsults.cmdNewProcClick(Sender: TObject);
1404	begin
1405	inherited;
1406	mnuActNewProcedureClick(Self);
1407	end;
1408
1409	{ Right panel (editor) events -------------------------------------------------------------- }
1410
1411	procedure TfrmConsults.NewPersonNeedData(Sender: TObject; const StartFrom: string;
1412	Direction, InsertAt: Integer);
1413	begin
1414	inherited;
1415	(Sender as TORComboBox).ForDataUse(SubSetOfPersons(StartFrom, Direction));
1416	end;
1417
1418	procedure TfrmConsults.memResultChange(Sender: TObject);
1419	{ sets FChanged to record that the note has really been edited }
1420	begin
1421	inherited;
1422	FChanged := True;
1423	end;
1424
1425	{ View menu events ------------------------------------------------------------------------- }
1426
1427	procedure TfrmConsults.mnuViewClick(Sender: TObject);
1428	{ changes the list of Consults available for viewing }
1429	var
1430	NewView: boolean;
1431	Saved: Boolean;
1432	//tmpNode: TTreeNode;
1433	begin
1434	inherited;
1435	// save note at FEditingIndex?
1436	if EditingIndex <> -1 then
1437	begin
1438	SaveCurrentNote(Saved);
1439	if not Saved then Exit;
1440	end;
1441	NewView := False ;
1442	if Sender is TMenuItem then
1443	begin
1444	ViewContext := TMenuItem(Sender).Tag ;
1445	case ViewContext of
1446	CC_BY_STATUS : NewView := SelectStatus(Font.Size, FCurrentContext, StsCtxt);
1447	CC_BY_SERVICE : NewView := SelectService(Font.Size, FCurrentContext, SvcCtxt);
1448	CC_BY_DATE : NewView := SelectConsultDateRange(Font.Size, FCurrentContext, DateRange);
1449	CC_CUSTOM : begin
1450	NewView := SelectConsultsView(Font.Size, FCurrentContext, uSelectContext) ;
1451	if NewView then lblConsults.Caption := 'Custom List';
1452	end;
1453	CC_ALL : NewView := True ;
1454	end;
1455	end
1456	else with FCurrentContext do
1457	begin
1458	if ((BeginDate + EndDate + Status + Service + GroupBy) <> '') then
1459	begin
1460	ViewContext := CC_CUSTOM;
1461	NewView := True;
1462	lblConsults.Caption := 'Default List';
1463	end
1464	else
1465	begin
1466	ViewContext := CC_ALL;
1467	NewView := True;
1468	lblConsults.Caption := 'All Consults';
1469	end;
1470	end;
1471	tvConsults.Caption := lblConsults.Caption;
1472	if NewView then
1473	begin
1474	StatusText('Retrieving Consult list...');
1475	lblTitle.Caption := '';
1476	lblTitle.Hint := lblTitle.Caption;
1477	UpdateList ;
1478	StatusText('');
1479	end;
1480	tvConsultsClick(Self);
1481	end;
1482
1483	{ Action menu events ----------------------------------------------------------------------- }
1484
1485	procedure TfrmConsults.mnuActCompleteClick(Sender: TObject);
1486	const
1487	IS_ID_CHILD = False;
1488	var
1489	NoteIEN: integer;
1490	ActionSts: TActionRec;
1491	UseClinProcTitles: boolean;
1492	begin
1493	inherited;
1494	if lstConsults.ItemIEN = 0 then exit;
1495	if MenuAccessRec.IsClinicalProcedure then
1496	begin
1497	case MenuAccessRec.ClinProcFlag of
1498	{1} CP_NO_INSTRUMENT : FActionType := CN_ACT_CP_COMPLETE;
1499	{2} CP_INSTR_NO_STUB : begin
1500	InfoBox(TX_CP_NO_RESULTS, TC_CP_NO_RESULTS, MB_OK or MB_ICONERROR);
1501	Exit;
1502	end;
1503	{3} CP_INSTR_INCOMPLETE : FActionType := CN_ACT_CP_COMPLETE;
1504	{4} CP_INSTR_COMPLETE : FActionType := CN_ACT_CP_COMPLETE;
1505	end;
1506	end
1507	else // {0} not a clinical procedure
1508	FActionType := TMenuItem(Sender).Tag ;
1509	if not StartNewEdit(NT_ACT_NEW_NOTE) then Exit;
1510
1511	SelectNoteForProcessing(Font.Size, FActionType, lstNotes.Items, NoteIEN, MenuAccessRec.ClinProcFlag);
1512	if NoteIEN > 0 then
1513	begin
1514	with tvCsltNotes do Selected := FindPieceNode(IntToStr(NoteIEN), 1, U, Items.GetFirstNode);
1515	if tvCsltNotes.Selected = nil then exit;
1516	ActOnDocument(ActionSts, lstNotes.ItemIEN, 'EDIT RECORD');
1517	if not ActionSts.Success then
1518	begin
1519	InfoBox(ActionSts.Reason, TX_IN_AUTH, MB_OK);
1520	Exit;
1521	end ;
1522	mnuActNoteEditClick(Self);
1523	end
1524	else if NoteIEN = StrToInt(CN_NEW_CP_NOTE) then
1525	begin
1526	// make sure a visit (time & location) is available before creating the note
1527	if Encounter.NeedVisit then
1528	begin
1529	UpdateVisit(Font.Size, DfltTIULocation);
1530	frmFrame.DisplayEncounterText;
1531	end;
1532	if Encounter.NeedVisit then
1533	begin
1534	InfoBox(TX_NEED_VISIT, TX_NO_VISIT, MB_OK or MB_ICONWARNING);
1535	Exit;
1536	end;
1537	SetResultMenus ;
1538	UseClinProcTitles := True;
1539	CompleteConsult(IS_ID_CHILD, 0, UseClinProcTitles);
1540	end
1541	else if NoteIEN = StrToInt(CN_NEW_CSLT_NOTE) then
1542	begin
1543	// make sure a visit (time & location) is available before creating the note
1544	if Encounter.NeedVisit then
1545	begin
1546	UpdateVisit(Font.Size, DfltTIULocation);
1547	frmFrame.DisplayEncounterText;
1548	end;
1549	if Encounter.NeedVisit then
1550	begin
1551	InfoBox(TX_NEED_VISIT, TX_NO_VISIT, MB_OK or MB_ICONWARNING);
1552	Exit;
1553	end;
1554	SetResultMenus ;
1555	UseClinProcTitles := False;
1556	CompleteConsult(IS_ID_CHILD, 0, UseClinProcTitles);
1557	end
1558	else if NoteIEN = -1 then Exit
1559	end;
1560
1561	procedure TfrmConsults.mnuActAddIDEntryClick(Sender: TObject);
1562	const
1563	IS_ID_CHILD = True;
1564	IS_CLIN_PROC = False;
1565	var
1566	AnIDParent: integer;
1567	//AConsultID: string;
1568	{ switches to current new note or creates a new note if none is being edited already }
1569	begin
1570	inherited;
1571	(* AConsultID := lstConsults.ItemID;*)
1572	AnIDParent := lstNotes.ItemIEN;
1573	if not StartNewEdit(NT_ACT_ID_ENTRY) then Exit;
1574	(* with tvConsults do Selected := FindPieceNode(AConsultID, 1, U, Items.GetFirstNode);
1575	with tvCsltNotes do Selected := FindPieceNode(IntToStr(AnIDParent), 1, U, Items.GetFirstNode);*)
1576
1577	// make sure a visit (time & location) is available before creating the note
1578	if Encounter.NeedVisit then
1579	begin
1580	UpdateVisit(Font.Size, DfltTIULocation);
1581	frmFrame.DisplayEncounterText;
1582	end;
1583	if Encounter.NeedVisit then
1584	begin
1585	InfoBox(TX_NEED_VISIT, TX_NO_VISIT, MB_OK or MB_ICONWARNING);
1586	Exit;
1587	end;
1588	CompleteConsult(IS_ID_CHILD, AnIDParent, IS_CLIN_PROC);
1589	end;
1590
1591	procedure TfrmConsults.mnuActMakeAddendumClick(Sender: TObject);
1592	var
1593	ActionSts: TActionRec;
1594	//ANoteID, AConsultID: string;
1595	begin
1596	inherited;
1597	if lstConsults.ItemIEN = 0 then exit;
1598	(* // ====== REMOVED IN V14 - superfluous with treeview in v15 ===========
1599	FActionType := TMenuItem(Sender).Tag ;
1600	SelectNoteForProcessing(Font.Size, FActionType, lstNotes.Items, NoteIEN);
1601	if NoteIEN = -1 then exit;
1602	//lstNotes.SelectByIEN(NoteIEN);
1603	with tvCsltNotes do Selected := FindPieceNode(IntToStr(NoteIEN), 1, U, Items.GetFirstNode);
1604	if tvCsltNotes.Selected = nil then exit;
1605	// ========================================*)
1606	if lstNotes.ItemIEN <= 0 then Exit;
1607	(* AConsultID := lstConsults.ItemID;
1608	ANoteID := lstNotes.ItemID;*)
1609	if lstNotes.ItemIndex = EditingIndex then
1610	begin
1611	InfoBox(TX_ADDEND_NO, TX_ADDEND_MK, MB_OK);
1612	Exit;
1613	end;
1614	if not StartNewEdit(NT_ACT_ADDENDUM) then Exit;
1615	(* with tvConsults do Selected := FindPieceNode(AConsultID, 1, U, Items.GetFirstNode);
1616	with tvCsltNotes do Selected := FindPieceNode(ANoteID, 1, U, Items.GetFirstNode);*)
1617	ActOnDocument(ActionSts, lstNotes.ItemIEN, 'MAKE ADDENDUM');
1618	if not ActionSts.Success then
1619	begin
1620	InfoBox(ActionSts.Reason, TX_IN_AUTH, MB_OK);
1621	Exit;
1622	end;
1623	with lstNotes do if TitleForNote(ItemIEN) = TYP_ADDENDUM then //v17.5 RV
1624	//with lstNotes do if Copy(Piece(Items[ItemIndex], U, 2), 1, 8) = 'Addendum' then
1625	begin
1626	InfoBox(TX_ADDEND_AD, TX_ADDEND_MK, MB_OK);
1627	Exit;
1628	end;
1629	SetResultMenus ;
1630	InsertAddendum;
1631	end;
1632
1633	procedure TfrmConsults.mnuActDetachFromIDParentClick(Sender: TObject);
1634	var
1635	DocID, WhyNot: string;
1636	Saved: boolean;
1637	SavedDocID, SavedConsultID: string;
1638	begin
1639	if lstNotes.ItemIEN = 0 then exit;
1640	SavedDocID := lstNotes.ItemID;
1641	if EditingIndex <> -1 then
1642	begin
1643	SaveCurrentNote(Saved);
1644	if not Saved then Exit;
1645	with tvConsults do Selected := FindPieceNode(SavedConsultID, 1, U, Items.GetFirstNode);
1646	tvConsultsClick(Self);
1647	with tvCsltNotes do Selected := FindPieceNode(SavedDocID, 1, U, Items.GetFirstNode);
1648	end;
1649	if not CanBeAttached(PDocTreeObject(tvCsltNotes.Selected.Data)^.DocID, WhyNot) then
1650	begin
1651	WhyNot := StringReplace(WhyNot, 'ATTACH', 'DETACH', [rfIgnoreCase]);
1652	WhyNot := StringReplace(WhyNot, 'to an ID', 'from an ID', [rfIgnoreCase]);
1653	InfoBox(WhyNot, TX_DETACH_FAILURE, MB_OK);
1654	Exit;
1655	end;
1656	if (InfoBox('DETACH: ' + tvCsltNotes.Selected.Text + CRLF + CRLF +
1657	' FROM: ' + tvCsltNotes.Selected.Parent.Text + CRLF + CRLF +
1658	'Are you sure?', TX_DETACH_CNF, MB_YESNO or MB_DEFBUTTON2 or MB_ICONQUESTION) <> IDYES)
1659	then Exit;
1660	DocID := PDocTreeObject(tvCsltNotes.Selected.Data)^.DocID;
1661	SavedDocID := PDocTreeObject(tvCsltNotes.Selected.Parent.Data)^.DocID;
1662	if DetachEntryFromParent(DocID, WhyNot) then
1663	begin
1664	tvConsultsChange(Self, tvConsults.Selected);
1665	with tvCsltNotes do Selected := FindPieceNode(SavedDocID, U, Items.GetFirstNode);
1666	if tvCsltNotes.Selected <> nil then tvCsltNotes.Selected.Expand(False);
1667	end
1668	else
1669	begin
1670	WhyNot := StringReplace(WhyNot, 'ATTACH', 'DETACH', [rfIgnoreCase]);
1671	WhyNot := StringReplace(WhyNot, 'to an ID', 'from an ID', [rfIgnoreCase]);
1672	InfoBox(WhyNot, TX_DETACH_FAILURE, MB_OK);
1673	end;
1674	end;
1675
1676	procedure TfrmConsults.mnuActSignatureListClick(Sender: TObject);
1677	{ add the note to the Encounter object, see mnuActSignatureSignClick - copied}
1678	const
1679	SIG_COSIGN = 'COSIGNATURE';
1680	SIG_SIGN = 'SIGNATURE';
1681	var
1682	ActionType, SignTitle: string;
1683	ActionSts: TActionRec;
1684	ErrMsg: string;
1685	begin
1686	inherited;
1687	if lstNotes.ItemIEN = 0 then Exit;
1688	if lstNotes.ItemIndex = EditingIndex then Exit; // already in signature list
1689	if LacksClinProcFieldsForSignature(lstNotes.ItemIEN, ErrMsg) then
1690	begin
1691	InfoBox(ErrMsg, TC_CLIN_PROC, MB_OK);
1692	Exit;
1693	end;
1694	if not NoteHasText(lstNotes.ItemIEN) then
1695	begin
1696	InfoBox(TX_EMPTY_NOTE1, TC_EMPTY_NOTE, MB_OK or MB_ICONERROR);
1697	Exit;
1698	end;
1699	if not LastSaveClean(lstNotes.ItemIEN) and
1700	(InfoBox(TX_ABSAVE, TC_ABSAVE, MB_YESNO or MB_DEFBUTTON2 or MB_ICONWARNING) <> IDYES) then Exit;
1701	if CosignDocument(lstNotes.ItemIEN) then
1702	begin
1703	SignTitle := TX_COSIGN;
1704	ActionType := SIG_COSIGN;
1705	end else
1706	begin
1707	SignTitle := TX_SIGN;
1708	ActionType := SIG_SIGN;
1709	end;
1710	ActOnDocument(ActionSts, lstNotes.ItemIEN, ActionType);
1711	if not ActionSts.Success then
1712	begin
1713	InfoBox(ActionSts.Reason, TX_IN_AUTH, MB_OK);
1714	Exit;
1715	end;
1716	LockConsultRequestAndNote(lstNotes.ItemIEN);
1717	with lstNotes do Changes.Add(CH_CON, ItemID, GetTitleText(ItemIndex), '', CH_SIGN_YES);
1718	end;
1719
1720
1721	procedure TfrmConsults.mnuActNoteDeleteClick(Sender: TObject);
1722	{ delete the selected progress note & remove from the Encounter object if necessary }
1723	var
1724	DeleteSts, ActionSts: TActionRec;
1725	SaveConsult, SavedDocIEN: Integer;
1726	ReasonForDelete, AVisitStr, SavedDocID, x: string;
1727	Saved: boolean;
1728	begin
1729	inherited;
1730	if lstNotes.ItemIEN = 0 then Exit;
1731	ActOnDocument(ActionSts, lstNotes.ItemIEN, 'DELETE RECORD');
1732	if ShowMsgOn(not ActionSts.Success, ActionSts.Reason, TX_IN_AUTH) then Exit;
1733	ReasonForDelete := SelectDeleteReason(lstNotes.ItemIEN);
1734	if ReasonForDelete = DR_CANCEL then Exit;
1735	// suppress prompt for deletion when called from SaveEditedNote (Sender = Self)
1736	if (Sender <> Self) and (InfoBox(MakeNoteDisplayText(lstNotes.Items[lstNotes.ItemIndex]) + TX_DEL_OK,
1737	TX_DEL_CNF, MB_YESNO or MB_DEFBUTTON2 or MB_ICONQUESTION) <> IDYES) then Exit;
1738	// do the appropriate locking
1739	if not LockConsultRequestAndNote(lstNotes.ItemIEN) then Exit;
1740	if JustifyDocumentDelete(lstNotes.ItemIEN) then
1741	InfoBox(TX_RETRACT, TX_RETRACT_CAP, MB_OK);
1742	SavedDocID := lstNotes.ItemID;
1743	SavedDocIEN := lstNotes.ItemIEN;
1744	if (EditingIndex > -1) and (not FConfirmed) and (lstNotes.ItemIndex <> EditingIndex) and (memResults.GetTextLen > 0) then
1745	begin
1746	SaveCurrentNote(Saved);
1747	if not Saved then Exit;
1748	end;
1749	EditingIndex := -1;
1750	FConfirmed := False;
1751	(* if Saved then
1752	begin
1753	EditingIndex := -1;
1754	mnuViewClick(Self);
1755	with tvCsltNotes do Selected := FindPieceNode(SavedDocID, U, Items.GetFirstNode);
1756	end;*)
1757	// remove the note
1758	DeleteSts.Success := True;
1759	x := GetPackageRefForNote(SavedDocIEN);
1760	SaveConsult := StrToIntDef(Piece(x, ';', 1), 0);
1761	//SaveConsult := GetConsultIENforNote(SavedDocIEN);
1762	AVisitStr := VisitStrForNote(SavedDocIEN);
1763	RemovePCEFromChanges(SavedDocIEN, AVisitStr);
1764	if (SavedDocIEN > 0) and (lstNotes.ItemIEN = SavedDocIEN)then DeleteDocument(DeleteSts, SavedDocIEN, ReasonForDelete);
1765	if not Changes.Exist(CH_CON, SavedDocID) then UnlockDocument(SavedDocIEN);
1766	Changes.Remove(CH_CON, SavedDocID); // this will unlock the document if in Changes
1767	UnlockConsultRequest(0, SaveConsult); // note has been deleted, so 1st param = 0
1768	// reset the display now that the note is gone
1769	if DeleteSts.Success then
1770	begin
1771	DeletePCE(AVisitStr); // removes PCE data if this was the only note pointing to it
1772	ClearEditControls;
1773	//ClearPtData; WRONG - fixed in v15.10 - RV
1774	cmdNewConsult.Visible := True;
1775	cmdNewProc.Top := cmdNewConsult.Top + cmdNewConsult.Height;
1776	cmdNewProc.Visible := True;
1777	pnlConsultList.Height := (pnlLeft.Height div 2);
1778	(* uChanging := True;
1779	with tvNotes do Selected := FindPieceNode(SavedDocID, U, Items.GetFirstNode);
1780	uChanging := False;
1781	if tvCsltNotes.Selected <> nil then tvCsltNotesChange(Self, tvCsltNotes.Selected) else
1782	begin*)
1783	pnlResults.Visible := False;
1784	pnlResults.SendToBack;
1785	pnlRead.Visible := True;
1786	pnlRead.BringToFront ;
1787	memConsult.TabStop := True;
1788	UpdateReminderFinish;
1789	ShowPCEControls(False);
1790	frmDrawers.DisplayDrawers(FALSE);
1791	cmdPCE.Visible := FALSE;
1792	popNoteMemoEncounter.Visible := FALSE;
1793	UpdateList;
1794	lstConsults.Enabled := True ;
1795	tvConsults.Enabled := True;
1796	with tvConsults do Selected := FindPieceNode(IntToStr(SaveConsult), 1, U, Items.GetFirstNode);
1797	tvConsultsClick(Self);
1798	(* lstConsults.SelectByIEN(ConsultRec.IEN);
1799	if lstConsults.ItemIEN > 0 then
1800	lstConsultsClick(Self) ;*)
1801	lstNotes.Enabled := True;
1802	(* uChanging := True;
1803	with tvNotes do Selected := FindPieceNode(SavedDocID, U, Items.GetFirstNode);
1804	uChanging := False;
1805	if tvCsltNotes.Selected <> nil then tvCsltNotesChange(Self, tvCsltNotes.Selected);
1806	end; {if ItemIndex}*)
1807	end {if DeleteSts}
1808	else InfoBox(DeleteSts.Reason, TX_DEL_ERR, MB_OK or MB_ICONWARNING);
1809	end;
1810
1811	procedure TfrmConsults.mnuActNoteEditClick(Sender: TObject);
1812	{ load the selected progress note for editing }
1813	var
1814	ActionSts: TActionRec;
1815	//AConsultID, ANoteID: string;
1816	begin
1817	inherited;
1818	if lstNotes.ItemIndex = EditingIndex then Exit;
1819	(* AConsultID := lstConsults.ItemID;
1820	ANoteID := lstNotes.ItemID;*)
1821	if not StartNewEdit(NT_ACT_EDIT_NOTE) then Exit;
1822	(* with tvConsults do Selected := FindPieceNode(AConsultID, 1, U, Items.GetFirstNode);
1823	with tvCsltNotes do Selected := FindPieceNode(ANoteID, 1, U, Items.GetFirstNode);*)
1824	ActOnDocument(ActionSts, lstNotes.ItemIEN, 'EDIT RECORD');
1825	if not ActionSts.Success then
1826	begin
1827	InfoBox(ActionSts.Reason, TX_IN_AUTH, MB_OK);
1828	Exit;
1829	end;
1830	LoadForEdit;
1831	end;
1832
1833	procedure TfrmConsults.mnuActSignatureSaveClick(Sender: TObject);
1834	{ saves the Consult that is currently being edited }
1835	var
1836	Saved: Boolean;
1837	// i: integer;
1838	SavedDocID, SavedCsltID, x: string;
1839	tmpNode: TORTreeNode;
1840	begin
1841	inherited;
1842	if EditingIndex > -1 then
1843	begin
1844	SavedDocID := Piece(lstNotes.Items[EditingIndex], U, 1);
1845	FLastNoteID := SavedDocID;
1846	SavedCsltID := lstConsults.ItemID;
1847	SaveCurrentNote(Saved) ;
1848	if Saved and (EditingIndex < 0) and (not FDeleted) then
1849	//if Saved then
1850	begin
1851	pnlResults.Visible := False;
1852	pnlResults.SendToBack;
1853	lstConsults.Enabled := True;
1854	tvConsults.Enabled := True;
1855	if Notifications.Active then
1856	with tvConsults do
1857	begin
1858	uChanging := True;
1859	Selected := FindPieceNode(SavedCsltID, 1, U, Items.GetFirstNode);
1860	if Selected <> nil then Selected.Delete;
1861	x := FindConsult(StrToIntDef(SavedCsltID, 0));
1862	tmpNode := TORTreeNode(Items.AddChildFirst(Items.GetFirstNode, MakeConsultListDisplayText(x)));
1863	tmpNode.StringData := x;
1864	SetNodeImage(tmpNode, FCurrentContext);
1865	uChanging := False;
1866	Selected := tmpNode;
1867	tvConsultsClick(Self);
1868	end
1869	else
1870	begin
1871	UpdateList ; {update consult list after success}
1872	with tvConsults do Selected := FindPieceNode(SavedCsltID, U, Items.GetFirstNode);
1873	tvConsultsClick(Self);
1874	with tvCsltNotes do Selected := FindPieceNode(SavedDocID, U, Items.GetFirstNode);
1875	end;
1876	pnlLeft.Refresh ;
1877	end;
1878	end
1879	else InfoBox(TX_NO_CONSULT, TX_SAVE_CONSULT, MB_OK or MB_ICONWARNING);
1880	if frmFrame.TimedOut then Exit;
1881	with tvCsltNotes do Selected := FindPieceNode(SavedDocID, U, Items.GetFirstNode);
1882	end;
1883
1884	procedure TfrmConsults.mnuActSignatureSignClick(Sender: TObject);
1885	{ sign the currently selected note, save first if necessary }
1886	const
1887	SIG_COSIGN = 'COSIGNATURE';
1888	SIG_SIGN = 'SIGNATURE';
1889	var
1890	Saved, NoteUnlocked: Boolean;
1891	ActionType, ESCode, SignTitle, x: string;
1892	ActionSts, SignSts: TActionRec;
1893	OK: boolean;
1894	tmpNode: TORTreeNode;
1895	SavedDocID, SavedCsltID, tmpItem, ErrMsg: string;
1896	EditingID: string; //v22.12 - RV
1897	begin
1898	inherited;
1899	(* if lstNotes.ItemIndex = EditingIndex then
1900	begin
1901	SaveCurrentNote(Saved);
1902	if (not Saved) or FDeleted then Exit;
1903	end
1904	else if EditingIndex > -1 then
1905	tmpItem := lstNotes.Items[EditingIndex];
1906	SavedDocID := lstNotes.ItemID;*)
1907	SavedCsltID := lstConsults.ItemID;
1908	SavedDocID := lstNotes.ItemID; //v22.12 - RV
1909	FLastNoteID := SavedDocID; //v22.12 - RV
1910	if lstNotes.ItemIndex = EditingIndex then //v22.12 - RV
1911	begin //v22.12 - RV
1912	SaveCurrentNote(Saved); //v22.12 - RV
1913	if (not Saved) or FDeleted then Exit; //v22.12 - RV
1914	end //v22.12 - RV
1915	else if EditingIndex > -1 then //v22.12 - RV
1916	begin //v22.12 - RV
1917	tmpItem := lstNotes.Items[EditingIndex]; //v22.12 - RV
1918	EditingID := Piece(tmpItem, U, 1); //v22.12 - RV
1919	end; //v22.12 - RV
1920	if LacksClinProcFieldsForSignature(lstNotes.ItemIEN, ErrMsg) then
1921	begin
1922	InfoBox(ErrMsg, TC_CLIN_PROC, MB_OK);
1923	Exit;
1924	end;
1925	if not NoteHasText(lstNotes.ItemIEN) then
1926	begin
1927	InfoBox(TX_EMPTY_NOTE1, TC_EMPTY_NOTE, MB_OK or MB_ICONERROR);
1928	Exit;
1929	end;
1930	if not LastSaveClean(lstNotes.ItemIEN) and
1931	(InfoBox(TX_ABSAVE, TC_ABSAVE, MB_YESNO or MB_DEFBUTTON2 or MB_ICONWARNING) <> IDYES) then Exit;
1932	if CosignDocument(lstNotes.ItemIEN) then
1933	begin
1934	SignTitle := TX_COSIGN;
1935	ActionType := SIG_COSIGN;
1936	end else
1937	begin
1938	SignTitle := TX_SIGN;
1939	ActionType := SIG_SIGN;
1940	end;
1941	if not LockConsultRequestAndNote(lstNotes.ItemIEN) then Exit;
1942	// no exits after things are locked
1943	NoteUnlocked := False;
1944	ActOnDocument(ActionSts, lstNotes.ItemIEN, ActionType);
1945	if ActionSts.Success then
1946	begin
1947	OK := IsOK2Sign(uPCEShow, lstNotes.ItemIEN);
1948	if frmFrame.Closing then exit;
1949	if(uPCEShow.Updated) then
1950	begin
1951	uPCEShow.CopyPCEData(uPCEEdit);
1952	uPCEShow.Updated := FALSE;
1953	lstNotesClick(Self);
1954	end;
1955	if not AuthorSignedDocument(lstNotes.ItemIEN) then
1956	begin
1957	if (InfoBox(TX_AUTH_SIGNED +
1958	GetTitleText(lstNotes.ItemIndex),TX_SIGN ,MB_YESNO)= ID_NO) then exit;
1959	end;
1960	if(OK) then
1961	begin
1962	with lstNotes do SignatureForItem(Font.Size, MakeConsultNoteDisplayText(Items[ItemIndex]), SignTitle, ESCode);
1963	if Length(ESCode) > 0 then
1964	begin
1965	SignDocument(SignSts, lstNotes.ItemIEN, ESCode);
1966	RemovePCEFromChanges(lstNotes.ItemIEN);
1967	NoteUnlocked := Changes.Exist(CH_CON, lstNotes.ItemID);
1968	Changes.Remove(CH_CON, lstNotes.ItemID); // this will unlock if in Changes
1969	if SignSts.Success then
1970	begin
1971	pnlResults.Visible := False;
1972	pnlResults.SendToBack;
1973	lstConsults.Enabled := True;
1974	tvConsults.Enabled := True;
1975	if Notifications.Active then
1976	with tvConsults do
1977	begin
1978	uChanging := True;
1979	Selected := FindPieceNode(SavedCsltID, 1, U, Items.GetFirstNode);
1980	if Selected <> nil then Selected.Delete;
1981	x := FindConsult(StrToIntDef(SavedCsltID, 0));
1982	tmpNode := TORTreeNode(Items.AddChildFirst(Items.GetFirstNode, MakeConsultListDisplayText(x)));
1983	tmpNode.StringData := x;
1984	SetNodeImage(tmpNode, FCurrentContext);
1985	uChanging := False;
1986	Selected := tmpNode;
1987	//tvConsultsClick(Self);
1988	end
1989	else
1990	begin
1991	UpdateList ; {update consult list after success}
1992	with tvConsults do Selected := FindPieceNode(SavedCsltID, U, Items.GetFirstNode);
1993	//tvConsultsClick(Self);
1994	//with tvCsltNotes do Selected := FindPieceNode(SavedDocID, U, Items.GetFirstNode);
1995	end;
1996	end
1997	else InfoBox(SignSts.Reason, TX_SIGN_ERR, MB_OK);
1998	end {if Length(ESCode)}
1999	else
2000	NoteUnlocked := Changes.Exist(CH_CON, lstNotes.ItemID);
2001	end;
2002	end
2003	else InfoBox(ActionSts.Reason, TX_IN_AUTH, MB_OK);
2004	if not NoteUnlocked then UnlockDocument(lstNotes.ItemIEN);
2005	UnlockConsultRequest(lstNotes.ItemIEN, StrToIntDef(SavedCsltID, 0)); // v20.4 RV (unlocking problem)
2006	//UnlockConsultRequest(lstNotes.ItemIEN, ConsultRec.IEN);
2007	tvConsultsClick(Self);
2008	//if EditingIndex > -1 then //v22.12 - RV
2009	if (EditingID <> '') then //v22.12 - RV
2010	begin
2011	lstNotes.Items.Insert(0, tmpItem);
2012	tmpNode := TORTreeNode(tvCsltNotes.Items.AddObjectFirst(tvCsltNotes.Items.GetFirstNode, 'Note being edited',
2013	MakeNoteTreeObject('EDIT^Note being edited^^^^^^^^^^^%^0')));
2014	tmpNode.StringData := 'EDIT^Note being edited^^^^^^^^^^^%^0';
2015	tmpNode.ImageIndex := IMG_TOP_LEVEL;
2016	tmpNode := TORTreeNode(tvCsltNotes.Items.AddChildObjectFirst(tmpNode, MakeConsultNoteDisplayText(tmpItem),
2017	MakeConsultsNoteTreeObject(tmpItem)));
2018	tmpNode.StringData := tmpItem;
2019	SetTreeNodeImagesAndFormatting(TORTreeNode(tmpNode), FCurrentNoteContext, CT_CONSULTS);
2020	EditingIndex := lstNotes.SelectByID(EditingID); //v22.12 - RV
2021	end;
2022	//with tvCsltNotes do Selected := FindPieceNode(SavedDocID, U, Items.GetFirstNode); //v22.12 - RV
2023	with tvCsltNotes do //v22.12 - RV
2024	begin //v22.12 - RV
2025	Selected := FindPieceNode(FLastNoteID, U, Items.GetFirstNode); //v22.12 - RV
2026	if Selected <> nil then tvCsltNotesChange(Self, Selected); //v22.12 - RV
2027	end;
2028	end;
2029
2030	procedure TfrmConsults.SaveSignItem(const ItemID, ESCode: string);
2031	{ saves and optionally signs a progress note or addendum }
2032	const
2033	SIG_COSIGN = 'COSIGNATURE';
2034	SIG_SIGN = 'SIGNATURE';
2035	var
2036	AnIndex, IEN, i: Integer;
2037	Saved, ContinueSign: Boolean; {RAB 8/26/99}
2038	ActionSts, SignSts: TActionRec;
2039	APCEObject: TPCEData;
2040	OK: boolean;
2041	SavedCsltID, x: string;
2042	tmpNode: TORTreeNode;
2043	ErrMsg: string;
2044	ActionType, SignTitle: string;
2045	begin
2046	AnIndex := -1;
2047	IEN := StrToIntDef(ItemID, 0);
2048	if IEN = 0 then Exit;
2049	x := GetPackageRefForNote(IEN);
2050	SavedCsltID := Piece(x, ';', 1);
2051	//SavedCsltID := IntToStr(GetConsultIENForNote(IEN));
2052	if frmFrame.TimedOut and (EditingIndex <> -1) then FSilent := True;
2053	with lstNotes do for i := 0 to Items.Count - 1 do if lstNotes.GetIEN(i) = IEN then
2054	begin
2055	AnIndex := i;
2056	break;
2057	end;
2058	if (AnIndex > -1) and (AnIndex = EditingIndex) then
2059	begin
2060	SaveCurrentNote(Saved);
2061	if not Saved then Exit;
2062	if FDeleted then
2063	begin
2064	FDeleted := False;
2065	Exit;
2066	end;
2067	AnIndex := lstNotes.SelectByIEN(IEN);
2068	//IEN := lstNotes.GetIEN(AnIndex); // saving will change IEN
2069	end;
2070	if Length(ESCode) > 0 then
2071	begin
2072	if CosignDocument(IEN) then
2073	begin
2074	SignTitle := TX_COSIGN;
2075	ActionType := SIG_COSIGN;
2076	end else
2077	begin
2078	SignTitle := TX_SIGN;
2079	ActionType := SIG_SIGN;
2080	end;
2081	ActOnDocument(ActionSts, IEN, ActionType);
2082	if not ActionSts.Success then
2083	begin
2084	InfoBox(ActionSts.Reason, TX_IN_AUTH, MB_OK);
2085	ContinueSign := False;
2086	end
2087	else if LacksClinProcFieldsForSignature(IEN, ErrMsg) then
2088	begin
2089	InfoBox(ErrMsg, TC_CLIN_PROC, MB_OK);
2090	ContinueSign := False;
2091	end
2092	else if not NoteHasText(IEN) then
2093	begin
2094	InfoBox(TX_EMPTY_NOTE1, TC_EMPTY_NOTE, MB_OK or MB_ICONERROR);
2095	ContinueSign := False;
2096	end
2097	else if not LastSaveClean(IEN) and
2098	(InfoBox(TX_ABSAVE, TC_ABSAVE, MB_YESNO or MB_DEFBUTTON2 or MB_ICONWARNING) <> IDYES)
2099	then ContinueSign := False
2100	else ContinueSign := True;
2101	if ContinueSign then
2102	begin
2103	if (AnIndex >= 0) and (AnIndex = lstNotes.ItemIndex) then
2104	APCEObject := uPCEShow
2105	else
2106	APCEObject := nil;
2107	OK := IsOK2Sign(APCEObject, IEN);
2108	if frmFrame.Closing then exit;
2109	if(assigned(APCEObject)) and (uPCEShow.Updated) then
2110	begin
2111	uPCEShow.CopyPCEData(uPCEEdit);
2112	uPCEShow.Updated := FALSE;
2113	lstNotesClick(Self);
2114	end
2115	else
2116	uPCEEdit.Clear;
2117	if(OK) then
2118	begin
2119	SignDocument(SignSts, IEN, ESCode);
2120	if not SignSts.Success then InfoBox(SignSts.Reason, TX_SIGN_ERR, MB_OK);
2121	end; {if OK}
2122	end; {if ContinueSign}
2123	end; {if Length(ESCode)}
2124
2125	UnlockConsultRequest(IEN);
2126	UnlockDocument(IEN);
2127	if (AnIndex = lstNotes.ItemIndex) and (not frmFrame.ContextChanging) then lstNotesClick(Self);
2128	if Notifications.Active then
2129	with tvConsults do
2130	begin
2131	if (AnIndex = lstNotes.ItemIndex) and (not frmFrame.ContextChanging) then lstNotesClick(Self);
2132	uChanging := True;
2133	Selected := FindPieceNode(SavedCsltID, 1, U, Items.GetFirstNode);
2134	if Selected <> nil then Selected.Delete;
2135	x := FindConsult(StrToIntDef(SavedCsltID, 0));
2136	tmpNode := TORTreeNode(Items.AddChildFirst(Items.GetFirstNode, MakeConsultListDisplayText(x)));
2137	tmpNode.StringData := x;
2138	SetNodeImage(tmpNode, FCurrentContext);
2139	uChanging := False;
2140	Selected := tmpNode;
2141	tvConsultsClick(Self);
2142	end
2143	else
2144	begin
2145	UpdateList ; {update consult list after success}
2146	if (AnIndex = lstNotes.ItemIndex) and (not frmFrame.ContextChanging) then lstNotesClick(Self);
2147	with tvConsults do Selected := FindPieceNode(SavedCsltID, U, Items.GetFirstNode);
2148	tvConsultsClick(Self);
2149	with tvCsltNotes do Selected := FindPieceNode(IntToStr(IEN), U, Items.GetFirstNode);
2150	end;
2151	pnlLeft.Refresh ;
2152	end ;
2153
2154	procedure TfrmConsults.cmdPCEClick(Sender: TObject);
2155	begin
2156	inherited;
2157	cmdPCE.Enabled := False;
2158	UpdatePCE(uPCEEdit);
2159	cmdPCE.Enabled := True;
2160	if frmFrame.Closing then exit;
2161	DisplayPCE;
2162	end;
2163
2164	procedure TfrmConsults.mnuActConsultClick(Sender: TObject);
2165	var
2166	// i:integer ;
2167	Saved, IsProcedure: boolean;
2168	SavedCsltID, x: string;
2169	tmpNode: TORTreeNode;
2170	begin
2171	inherited;
2172	if lstConsults.ItemIEN = 0 then exit;
2173	SavedCsltID := lstConsults.ItemID;
2174	if EditingIndex <> -1 then
2175	begin
2176	SaveCurrentNote(Saved);
2177	if not Saved then Exit;
2178	end;
2179	FOrderID := Piece(lstConsults.Items[lstConsults.ItemIndex], U, 6);
2180	if not LockConsultRequest(lstConsults.ItemIEN) then Exit;
2181	FActionType := TMenuItem(Sender).Tag ;
2182	ClearEditControls ;
2183	lstNotes.Enabled := False ;
2184	lstConsults.Enabled := False ;
2185	tvConsults.Enabled := False;
2186	x := Piece(lstConsults.Items[lstConsults.ItemIndex], U, 12);
2187	if x <> '' then
2188	IsProcedure := (x[1] in ['P', 'M'])
2189	else
2190	IsProcedure := (Piece(lstConsults.Items[lstConsults.ItemIndex], U, 9) = 'Procedure');
2191	//if SetActionContext(Font.Size,FActionType, IsProcedure, ConsultRec.ConsultProcedure) then
2192	if SetActionContext(Font.Size,FActionType, IsProcedure, ConsultRec.ConsultProcedure, MenuAccessRec.UserLevel) then
2193	begin
2194	if Notifications.Active then
2195	with tvConsults do
2196	begin
2197	uChanging := True;
2198	Selected := FindPieceNode(SavedCsltID, 1, U, Items.GetFirstNode);
2199	if Selected <> nil then Selected.Delete;
2200	x := FindConsult(StrToIntDef(SavedCsltID, 0));
2201	tmpNode := TORTreeNode(Items.AddChildFirst(Items.GetFirstNode, MakeConsultListDisplayText(x)));
2202	tmpNode.StringData := x;
2203	SetNodeImage(tmpNode, FCurrentContext);
2204	uChanging := False;
2205	Selected := tmpNode;
2206	tvConsultsClick(Self);
2207	end
2208	(* with tvConsults do
2209	begin
2210	Selected := FindPieceNode(IntToStr(ConsultRec.IEN), 1, U, Items.GetFirstNode);
2211	if Selected <> nil then Selected.Delete;
2212	Items.AddFirst(nil, FindConsult(ConsultRec.IEN));
2213	Selected := FindPieceNode(IntToStr(ConsultRec.IEN), 1, U, Items.GetFirstNode);
2214	end*)
2215	else
2216	begin
2217	UpdateList ; {update consult list after success}
2218	with tvConsults do Selected := FindPieceNode(SavedCsltID, U, Items.GetFirstNode);
2219	tvConsultsClick(Self);
2220	end;
2221	end;
2222	UnlockConsultRequest(lstNotes.ItemIEN, StrToIntDef(SavedCsltID, 0)); // v20.4 RV (unlocking problem)
2223	//UnlockConsultRequest(lstNotes.ItemIEN, lstConsults.ItemIEN);
2224	lstNotes.Enabled := True ;
2225	lstConsults.Enabled := True ;
2226	tvConsults.Enabled := True;
2227	end;
2228
2229	procedure TfrmConsults.UpdateList;
2230	begin
2231	{ call this after performing some action on a consult that changes its status
2232	or its service }
2233	case ViewContext of
2234	CC_ALL : begin
2235	FillChar(FCurrentContext, SizeOf(FCurrentContext), 0);
2236	lblConsults.Caption := 'All Consults' ;
2237	FCurrentContext.Ascending := False;
2238	end;
2239	CC_BY_STATUS : begin
2240	with StsCtxt do if Changed then
2241	begin
2242	FillChar(FCurrentContext, SizeOf(FCurrentContext), 0);
2243	lblConsults.Caption := 'All ' + StatusName + ' Consults';
2244	FCurrentContext.Status := Status;
2245	FCurrentContext.Ascending := Ascending;
2246	end;
2247	end;
2248	CC_BY_SERVICE : begin
2249	with SvcCtxt do if Changed then
2250	begin
2251	FillChar(FCurrentContext, SizeOf(FCurrentContext), 0);
2252	lblConsults.Caption := 'Consults to ' + ServiceName;
2253	FCurrentContext.Service := Service;
2254	FCurrentContext.Ascending := Ascending;
2255	end;
2256	end;
2257	CC_BY_DATE : begin
2258	with DateRange do if Changed then
2259	begin
2260	FillChar(FCurrentContext, SizeOf(FCurrentContext), 0);
2261	lblConsults.Caption := FormatFMDateTime('mmm dd,yy', StrToFMDateTime(BeginDate)) + ' to ' +
2262	FormatFMDateTime('mmm dd,yy', StrToFMDateTime(EndDate));
2263	FCurrentContext.BeginDate := BeginDate;
2264	FCurrentContext.EndDate := EndDate;
2265	FCurrentContext.Ascending := Ascending;
2266	end;
2267	end;
2268	CC_CUSTOM : begin
2269	with uSelectContext do if Changed then
2270	begin
2271	FillChar(FCurrentContext, SizeOf(FCurrentContext), 0);
2272	with lblConsults do if Caption <> 'Default List' then Caption := 'Custom List' ;
2273	FCurrentContext.BeginDate := BeginDate;
2274	FCurrentContext.EndDate := EndDate;
2275	FCurrentContext.Status := Status;
2276	FCurrentContext.Service := Service;
2277	FCurrentContext.GroupBy := GroupBy;
2278	FCurrentContext.Ascending := Ascending;
2279	end ;
2280	end ;
2281	end; {case}
2282	tvConsults.Caption := lblConsults.Caption;
2283	if not frmFrame.ContextChanging then LoadConsults;
2284	end ;
2285
2286	procedure TfrmConsults.SetActionMenus ;
2287	{Set available menu actions based on consult status and user access to consult's service}
2288	var
2289	status: integer ;
2290	begin
2291
2292	FillChar(MenuAccessRec, SizeOf(MenuAccessRec), 0);
2293	if (lstConsults.ItemIndex < 0) then
2294	begin
2295	mnuAct.Enabled := False ;
2296	exit ;
2297	end
2298	else
2299	begin
2300	MenuAccessRec := GetActionMenuLevel(ConsultRec.IEN) ;
2301	status := ConsultRec.ORStatus ;
2302	end ;
2303
2304
2305	with MenuAccessRec do
2306	begin
2307	// mnuAct.Enabled := (UserLevel > 1) ; {'User Review' menu level = 1 }
2308	{'Service Action' menu level = 2 }
2309
2310	mnuActConsultRequest.Enabled := (lstConsults.ItemIEN > 0);
2311	mnuActReceive.Enabled := (UserLevel > UL_REVIEW)
2312	and (status=ST_PENDING);
2313	mnuActSchedule.Enabled := (UserLevel > UL_REVIEW)
2314	and ((status=ST_PENDING)
2315	or (status=ST_ACTIVE));
2316	mnuActDeny.Enabled := (UserLevel > UL_REVIEW)
2317	and ((status<>ST_DISCONTINUED)
2318	and (status<>ST_COMPLETE)
2319	and (status<>ST_CANCELLED)
2320	and (status<>ST_PARTIAL_RESULTS)) ;
2321	(* mnuActEditResubmit.Enabled := {(UserLevel > 1) and }(Notifications.Active)
2322	{if the user received the alert,} and (lstConsults.ItemIEN = CurrNotifIEN)
2323	{ this menu should be available } and (status = ST_CANCELLED)
2324	and (not User.NoOrdering);*)
2325	{if processing an alert - NO CHANGE HERE}
2326	if Notifications.Active and (lstConsults.ItemIEN = CurrNotifIEN) then
2327	mnuActEditResubmit.Enabled := ((lstConsults.ItemIEN = CurrNotifIEN) and)
2328	(status = ST_CANCELLED) and
2329	(not User.NoOrdering)
2330	{if not processing an alert, check other stuff}
2331	else
2332	mnuActEditResubmit.Enabled := AllowResubmit and
2333	(status = ST_CANCELLED) and
2334	(not User.NoOrdering);
2335	mnuActForward.Enabled := (UserLevel > UL_REVIEW)
2336	and ((status<>ST_DISCONTINUED)
2337	and (status<>ST_COMPLETE)
2338	and (status<>ST_CANCELLED)) ;
2339	mnuActDiscontinue.Enabled := (UserLevel > UL_REVIEW)
2340	and ((status<>ST_DISCONTINUED)
2341	and (status<>ST_COMPLETE)
2342	and (status<>ST_CANCELLED)
2343	and (status<>ST_PARTIAL_RESULTS)) ;
2344	mnuActSigFindings.Enabled := (UserLevel > UL_REVIEW)
2345	and ((status<>ST_DISCONTINUED)
2346	and (status<>ST_CANCELLED));
2347	mnuActAdminComplete.Enabled := ((UserLevel = UL_ADMIN) or (UserLevel = UL_UPDATE_AND_ADMIN))
2348	and ((status<>ST_DISCONTINUED)
2349	and (status<>ST_COMPLETE)
2350	and (status<>ST_CANCELLED));
2351
2352	mnuActAddComment.Enabled := True;
2353	mnuActDisplayDetails.Enabled := True;
2354	mnuActDisplayResults.Enabled := True;
2355	mnuActDisplaySF513.Enabled := True;
2356	mnuActPrintSF513.Enabled := True;
2357	mnuActConsultResults.Enabled := (lstConsults.ItemIEN > 0) and
2358	(((UserLevel = UL_UPDATE) or (UserLevel = UL_UPDATE_AND_ADMIN) or (UserLevel = UL_UNRESTRICTED)) and
2359	((status<>ST_DISCONTINUED) and
2360	(status<>ST_CANCELLED)))
2361	or
2362	(lstConsults.ItemIEN > 0) and
2363	((AllowMedResulting) and
2364	((status<>ST_DISCONTINUED) and
2365	(status<>ST_CANCELLED)))
2366	or
2367	(lstConsults.ItemIEN > 0) and
2368	((AllowMedDissociate) and
2369	((status = ST_COMPLETE)))
2370	or
2371	((Notifications.Active) and
2372	(lstConsults.ItemIEN = CurrNotifIEN) and
2373	(Notifications.FollowUp = NF_CONSULT_UNSIGNED_NOTE) and
2374	(lstNotes.ItemIndex > -1));
2375	cmdEditResubmit.Visible := mnuActEditResubmit.Enabled;
2376	end;
2377	end ;
2378
2379	procedure TfrmConsults.SetResultMenus ;
2380	var
2381	WhyNot: string;
2382	begin
2383	mnuActComplete.Enabled := mnuActConsultResults.Enabled and
2384	((MenuAccessRec.UserLevel = UL_UPDATE) or
2385	(MenuAccessRec.UserLevel = UL_UPDATE_AND_ADMIN) or
2386	(MenuAccessRec.UserLevel = UL_UNRESTRICTED))
2387	and
2388	((ConsultRec.ORStatus=ST_PENDING) or
2389	(ConsultRec.ORStatus=ST_ACTIVE) or
2390	(ConsultRec.ORStatus=ST_SCHEDULED) or
2391	(ConsultRec.ORStatus=ST_PARTIAL_RESULTS) or
2392	(ConsultRec.ORStatus=ST_COMPLETE)) ;
2393	mnuActMakeAddendum.Enabled := mnuActConsultResults.Enabled and
2394	((MenuAccessRec.UserLevel = UL_UPDATE) or
2395	(MenuAccessRec.UserLevel = UL_UPDATE_AND_ADMIN) or
2396	(MenuAccessRec.UserLevel = UL_UNRESTRICTED))
2397	and
2398	(ConsultRec.ORStatus=ST_COMPLETE) and
2399	((lstNotes.ItemIndex > -1) and
2400	((ConsultRec.TIUResultNarrative>0) or
2401	(lstNotes.ItemIEN > 0)));
2402	mnuActAddIDEntry.Enabled := mnuActConsultResults.Enabled and
2403	uIDNotesActive and
2404	(tvCsltNotes.Selected <> nil) and
2405	(tvCsltNotes.Selected.ImageIndex in [IMG_SINGLE, IMG_PARENT,
2406	IMG_IDNOTE_OPEN, IMG_IDNOTE_SHUT, IMG_IDPAR_ADDENDA_OPEN,
2407	IMG_IDPAR_ADDENDA_SHUT]) and
2408	CanReceiveAttachment(PDocTreeObject(tvCsltNotes.Selected.Data)^.DocID, WhyNot);
2409	mnuActDetachFromIDParent.Enabled := mnuActConsultResults.Enabled and
2410	uIDNotesActive and
2411	(tvCsltNotes.Selected <> nil) and
2412	(tvCsltNotes.Selected.ImageIndex in [IMG_ID_CHILD, IMG_ID_CHILD_ADD]);
2413	mnuActAttachMed.Enabled := mnuActConsultResults.Enabled and
2414	(((mnuActComplete.Enabled) or
2415	(MenuAccessRec.UserLevel = UL_ADMIN) or
2416	(MenuAccessRec.UserLevel = UL_UPDATE_AND_ADMIN)))
2417	and (MenuAccessRec.AllowMedResulting);
2418	mnuActRemoveMed.Enabled := mnuActConsultResults.Enabled and
2419	((ConsultRec.ORStatus=ST_COMPLETE) and (MenuAccessRec.AllowMedDissociate));
2420	mnuActNoteEdit.Enabled := mnuActConsultResults.Enabled and
2421	((lstNotes.ItemIndex > -1) and
2422	((ConsultRec.TIUResultNarrative>0) or
2423	(lstNotes.ItemIEN > 0) or
2424	(FActionType = CN_ACT_COMPLETE) or
2425	(FActionType = CN_ACT_ADDENDUM)));
2426	mnuActNoteDelete.Enabled := mnuActConsultResults.Enabled and
2427	((lstNotes.ItemIndex > -1) and
2428	((ConsultRec.TIUResultNarrative>0) or
2429	(lstNotes.ItemIEN > 0) or
2430	(FActionType = CN_ACT_COMPLETE) or
2431	(FActionType = CN_ACT_ADDENDUM)));
2432	mnuActSignatureSign.Enabled := mnuActConsultResults.Enabled and
2433	((lstNotes.ItemIndex > -1) and
2434	((ConsultRec.TIUResultNarrative>0) or
2435	(lstNotes.ItemIEN > 0) or
2436	(FActionType = CN_ACT_COMPLETE) or
2437	(FActionType = CN_ACT_ADDENDUM)))
2438	or
2439	((Notifications.Active) and
2440	(lstConsults.ItemIEN = CurrNotifIEN) and
2441	(Notifications.FollowUp = NF_CONSULT_UNSIGNED_NOTE) and
2442	(lstNotes.ItemIndex > -1));
2443	mnuActSignatureList.Enabled := mnuActConsultResults.Enabled and
2444	((lstNotes.ItemIndex > -1) and
2445	((ConsultRec.TIUResultNarrative>0) or
2446	(lstNotes.ItemIEN > 0) or
2447	(FActionType = CN_ACT_COMPLETE) or
2448	(FActionType = CN_ACT_ADDENDUM)))
2449	or
2450	((Notifications.Active) and
2451	(lstConsults.ItemIEN = CurrNotifIEN) and
2452	(Notifications.FollowUp = NF_CONSULT_UNSIGNED_NOTE) and
2453	(lstNotes.ItemIndex > -1));
2454	mnuActSignatureSave.Enabled := mnuActConsultResults.Enabled and
2455	((lstNotes.ItemIndex > -1) and
2456	((ConsultRec.TIUResultNarrative>0) or
2457	(lstNotes.ItemIEN > 0) or
2458	(FActionType = CN_ACT_COMPLETE) or
2459	(FActionType = CN_ACT_ADDENDUM)));
2460	mnuActIdentifyAddlSigners.Enabled := mnuActConsultResults.Enabled and
2461	((lstNotes.ItemIndex > -1) and
2462	((ConsultRec.TIUResultNarrative>0) or
2463	(lstNotes.ItemIEN > 0)));
2464	mnuActNotePrint.Enabled := mnuActConsultResults.Enabled and
2465	((lstNotes.ItemIndex > -1) and
2466	((ConsultRec.TIUResultNarrative>0) or
2467	(lstNotes.ItemIEN > 0)));
2468	mnuActChange.Enabled := mnuActConsultResults.Enabled and
2469	((lstNotes.ItemIndex > -1) and (lstNotes.ItemIndex = EditingIndex));
2470	mnuActLoadBoiler.Enabled := mnuActConsultResults.Enabled and
2471	((lstNotes.ItemIndex > -1) and (lstNotes.ItemIndex = EditingIndex));
2472
2473	if ((lstNotes.ItemIndex > -1) and UserIsSigner(lstNotes.ItemIEN)) then
2474	begin
2475	mnuActSignatureList.Enabled := True;
2476	mnuActSignatureSign.Enabled := True;
2477	mnuActConsultResults.Enabled := True;
2478	end;
2479
2480	popNoteMemoSignList.Enabled := //(mnuActConsultResults.Enabled) and
2481	(mnuActSignatureList.Enabled) ;
2482	popNoteMemoSign.Enabled := //(mnuActConsultResults.Enabled) and
2483	mnuActSignatureSign.Enabled ;
2484	popNoteMemoSave.Enabled := //(mnuActConsultResults.Enabled) and
2485	mnuActSignatureSave.Enabled ;
2486	popNoteMemoEdit.Enabled := //(mnuActConsultResults.Enabled) and
2487	mnuActNoteEdit.Enabled;
2488	popNoteMemoAddend.Enabled := //(mnuActConsultResults.Enabled) and
2489	mnuActMakeAddendum.Enabled;
2490	popNoteMemoDelete.Enabled := //(mnuActConsultResults.Enabled) and
2491	mnuActNoteDelete.Enabled;
2492	popNoteMemoAddlSign.Enabled := //(mnuActConsultResults.Enabled) and
2493	mnuActIdentifyAddlSigners.Enabled;
2494	popNoteMemoPrint.Enabled := (mnuActNotePrint.Enabled);
2495	end;
2496
2497	procedure TfrmConsults.DisplayPCE;
2498	{ displays PCE information if appropriate & enables/disables editing of PCE data }
2499	var
2500	EnableList, ShowList: TDrawers;
2501	VitalStr: TStringlist;
2502	NoPCE: boolean;
2503	ActionSts: TActionRec;
2504
2505	begin
2506	if (lstNotes.ItemIndex=-1) or (lstNotes.Items.Count=0) then exit ;
2507	memPCEShow.Clear;
2508	with lstNotes do if ItemIndex = EditingIndex then
2509	begin
2510	with uPCEEdit do
2511	begin
2512	AddStrData(memPCEShow.Lines);
2513	NoPCE := (memPCEShow.Lines.Count = 0);
2514	VitalStr := TStringList.create;
2515	try
2516	GetVitalsFromDate(VitalStr, uPCEEdit);
2517	AddVitalData(VitalStr, memPCEShow.Lines);
2518	finally
2519	VitalStr.free;
2520	end;
2521	cmdPCE.Enabled := CanEditPCE(uPCEEdit);
2522	ShowPCEControls(cmdPCE.Enabled or (memPCEShow.Lines.Count > 0));
2523	if(NoPCE and memPCEShow.Visible) then
2524	memPCEShow.Lines.Insert(0, TX_NOPCE);
2525
2526	if(InteractiveRemindersActive) then
2527	begin
2528	if(GetReminderStatus = rsNone) then
2529	EnableList := [odTemplates]
2530	else
2531	EnableList := [odTemplates, odReminders];
2532	ShowList := [odTemplates, odReminders];
2533	end
2534	else
2535	begin
2536	EnableList := [odTemplates];
2537	ShowList := [odTemplates];
2538	end;
2539	frmDrawers.Visible := True;
2540	frmDrawers.DisplayDrawers(TRUE, EnableList, ShowList);
2541	cmdNewConsult.Visible := False;
2542	cmdNewProc.Visible := False;
2543	pnlConsultList.Height := (pnlLeft.Height div 5);
2544
2545	cmdPCE.Visible := TRUE;
2546	end;
2547	end else
2548	begin
2549	//VitalStr := TStringList.create;
2550	//VitalStr.clear;
2551	cmdPCE.Enabled := False;
2552
2553	frmDrawers.Visible := False;
2554	frmDrawers.DisplayDrawers(FALSE);
2555	cmdPCE.Visible := FALSE;
2556	cmdNewConsult.Visible := True;
2557	cmdNewProc.Top := cmdNewConsult.Top + cmdNewConsult.Height;
2558	cmdNewProc.Visible := True;
2559	pnlConsultList.Height := (pnlLeft.Height div 2);
2560	//pnlConsultList.Height := 3 * (pnlLeft.Height div 5);
2561
2562	ActOnDocument(ActionSts, lstNotes.ItemIEN, 'VIEW');
2563	if ActionSts.Success then
2564	begin
2565	StatusText('Retrieving encounter information...');
2566	with uPCEShow do
2567	begin
2568	NoteDateTime := MakeFMDateTime(Piece(lstNotes.Items[lstNotes.ItemIndex], U, 3));
2569	PCEForNote(lstNotes.ItemIEN, uPCEEdit);
2570	AddStrData(memPCEShow.Lines);
2571	NoPCE := (memPCEShow.Lines.Count = 0);
2572	VitalStr := TStringList.create;
2573	try
2574	GetVitalsFromNote(VitalStr, uPCEShow, lstNotes.ItemIEN);
2575	AddVitalData(VitalStr, memPCEShow.Lines);
2576	finally
2577	VitalStr.free;
2578	end;
2579	ShowPCEControls(memPCEShow.Lines.Count > 0);
2580	if(NoPCE and memPCEShow.Visible) then
2581	memPCEShow.Lines.Insert(0, TX_NOPCE);
2582	end;
2583	StatusText('');
2584	end
2585	else
2586	ShowPCEControls(FALSE);
2587	end; {if ItemIndex}
2588	memPCEShow.SelStart := 0;
2589	popNoteMemoEncounter.Enabled := cmdPCE.Enabled;
2590	popNoteMemoEncounter.Visible := cmdPCE.Visible;
2591	end;
2592
2593	procedure TfrmConsults.ShowPCEControls(ShouldShow: Boolean);
2594	begin
2595	sptVert.Visible := ShouldShow;
2596	memPCEShow.Visible := ShouldShow;
2597	if(ShouldShow) then
2598	sptVert.Top := memPCEShow.Top - sptVert.Height;
2599	memResults.Invalidate;
2600	end;
2601
2602	procedure TfrmConsults.RemovePCEFromChanges(IEN: Integer; AVisitStr: string = '');
2603	begin
2604	if IEN = CN_ADDENDUM then Exit; // no PCE information entered for an addendum
2605	if AVisitStr = '' then AVisitStr := VisitStrForNote(IEN);
2606	Changes.Remove(CH_PCE, 'V' + AVisitStr);
2607	Changes.Remove(CH_PCE, 'P' + AVisitStr);
2608	Changes.Remove(CH_PCE, 'D' + AVisitStr);
2609	Changes.Remove(CH_PCE, 'I' + AVisitStr);
2610	Changes.Remove(CH_PCE, 'S' + AVisitStr);
2611	Changes.Remove(CH_PCE, 'A' + AVisitStr);
2612	Changes.Remove(CH_PCE, 'H' + AVisitStr);
2613	Changes.Remove(CH_PCE, 'E' + AVisitStr);
2614	Changes.Remove(CH_PCE, 'T' + AVisitStr);
2615	end;
2616
2617	procedure TfrmConsults.lstNotesClick(Sender: TObject);
2618	{ loads the text for the selected note or displays the editing panel for the selected note }
2619	var
2620	x: string;
2621	begin
2622	inherited;
2623	if (lstNotes.ItemIEN = -1) then exit ;
2624	with lstNotes do
2625	if ItemIndex = EditingIndex then
2626	begin
2627	lstConsults.Enabled := False ;
2628	tvConsults.Enabled := False;
2629	pnlResults.Visible := True;
2630	pnlResults.BringToFront;
2631	memConsult.TabStop := False;
2632	mnuActChange.Enabled := True;
2633	mnuActLoadBoiler.Enabled := True;
2634	UpdateReminderFinish;
2635	end
2636	else
2637	begin
2638	StatusText('Retrieving selected item...');
2639	if EditingIndex = -1 then
2640	begin
2641	lstConsults.Enabled := True ;
2642	tvConsults.Enabled := True;
2643	end;
2644	lblTitle.Caption := MakeConsultNoteDisplayText(lstNotes.Items[lstNotes.ItemIndex]);
2645	lblTitle.Hint := lblTitle.Caption;
2646	lstNotes.Enabled := True ;
2647	pnlResults.Visible := False;
2648	UpdateReminderFinish;
2649	pnlRead.BringToFront;
2650	memConsult.TabStop := True;
2651	if Copy(Piece(lstNotes.ItemID, ';', 2), 1, 4)= 'MCAR' then
2652	begin
2653	QuickCopy(GetDetailedMedicineResults(lstNotes.ItemID), memConsult);
2654	x := Piece(Piece(Piece(lstNotes.ItemID, ';', 2), '(', 2), ',', 1) + ';' + Piece(lstNotes.ItemID, ';', 1);
2655	x := 'MED^' + x;
2656	SetPiece(x, U, 10, Piece(lstNotes.Items[lstNotes.ItemIndex], U, 11));
2657	NotifyOtherApps(NAE_REPORT, x);
2658	end
2659	else
2660	begin
2661	LoadDocumentText(memConsult.Lines,ItemIEN) ;
2662	mnuActChange.Enabled := False;
2663	mnuActLoadBoiler.Enabled := False;
2664	x := 'TIU^' + lstNotes.ItemID;
2665	SetPiece(x, U, 10, Piece(lstNotes.Items[lstNotes.ItemIndex], U, 11));
2666	NotifyOtherApps(NAE_REPORT, x);
2667	end;
2668	memConsult.SelStart := 0;
2669	end;
2670	if Copy(Piece(lstNotes.ItemID, ';', 2), 1, 4) <> 'MCAR' then
2671	begin
2672	if(assigned(frmReminderTree)) then frmReminderTree.EnableActions;
2673	DisplayPCE;
2674	end;
2675	pnlRight.Refresh;
2676	memConsult.Repaint;
2677	memResults.Repaint;
2678	SetResultMenus;
2679	StatusText('');
2680	end;
2681
2682	procedure TfrmConsults.popNoteMemoPopup(Sender: TObject);
2683	begin
2684	inherited;
2685	if PopupComponent(Sender, popNoteMemo) is TCustomEdit
2686	then FEditCtrl := TCustomEdit(PopupComponent(Sender, popNoteMemo))
2687	else FEditCtrl := nil;
2688	if FEditCtrl <> nil then
2689	begin
2690	popNoteMemoCut.Enabled := FEditCtrl.SelLength > 0;
2691	popNoteMemoCopy.Enabled := popNoteMemoCut.Enabled;
2692	popNoteMemoPaste.Enabled := (not TORExposedCustomEdit(FEditCtrl).ReadOnly) and
2693	Clipboard.HasFormat(CF_TEXT);
2694	popNoteMemoTemplate.Enabled := frmDrawers.CanEditTemplates and popNoteMemoCut.Enabled;
2695	popNoteMemoFind.Enabled := FEditCtrl.GetTextLen > 0;
2696	end
2697	else
2698	begin
2699	popNoteMemoCut.Enabled := False;
2700	popNoteMemoCopy.Enabled := False;
2701	popNoteMemoPaste.Enabled := False;
2702	popNoteMemoTemplate.Enabled := False;
2703	end;
2704	if pnlResults.Visible then
2705	begin
2706	popNoteMemoSpell.Enabled := True;
2707	popNoteMemoGrammar.Enabled := True;
2708	popNoteMemoReformat.Enabled := True;
2709	popNoteMemoReplace.Enabled := (FEditCtrl.GetTextLen > 0);
2710	popNoteMemoPreview.Enabled := (frmDrawers.TheOpenDrawer = odTemplates) and Assigned(frmDrawers.tvTemplates.Selected);
2711	popNoteMemoInsTemplate.Enabled := (frmDrawers.TheOpenDrawer = odTemplates) and Assigned(frmDrawers.tvTemplates.Selected);
2712	end else
2713	begin
2714	popNoteMemoSpell.Enabled := False;
2715	popNoteMemoGrammar.Enabled := False;
2716	popNoteMemoReformat.Enabled := False;
2717	popNoteMemoReplace.Enabled := False;
2718	popNoteMemoPreview.Enabled := False;
2719	popNoteMemoInsTemplate.Enabled := False;
2720	end;
2721	end;
2722
2723	procedure TfrmConsults.popNoteMemoCutClick(Sender: TObject);
2724	begin
2725	inherited;
2726	FEditCtrl.CutToClipboard;
2727	end;
2728
2729	procedure TfrmConsults.popNoteMemoCopyClick(Sender: TObject);
2730	begin
2731	inherited;
2732	FEditCtrl.CopyToClipboard;
2733	end;
2734
2735	procedure TfrmConsults.popNoteMemoPasteClick(Sender: TObject);
2736	begin
2737	inherited;
2738	FEditCtrl.SelText := Clipboard.AsText; {KCM}
2739	//FEditCtrl.PasteFromClipboard; // use AsText to prevent formatting
2740	end;
2741
2742	procedure TfrmConsults.popNoteMemoReformatClick(Sender: TObject);
2743	begin
2744	inherited;
2745	if Screen.ActiveControl <> memResults then Exit;
2746	ReformatMemoParagraph(memResults);
2747	end;
2748
2749	procedure TfrmConsults.popNoteMemoFindClick(Sender: TObject);
2750	begin
2751	inherited;
2752	SendMessage(TRichEdit(popNoteMemo.PopupComponent).Handle, WM_VSCROLL, SB_TOP, 0);
2753	with dlgFindText do
2754	begin
2755	Position := Point(Application.MainForm.Left + pnlLeft.Width, Application.MainForm.Top);
2756	FindText := '';
2757	Options := [frDown, frHideUpDown];
2758	Execute;
2759	end;
2760	end;
2761
2762	procedure TfrmConsults.dlgFindTextFind(Sender: TObject);
2763	begin
2764	dmodShared.FindRichEditText(dlgFindText, TRichEdit(popNoteMemo.PopupComponent));
2765	end;
2766
2767	procedure TfrmConsults.dlgReplaceTextFind(Sender: TObject);
2768	begin
2769	inherited;
2770	dmodShared.FindRichEditText(dlgFindText, TRichEdit(popNoteMemo.PopupComponent));
2771	end;
2772
2773	procedure TfrmConsults.dlgReplaceTextReplace(Sender: TObject);
2774	begin
2775	inherited;
2776	dmodShared.ReplaceRichEditText(dlgReplaceText, TRichEdit(popNoteMemo.PopupComponent));
2777	end;
2778
2779	procedure TfrmConsults.popNoteMemoReplaceClick(Sender: TObject);
2780	begin
2781	inherited;
2782	SendMessage(TRichEdit(popNoteMemo.PopupComponent).Handle, WM_VSCROLL, SB_TOP, 0);
2783	with dlgReplaceText do
2784	begin
2785	Position := Point(Application.MainForm.Left + pnlLeft.Width, Application.MainForm.Top);
2786	FindText := '';
2787	ReplaceText := '';
2788	Options := [frDown, frHideUpDown];
2789	Execute;
2790	end;
2791	end;
2792
2793	procedure TfrmConsults.popNoteMemoSpellClick(Sender: TObject);
2794	begin
2795	inherited;
2796	DoAutoSave(0);
2797	timAutoSave.Enabled := False;
2798	try
2799	SpellCheckForControl(memResults);
2800	finally
2801	FChanged := True;
2802	DoAutoSave(0);
2803	timAutoSave.Enabled := True;
2804	end;
2805	end;
2806
2807	procedure TfrmConsults.popNoteMemoGrammarClick(Sender: TObject);
2808	begin
2809	inherited;
2810	DoAutoSave(0);
2811	timAutoSave.Enabled := False;
2812	try
2813	GrammarCheckForControl(memResults);
2814	finally
2815	FChanged := True;
2816	DoAutoSave(0);
2817	timAutoSave.Enabled := True;
2818	end;
2819	end;
2820
2821	procedure TfrmConsults.RequestPrint;
2822	var
2823	Saved: boolean;
2824	begin
2825	inherited;
2826	if lstNotes.ItemIEN = EditingIndex then // !KCM! in response to WPB-0898-31166
2827	//if ItemIEN < 0 then
2828	begin
2829	SaveCurrentNote(Saved);
2830	if not Saved then Exit;
2831	end;
2832	with lstConsults do
2833	if ItemIEN > 0 then PrintSF513(ItemIEN, DisplayText[ItemIndex]) else
2834	begin
2835	if ItemIEN = 0 then InfoBox(TX_NOCONSULT, TX_NOCSLT_CAP, MB_OK);
2836	if lstNotes.ItemIEN < 0 then InfoBox(TX_NOPRT_NEW, TX_NOPRT_NEW_CAP, MB_OK);
2837	end;
2838	end;
2839
2840	{for printing multiple notes}
2841	procedure TfrmConsults.RequestMultiplePrint(AForm: TfrmPrintList);
2842	var
2843	NoteIEN: int64;
2844	i: integer;
2845	begin
2846	with AForm.lbIDParents do
2847	for i := 0 to Items.Count - 1 do
2848	if Selected[i] then
2849	begin
2850	NoteIEN := StrToInt64def(Piece(Items[i], U, 1), 0);
2851	if NoteIEN > 0 then PrintSF513(NoteIEN, DisplayText[i])
2852	else if NoteIEN = 0 then InfoBox(TX_NOCONSULT, TX_NOCSLT_CAP, MB_OK)
2853	else InfoBox(TX_NOPRT_NEW, TX_NOPRT_NEW_CAP, MB_OK);
2854	end;
2855	end;
2856
2857	procedure TfrmConsults.mnuActDisplayResultsClick(Sender: TObject);
2858	var
2859	Saved: boolean;
2860	begin
2861	inherited;
2862	if lstConsults.ItemIEN = 0 then exit;
2863	if EditingIndex <> -1 then
2864	begin
2865	SaveCurrentNote(Saved);
2866	if not Saved then Exit;
2867	end;
2868	lstNotes.ItemIndex := -1 ;
2869	DisplayResults(memConsult.Lines, lstConsults.ItemIEN) ;
2870	memConsult.SelStart := 0;
2871	SetResultMenus;
2872	if memConsult.CanFocus then
2873	memConsult.SetFocus;
2874	end;
2875
2876	procedure TfrmConsults.mnuActDisplaySF513Click(Sender: TObject);
2877	var
2878	Saved: boolean;
2879	begin
2880	inherited;
2881	if lstConsults.ItemIEN = 0 then exit;
2882	if EditingIndex <> -1 then
2883	begin
2884	SaveCurrentNote(Saved);
2885	if not Saved then Exit;
2886	end;
2887	lstNotes.ItemIndex := -1 ;
2888	with lstConsults do
2889	if ItemIEN > 0 then ReportBox(ShowSF513(ItemIEN),DisplayText[ItemIndex], False)
2890	else
2891	begin
2892	if ItemIEN = 0 then InfoBox(TX_NOCONSULT, TX_NOCSLT_CAP, MB_OK);
2893	if lstNotes.ItemIEN < 0 then InfoBox(TX_NOPRT_NEW, TX_NOPRT_NEW_CAP, MB_OK);
2894	end;
2895	SetResultMenus;
2896	end;
2897
2898	procedure TfrmConsults.pnlResultsResize(Sender: TObject);
2899	const
2900	LEFT_MARGIN = 4;
2901	begin
2902	inherited;
2903	LimitEditWidth(memResults, MAX_ENTRY_WIDTH - 1);
2904	memResults.Constraints.MinWidth := TextWidthByFont(memResults.Font.Handle, StringOfChar('X', MAX_ENTRY_WIDTH)) + (LEFT_MARGIN * 2) + ScrollBarWidth;
2905	//CQ13181 508 Consults--Splitter bar doesn't retain size
2906	//CQ13181 pnlLeft.Width := self.ClientWidth - pnlResults.Width - sptHorz.Width;
2907	end;
2908
2909	procedure TfrmConsults.NotifyOrder(OrderAction: Integer; AnOrder: TOrder);
2910	var
2911	SavedCsltID: string;
2912	begin
2913	if ViewContext = 0 then exit; // form has not yet been displayed, so nothing to update
2914	if EditingIndex <> -1 then exit; // do not rebuild list until after save
2915	with tvConsults do if Selected <> nil then SavedCsltID := lstConsults.ItemID;
2916	case OrderAction of
2917	ORDER_NEW: UpdateList ;
2918	ORDER_SIGN: UpdateList{ sent by fReview, fOrderSign when orders signed, AnOrder=nil}
2919	end;
2920	if SavedCsltID <> '' then with tvConsults do
2921	begin
2922	Selected := FindPieceNode(SavedCsltID, U, Items.GetFirstNode);
2923	tvConsultsChange(Self, Selected);
2924	end;
2925	end;
2926
2927	procedure TfrmConsults.mnuActPrintSF513Click(Sender: TObject);
2928	var
2929	Saved: boolean;
2930	begin
2931	inherited;
2932	if lstConsults.ItemIEN = 0 then exit;
2933	if EditingIndex <> -1 then
2934	begin
2935	SaveCurrentNote(Saved);
2936	if not Saved then Exit;
2937	end;
2938	RequestPrint;
2939	end;
2940
2941
2942	function TfrmConsults.AuthorizedUser: Boolean;
2943	begin
2944	Result := True;
2945	if User.NoOrdering then Result := False;
2946	if User.OrderRole = OR_BADKEYS then
2947	begin
2948	InfoBox(TX_BADKEYS, TC_BADKEYS, MB_OK);
2949	Result := False;
2950	end;
2951	end;
2952
2953	procedure TfrmConsults.FormCreate(Sender: TObject);
2954	begin
2955	inherited;
2956	FocusToRightPanel := False;
2957	PageID := CT_CONSULTS;
2958	EditingIndex := -1;
2959	FLastNoteID := '';
2960	FEditNote.LastCosigner := 0;
2961	FEditNote.LastCosignerName := '';
2962	//pnlConsultList.Height := (pnlLeft.Height div 2);
2963	pnlConsultList.Height := 3 * (pnlLeft.Height div 5);
2964	frmDrawers := TfrmDrawers.CreateDrawers(Self, pnlAction, [],[]);
2965	frmDrawers.Align := alBottom;
2966	frmDrawers.RichEditControl := memResults;
2967	frmDrawers.Splitter := splDrawers;
2968	frmDrawers.DefTempPiece := 2;
2969	FImageFlag := TBitmap.Create;
2970	FDocList := TStringList.Create;
2971	with FCurrentNoteContext do
2972	begin
2973	GroupBy := '';
2974	TreeAscending := False;
2975	Status := IntToStr(NC_ALL);
2976	end;
2977	FCsltList := TStringList.Create;
2978	end;
2979
2980	procedure TfrmConsults.mnuActDisplayDetailsClick(Sender: TObject);
2981	var
2982	Saved: boolean;
2983	begin
2984	inherited;
2985	if lstConsults.ItemIEN = 0 then exit;
2986	if EditingIndex <> -1 then
2987	begin
2988	SaveCurrentNote(Saved);
2989	if not Saved then Exit;
2990	end;
2991	tvConsultsChange(Self, tvConsults.Selected);
2992	//lstConsultsClick(Self);
2993	if memConsult.CanFocus then
2994	memConsult.SetFocus;
2995	end;
2996
2997	procedure TfrmConsults.FormClose(Sender: TObject; var Action: TCloseAction);
2998	var
2999	Saved: Boolean;
3000	IEN: Int64;
3001	ErrMsg: string;
3002	DeleteSts: TActionRec;
3003	begin
3004	inherited;
3005	if frmFrame.TimedOut and (EditingIndex <> -1) then
3006	begin
3007	FSilent := True;
3008	if memResults.GetTextLen > 0 then SaveCurrentNote(Saved)
3009	else
3010	begin
3011	IEN := lstNotes.GetIEN(EditingIndex);
3012	if not LastSaveClean(IEN) then // means note hasn't been committed yet
3013	begin
3014	LockDocument(IEN, ErrMsg);
3015	if ErrMsg = '' then
3016	begin
3017	DeleteDocument(DeleteSts, IEN, '');
3018	UnlockDocument(IEN);
3019	end; {if ErrMsg}
3020	end; {if not LastSaveClean}
3021	end; {else}
3022	end; {if frmFrame}
3023	end;
3024
3025	procedure TfrmConsults.mnuActIdentifyAddlSignersClick(Sender: TObject);
3026	var
3027	Exclusions: TStrings;
3028	Saved, x, y: boolean;
3029	SignerList: TSignerList;
3030	ActionSts: TActionRec;
3031	SigAction: integer;
3032	SavedDocID, SavedCsltID: string;
3033	ARefDate: TFMDateTime;
3034	begin
3035	inherited;
3036	if lstNotes.ItemIEN = 0 then exit;
3037	SavedDocID := lstNotes.ItemID;
3038	SavedCsltID := lstConsults.ItemID;
3039	if lstNotes.ItemIndex = EditingIndex then
3040	begin
3041	SaveCurrentNote(Saved);
3042	if not Saved then Exit;
3043	tvConsultsChange(Self, tvConsults.Selected);
3044	with tvCsltNotes do Selected := FindPieceNode(SavedDocID, U, Items.GetFirstNode);
3045	end;
3046	x := CanChangeCosigner(lstNotes.ItemIEN);
3047	ActOnDocument(ActionSts, lstNotes.ItemIEN, 'IDENTIFY SIGNERS');
3048	y := ActionSts.Success;
3049	if x and not y then
3050	begin
3051	if InfoBox(ActionSts.Reason + CRLF + CRLF +
3052	'Would you like to change the cosigner?',
3053	TX_IN_AUTH, MB_YESNO or MB_DEFBUTTON2 or MB_ICONQUESTION) = ID_YES then
3054	SigAction := SG_COSIGNER
3055	else
3056	Exit;
3057	end
3058	else if y and not x then SigAction := SG_ADDITIONAL
3059	else if x and y then SigAction := SG_BOTH
3060	else
3061	begin
3062	InfoBox(ActionSts.Reason, TX_IN_AUTH, MB_OK);
3063	Exit;
3064	end;
3065
3066	with lstNotes do
3067	begin
3068	if not LockConsultRequestAndNote(ItemIEN) then Exit;
3069	Exclusions := GetCurrentSigners(ItemIEN);
3070	ARefDate := StrToFloat(Piece(Items[ItemIndex], U, 3));
3071	SelectAdditionalSigners(Font.Size, ItemIEN, SigAction, Exclusions, SignerList, CT_CONSULTS, ARefDate);
3072	end;
3073	with SignerList do
3074	begin
3075	case SigAction of
3076	SG_ADDITIONAL: if Changed and (Signers <> nil) and (Signers.Count > 0) then
3077	UpdateAdditionalSigners(lstNotes.ItemIEN, Signers);
3078	SG_COSIGNER: if Changed then ChangeCosigner(lstNotes.ItemIEN, Cosigner);
3079	SG_BOTH: if Changed then
3080	begin
3081	if (Signers <> nil) and (Signers.Count > 0) then
3082	UpdateAdditionalSigners(lstNotes.ItemIEN, Signers);
3083	ChangeCosigner(lstNotes.ItemIEN, Cosigner);
3084	end;
3085	end;
3086	lstNotesClick(Self);
3087	end;
3088	UnlockDocument(lstNotes.ItemIEN);
3089	UnlockConsultRequest(lstNotes.ItemIEN, StrToIntDef(SavedCsltID, 0)); // v20.4 RV (unlocking problem)
3090	//UnlockConsultRequest(lstNotes.ItemIEN, ConsultRec.IEN);
3091	end;
3092
3093	procedure TfrmConsults.popNoteMemoAddlSignClick(Sender: TObject);
3094	begin
3095	inherited;
3096	mnuActIdentifyAddlSignersClick(Self);
3097	end;
3098
3099	procedure TfrmConsults.ProcessNotifications;
3100	var
3101	ConsultIEN, NoteIEN: integer;
3102	x: string;
3103	Saved: boolean;
3104	AnObject: PDocTreeObject;
3105	tmpNode: TORTreeNode;
3106	begin
3107	if EditingIndex <> -1 then
3108	begin
3109	SaveCurrentNote(Saved);
3110	if not Saved then Exit;
3111	end;
3112	FNotifPending := True;
3113	NoteIEN := 0;
3114	CurrNotifIEN := 0;
3115	lblConsults.Caption := Notifications.Text;
3116	tvConsults.Caption := Notifications.Text;
3117	EditingIndex := -1;
3118	lstConsults.Enabled := True ;
3119	tvConsults.Enabled := True;
3120	lstNotes.Enabled := True ;
3121	pnlRead.BringToFront ;
3122	memConsult.TabStop := True;
3123	lstConsults.Clear;
3124
3125	if Copy(Piece(Piece(Notifications.RecordID, U, 2),';',1),1,3) = 'TIU' then
3126	begin
3127	ConsultIEN := StrToIntDef(Piece(Piece(Notifications.RecordID, U, 4),';',2),0);
3128	NoteIEN := StrToIntDef(Piece(Notifications.AlertData, U, 1),0);
3129	end
3130	else if Notifications.Followup = NF_STAT_RESULTS then
3131	ConsultIEN := StrToIntDef(Piece(Piece(Piece(Notifications.AlertData, '\|', 2), '@', 1), ';', 1), 0)
3132	else if Notifications.Followup = NF_CONSULT_PROC_INTERPRETATION then
3133	ConsultIEN := StrToIntDef(Piece(Notifications.AlertData, '\|', 1), 0)
3134	else if ((Notifications.Followup = NF_CONSULT_REQUEST_RESOLUTION) and (Pos('Sig Findings', Notifications.RecordID) = 0)) then
3135	ConsultIEN := StrToIntDef(Piece(Notifications.AlertData, '\|', 1), 0)
3136	else
3137	ConsultIEN := StrToIntDef(Notifications.AlertData, 0);
3138	x := FindConsult(ConsultIEN);
3139	CurrNotifIEN := ConsultIEN;
3140	lstConsults.Items.Add(x);
3141	uChanging := True;
3142	tvConsults.Items.BeginUpdate;
3143	tvConsults.Items.Clear;
3144	tmpNode := tvConsults.FindPieceNode('Alerted Consult', 2, U, nil);
3145	if tmpNode = nil then
3146	begin
3147	tmpNode := TORTreeNode(tvConsults.Items.AddFirst(tvConsults.Items.GetFirstNode, 'Alerted Consult'));
3148	tmpNode.StringData := '-1^Alerted Consult^^^^^^0';
3149	end
3150	else
3151	tmpNode.DeleteChildren;
3152	SetNodeImage(tmpNode, FCurrentContext);
3153	tmpNode := TORTreeNode(tvConsults.Items.AddChildFirst(tmpNode, MakeConsultListDisplayText(x)));
3154	tmpNode.StringData := x;
3155	SetNodeImage(tmpNode, FCurrentContext);
3156	with tvConsults do Selected := FindPieceNode(Piece(x, U, 1), U, Items.GetFirstNode);
3157	tvConsults.Items.EndUpdate;
3158	uChanging := False;
3159	tvConsultsChange(Self, tvConsults.Selected);
3160	if ((Notifications.Followup = NF_CONSULT_REQUEST_RESOLUTION) and (Pos('Sig Findings', Notifications.RecordID) = 0)) then
3161	begin
3162	//XQADATA = consult_ien\|tiu_ien;TIU(8925,
3163	if Copy(Piece(Piece(Notifications.AlertData, '\|', 2), ';', 2), 1, 3) = 'TIU' then
3164	NoteIEN := StrToIntDef(Piece(Piece(Notifications.AlertData, '\|', 2), ';', 1), 0);
3165	end
3166	else if (Notifications.Followup = NF_CONSULT_PROC_INTERPRETATION) then
3167	begin
3168	NoteIEN := StrToIntDef(Piece(Piece(Notifications.AlertData, '\|', 2), ';', 1), 0);
3169	end
3170	else if (Notifications.Followup = NF_STAT_RESULTS) then
3171	begin
3172	NoteIEN := 0; // Note IEN not available for this alert - fall through to display all results - CURTIS?
3173	end;
3174	tvCsltNotes.FullExpand;
3175	if NoteIEN > 0 then with lstNotes do
3176	begin
3177	if SelectByIEN(NoteIEN) = -1 then
3178	begin
3179	x := Notifications.AlertData;
3180	uChanging := True;
3181	tvCsltNotes.Items.BeginUpdate;
3182	lstNotes.Clear;
3183	KillDocTreeObjects(tvCsltNotes);
3184	tvCsltNotes.Items.Clear;
3185	lstNotes.Items.Add(x);
3186	AnObject := MakeConsultsNoteTreeObject('ALERT^Alerted Note^^^^^^^^^^^%^0');
3187	tmpNode := TORTreeNode(tvCsltNotes.Items.AddObjectFirst(tvCsltNotes.Items.GetFirstNode, AnObject.NodeText, AnObject));
3188	TORTreeNode(tmpNode).StringData := 'ALERT^Alerted Note^^^^^^^^^^^%^0';
3189	tmpNode.ImageIndex := IMG_TOP_LEVEL;
3190	AnObject := MakeConsultsNoteTreeObject(x);
3191	tmpNode := TORTreeNode(tvCsltNotes.Items.AddChildObjectFirst(tmpNode, AnObject.NodeText, AnObject));
3192	tmpNode.StringData := x;
3193	SetTreeNodeImagesAndFormatting(tmpNode, FCurrentNoteContext, CT_CONSULTS);
3194	with tvCsltNotes do Selected := FindPieceNode(Piece(x, U, 1), U, Items.GetFirstNode);
3195	tvCsltNotes.Items.EndUpdate;
3196	uChanging := False;
3197	end
3198	else
3199	begin
3200	uChanging := True;
3201	with tvCsltNotes do Selected := FindPieceNode(IntToStr(NoteIEN), U , nil);
3202	uChanging := False;
3203	end;
3204	tvCsltNotesChange(Self, tvCsltNotes.Selected);
3205	end
3206	else if (ConsultRec.ORStatus = ST_COMPLETE) and ((ConsultRec.TIUDocuments.Count + ConsultRec.MedResults.Count) > 0) then
3207	mnuActDisplayResultsClick(Self);
3208
3209	case Notifications.Followup of
3210	NF_CONSULT_REQUEST_RESOLUTION : Notifications.Delete;
3211	NF_NEW_SERVICE_CONSULT_REQUEST : Notifications.Delete;
3212	NF_STAT_RESULTS : Notifications.Delete;
3213	NF_CONSULT_REQUEST_CANCEL_HOLD : Notifications.Delete;
3214	NF_CONSULT_REQUEST_UPDATED : Notifications.Delete;
3215	NF_CONSULT_UNSIGNED_NOTE : {Will be automatically deleted by TIU sig action!!!} ;
3216	NF_CONSULT_PROC_INTERPRETATION : Notifications.Delete; // not sure we want to do this yet,
3217	// but if not now, then when?
3218	end;
3219	if Copy(Piece(Notifications.RecordID, U, 2), 1, 6) = 'TIUADD' then Notifications.Delete;
3220	if Copy(Piece(Notifications.RecordID, U, 2), 1, 5) = 'TIUID' then Notifications.Delete;
3221	FNotifPending := False;
3222	end;
3223
3224	procedure TfrmConsults.mnuActEditResubmitClick(Sender: TObject);
3225	var
3226	Resubmitted: boolean;
3227	x: string;
3228	SavedConsultID: string;
3229	begin
3230	inherited;
3231	if lstConsults.ItemIEN = 0 then exit;
3232	SavedConsultID := lstConsults.ItemID;
3233	x := ConsultCanBeResubmitted(lstConsults.ItemIEN);
3234	if Piece(x, U, 1) = '0' then
3235	begin
3236	InfoBox(Piece(x, U, 2), TC_NO_RESUBMIT, MB_OK);
3237	Exit;
3238	end;
3239	if ConsultRec.ConsultProcedure <> '' then
3240	Resubmitted := EditResubmitProcedure(Font.Size, lstConsults.ItemIEN)
3241	else
3242	Resubmitted := EditResubmitConsult(Font.Size, lstConsults.ItemIEN);
3243	if Resubmitted then
3244	begin
3245	LoadConsults;
3246	with tvConsults do Selected := FindPieceNode(SavedConsultID, 1, U, Items.GetFirstNode);
3247	tvConsultsClick(Self);
3248	(* lstConsults.Clear;
3249	lstConsults.Items.Add(FindConsult(ConsultRec.IEN));
3250	lstConsults.SelectByIEN(ConsultRec.IEN);
3251	lstConsultsClick(Self);*)
3252	end;
3253	end;
3254
3255	procedure TfrmConsults.EnableDisableOrdering;
3256	begin
3257	if User.NoOrdering then
3258	begin
3259	cmdNewConsult.Enabled := False;
3260	cmdNewProc.Enabled := False;
3261	mnuActNew.Enabled := False;
3262	Exit;
3263	end;
3264	end;
3265
3266	procedure TfrmConsults.UMNewOrder(var Message: TMessage);
3267	{ update consults list if progress note completes consult }
3268	begin
3269	with Message do
3270	begin
3271	if ViewContext = 0 then exit; // form has not yet been displayed, so nothing to update
3272	UpdateList;
3273	end;
3274	end;
3275
3276	procedure TfrmConsults.cmdEditResubmitClick(Sender: TObject);
3277	begin
3278	inherited;
3279	mnuActEditResubmitClick(Self);
3280	end;
3281
3282	procedure TfrmConsults.cmdEditResubmitExit(Sender: TObject);
3283	begin
3284	inherited;
3285	DoLeftPanelCustomShiftTab;
3286	end;
3287
3288	procedure TfrmConsults.mnuViewSaveAsDefaultClick(Sender: TObject);
3289	begin
3290	inherited;
3291	if InfoBox('Replace current defaults?','Confirmation', MB_YESNO or MB_ICONQUESTION) = IDYES then
3292	begin
3293	SaveCurrentContext(FCurrentContext);
3294	lblConsults.Caption := 'Default List';
3295	tvConsults.Caption := 'Default List';
3296	FDefaultContext := FCurrentContext;
3297	end;
3298	end;
3299
3300	procedure TfrmConsults.mnuViewReturntoDefaultClick(Sender: TObject);
3301	begin
3302	inherited;
3303	lblConsults.Caption := 'Default List';
3304	tvConsults.Caption := 'Default List';
3305	SetViewContext(FDefaultContext);
3306	end;
3307
3308	procedure TfrmConsults.popNoteMemoTemplateClick(Sender: TObject);
3309	begin
3310	inherited;
3311	EditTemplates(Self, True, FEditCtrl.SelText);
3312	end;
3313
3314	procedure TfrmConsults.mnuEditTemplatesClick(Sender: TObject);
3315	begin
3316	inherited;
3317	EditTemplates(Self);
3318	end;
3319
3320	procedure TfrmConsults.mnuNewTemplateClick(Sender: TObject);
3321	begin
3322	inherited;
3323	EditTemplates(Self, True);
3324	end;
3325
3326	procedure TfrmConsults.pnlLeftExit(Sender: TObject);
3327	begin
3328	inherited;
3329	if (Not FocusToRightPanel) then
3330	if ShiftTabIsPressed then
3331	frmFrame.tabPage.SetFocus
3332	else if TabIsPressed then
3333	frmFrame.pnlPatient.SetFocus;
3334
3335	if FocusToRightPanel then
3336	FocusToRightPanel := False;
3337	end;
3338
3339	procedure TfrmConsults.pnlLeftResize(Sender: TObject);
3340	begin
3341	inherited;
3342	if EditingIndex = -1 then
3343	pnlConsultList.Height := (pnlLeft.Height div 2)
3344	//pnlConsultList.Height := 3 * (pnlLeft.Height div 5)
3345	else
3346	pnlConsultList.Height := (pnlLeft.Height div 5);
3347	Self.Invalidate;
3348	end;
3349
3350	procedure TfrmConsults.mnuOptionsClick(Sender: TObject);
3351	begin
3352	inherited;
3353	mnuEditTemplates.Enabled := frmDrawers.CanEditTemplates;
3354	mnuNewTemplate.Enabled := frmDrawers.CanEditTemplates;
3355	mnuEditSharedTemplates.Enabled := frmDrawers.CanEditShared;
3356	mnuNewSharedTemplate.Enabled := frmDrawers.CanEditShared;
3357	mnuEditDialgFields.Enabled := CanEditTemplateFields;
3358	end;
3359
3360	procedure TfrmConsults.mnuEditSharedTemplatesClick(Sender: TObject);
3361	begin
3362	inherited;
3363	EditTemplates(Self, FALSE, '', TRUE);
3364	end;
3365
3366	procedure TfrmConsults.mnuNewSharedTemplateClick(Sender: TObject);
3367	begin
3368	inherited;
3369	EditTemplates(Self, TRUE, '', TRUE);
3370	end;
3371
3372	procedure TfrmConsults.mnuActNotePrintClick(Sender: TObject);
3373	var
3374	Saved: Boolean;
3375	begin
3376	inherited;
3377	with lstNotes do
3378	begin
3379	if ItemIndex = EditingIndex then
3380	begin
3381	SaveCurrentNote(Saved);
3382	if not Saved then Exit;
3383	end;
3384	if ItemIEN > 0 then PrintNote(ItemIEN, MakeConsultNoteDisplayText(Items[ItemIndex])) else
3385	begin
3386	if ItemIEN = 0 then InfoBox(TX_NONOTE, TX_NONOTE_CAP, MB_OK);
3387	if ItemIEN < 0 then InfoBox(TX_NOPRT_NEW, TX_NOPRT_NEW_CAP, MB_OK);
3388	end;
3389	end;
3390	end;
3391
3392	procedure TfrmConsults.popNoteMemoPrintClick(Sender: TObject);
3393	begin
3394	inherited;
3395	mnuActNotePrintClick(Self);
3396	end;
3397
3398
3399	//========================== leave these at end of file =============================
3400
3401	(*procedure TfrmConsults.lstNotesDrawItem(Control: TWinControl;
3402	Index: Integer; Rect: TRect; State: TOwnerDrawState);
3403	var
3404	x: string;
3405	const
3406	STD_DATE = 'MMM DD,YY';
3407	begin
3408	inherited;
3409	with (Control as TORListBox).Canvas do { draw on control canvas, not on the form }
3410	begin
3411	FImageFlag.LoadFromResourceName(hInstance, 'BMP_IMAGEFLAG_1');
3412	x := (Control as TORListBox).Items[Index];
3413	(Control as TORListBox).ItemHeight := HigherOf(TextHeight(x), FImageFlag.Height);
3414	FillRect(Rect); { clear the rectangle }
3415	if StrToIntDef(Piece(x, U, 7), 0) > 0 then
3416	begin
3417	if StrToIntDef(Piece(x, U, 7), 0) = 1 then
3418	FImageFlag.LoadFromResourceName(hInstance, 'BMP_IMAGEFLAG_1')
3419	else if StrToIntDef(Piece(x, U, 7), 0) = 2 then
3420	FImageFlag.LoadFromResourceName(hInstance, 'BMP_IMAGEFLAG_2')
3421	else if StrToIntDef(Piece(x, U, 7), 0) > 2 then
3422	FImageFlag.LoadFromResourceName(hInstance, 'BMP_IMAGEFLAG_3');
3423	BrushCopy(Bounds(Rect.Left, Rect.Top, FImageFlag.Width, FImageFlag.Height),
3424	FImageFlag, Bounds(0, 0, FImageFlag.Width, FImageFlag.Height), clRed); {render ImageFlag}
3425	end;
3426	TextOut(Rect.Left + FImageFlag.Width, Rect.Top, Piece(x, U, 2));
3427	TextOut(Rect.Left + FImageFlag.Width + TextWidth(STD_DATE), Rect.Top, Piece(x, U, 3));
3428	end;
3429	end;
3430	*)
3431	procedure TfrmConsults.FormDestroy(Sender: TObject);
3432	begin
3433	FDocList.Free;
3434	FCsltList.Free;
3435	FImageFlag.Free;
3436	KillDocTreeObjects(tvCsltNotes);
3437	inherited;
3438	end;
3439
3440	function TfrmConsults.GetDrawers: TFrmDrawers;
3441	begin
3442	Result := frmDrawers;
3443	end;
3444
3445	procedure TfrmConsults.SetEditingIndex(const Value: Integer);
3446	begin
3447	FEditingIndex := Value;
3448	if(FEditingIndex < 0) then
3449	KillReminderDialog(Self);
3450	if(assigned(frmReminderTree)) then
3451	frmReminderTree.EnableActions;
3452	end;
3453
3454	function TfrmConsults.LockConsultRequest(AConsult: Integer): Boolean;
3455	{ returns true if consult successfully locked }
3456	begin
3457	// *** I'm not sure about the FOrderID field - if the user is editing one note and
3458	// deletes another, FOrderID will be for editing note, then delete note, then null
3459	Result := True;
3460	FOrderID := GetConsultOrderIEN(AConsult);
3461	if frmNotes.ActiveEditOf(0, AConsult) then
3462	begin
3463	InfoBox(TX_ORDER_LOCKED, TC_ORDER_LOCKED, MB_OK);
3464	Result := False;
3465	FOrderID := '';
3466	Exit;
3467	end;
3468	(* if (FOrderID <> '') and (FOrderID = frmNotes.OrderID) then
3469	begin
3470	InfoBox(TX_ORDER_LOCKED, TC_ORDER_LOCKED, MB_OK);
3471	Result := False;
3472	FOrderID := '';
3473	Exit;
3474	end;*)
3475	if (FOrderId <> '') then
3476	if not OrderCanBeLocked(FOrderID) then Result := False;
3477	if not Result then FOrderID := '';
3478	end;
3479
3480	function TfrmConsults.LockConsultRequestAndNote(AnIEN: Int64): Boolean;
3481	{ returns true if note and associated request successfully locked }
3482	var
3483	AConsult: Integer;
3484	LockMsg, x: string;
3485	begin
3486	Result := True;
3487	AConsult := 0;
3488	if frmNotes.ActiveEditOf(AnIEN, lstConsults.ItemIEN) then
3489	begin
3490	InfoBox(TX_ORDER_LOCKED, TC_ORDER_LOCKED, MB_OK);
3491	Result := False;
3492	Exit;
3493	end;
3494	if Changes.Exist(CH_CON, IntToStr(AnIEN)) then Exit; // already locked
3495	// try to lock the consult request first, if there is one
3496	if IsConsultTitle(TitleForNote(AnIEN)) then
3497	begin
3498	x := GetPackageRefForNote(lstNotes.ItemIEN);
3499	AConsult := StrToIntDef(Piece(x, ';', 1), 0);
3500	//AConsult := GetConsultIENforNote(lstNotes.ItemIEN);
3501	Result := LockConsultRequest(AConsult);
3502	end;
3503	// now try to lock the note
3504	if Result then
3505	begin
3506	LockDocument(AnIEN, LockMsg);
3507	if LockMsg <> '' then
3508	begin
3509	Result := False;
3510	// if can't lock the note, unlock the consult request that was just locked
3511	if AConsult > 0 then
3512	begin
3513	UnlockOrderIfAble(FOrderID);
3514	FOrderID := '';
3515	end;
3516	InfoBox(LockMsg, TC_NO_LOCK, MB_OK);
3517	end;
3518	end;
3519	if not Result then FOrderID := '';
3520	end;
3521
3522	procedure TfrmConsults.UnlockConsultRequest(ANote: Int64; AConsult: Integer = 0);
3523	(*var
3524	x: string;*)
3525	begin
3526	(* if (AConsult = 0) then
3527	begin
3528	x := GetPackageRefForNote(ANote);
3529	AConsult := StrToIntDef(Piece(x, ';', 1), 0);
3530	end;
3531	if AConsult = 0 then Exit;*)
3532	if AConsult = 0 then AConsult := GetConsultIENForNote(ANote);
3533	if AConsult <= 0 then exit;
3534	FOrderID := GetConsultOrderIEN(AConsult);
3535	UnlockOrderIfAble(FOrderID);
3536	FOrderID := '';
3537	end;
3538
3539	function TfrmConsults.ActiveEditOf(AnIEN: Int64): Boolean;
3540	var
3541	ARequest: integer;
3542	x: string;
3543	begin
3544	Result := False;
3545	if (lstNotes.ItemIEN = AnIEN) and (lstNotes.ItemIndex = EditingIndex) then
3546	begin
3547	Result := True;
3548	Exit;
3549	end;
3550	x := GetPackageRefForNote(AnIEN);
3551	ARequest := StrToIntDef(Piece(x, ';', 1), 0);
3552	//ARequest := GetConsultIENForNote(AnIEN);
3553	if (lstConsults.ItemIEN = ARequest) and (EditingIndex > -1) then Result := True;
3554	end;
3555
3556	function TfrmConsults.StartNewEdit(NewNoteType: integer): Boolean;
3557	{ if currently editing a note, returns TRUE if the user wants to start a new one }
3558	var
3559	Saved: Boolean;
3560	AConsultID, ANoteID: string;
3561	Msg, CapMsg: string;
3562	begin
3563	AConsultID := lstConsults.ItemID;
3564	ANoteID := lstNotes.ItemID;
3565	Result := True;
3566	if EditingIndex > -1 then
3567	begin
3568	case NewNoteType of
3569	NT_ACT_ADDENDUM: begin
3570	Msg := TX_NEW_SAVE1 + MakeConsultNoteDisplayText(lstNotes.Items[EditingIndex]) + TX_NEW_SAVE3;
3571	CapMsg := TC_NEW_SAVE3;
3572	end;
3573	NT_ACT_EDIT_NOTE: begin
3574	Msg := TX_NEW_SAVE1 + MakeConsultNoteDisplayText(lstNotes.Items[EditingIndex]) + TX_NEW_SAVE4;
3575	CapMsg := TC_NEW_SAVE4;
3576	end;
3577	NT_ACT_ID_ENTRY: begin
3578	Msg := TX_NEW_SAVE1 + MakeConsultNoteDisplayText(lstNotes.Items[EditingIndex]) + TX_NEW_SAVE5;
3579	CapMsg := TC_NEW_SAVE5;
3580	end;
3581	else
3582	begin
3583	Msg := TX_NEW_SAVE1 + MakeNoteDisplayText(lstNotes.Items[EditingIndex]) + TX_NEW_SAVE2;
3584	CapMsg := TC_NEW_SAVE2;
3585	end;
3586	end;
3587	if InfoBox(Msg, CapMsg, MB_YESNO) = IDNO then Result := False
3588	else
3589	begin
3590	SaveCurrentNote(Saved);
3591	if not Saved then Result := False
3592	else
3593	begin
3594	with tvConsults do Selected := FindPieceNode(AConsultID, 1, U, Items.GetFirstNode);
3595	tvConsultsClick(Self);
3596	with tvCsltNotes do Selected := FindPieceNode(ANoteID, 1, U, Items.GetFirstNode);
3597	end;
3598	end;
3599	end;
3600	end;
3601
3602	function TfrmConsults.LacksRequiredForCreate: Boolean;
3603	{ determines if the fields required to create the note are present }
3604	var
3605	CurTitle: Integer;
3606	begin
3607	Result := False;
3608	with FEditNote do
3609	begin
3610	if Title <= 0 then Result := True;
3611	if Author <= 0 then Result := True;
3612	if DateTime <= 0 then Result := True;
3613	if MenuAccessRec.IsClinicalProcedure then
3614	begin
3615	if (IsClinProcTitle(Title) and (PkgIEN = 0)) then Result := True;
3616	//if (IsClinProcTitle(Title) and (Consult = 0)) then Result := True;
3617	end
3618	else
3619	if (IsConsultTitle(Title) and (PkgIEN = 0)) then Result := True;
3620	//if (IsConsultTitle(Title) and (Consult = 0)) then Result := True;
3621	if (DocType = TYP_ADDENDUM) then
3622	begin
3623	if AskCosignerForDocument(Addend, Author, DateTime) and (Cosigner <= 0) then Result := True;
3624	end else
3625	begin
3626	if Title > 0 then CurTitle := Title else CurTitle := DocType;
3627	if AskCosignerForTitle(CurTitle, Author, DateTime) and (Cosigner <= 0) then Result := True;
3628	end;
3629	end;
3630	end;
3631
3632	function TfrmConsults.LacksClinProcFields(AnEditRec: TEditNoteRec; AMenuAccessRec: TMenuAccessRec; var ErrMsg: string): boolean;
3633	begin
3634	Result := False;
3635	if not AMenuAccessRec.IsClinicalProcedure then exit;
3636	with AnEditRec do
3637	begin
3638	if Author <= 0 then
3639	begin
3640	Result := True;
3641	ErrMsg := TX_NO_AUTHOR;
3642	end;
3643	if AskCosignerForTitle(Title, Author, DateTime) and (Cosigner = 0) then
3644	begin
3645	Result := True;
3646	ErrMsg := ErrMsg + CRLF + TX_REQ_COSIGNER;
3647	end;
3648	if (DocType <> TYP_ADDENDUM) and (AMenuAccessRec.ClinProcFlag = CP_INSTR_INCOMPLETE) then
3649	begin
3650	if (ClinProcSummCode = 0) or (ClinProcDateTime <= 0) then
3651	begin
3652	Result := True;
3653	ErrMsg := ErrMsg + CRLF + TX_CLIN_PROC;
3654	end;
3655	end;
3656	end;
3657	end;
3658
3659	function TfrmConsults.LacksClinProcFieldsForSignature(NoteIEN: int64; var ErrMsg: string): boolean;
3660	var
3661	CsltIEN: integer;
3662	CsltActionRec: TMenuAccessRec;
3663	SignRec: TEditNoteRec;
3664	begin
3665	Result := False;
3666	CsltIEN := GetConsultIENForNote(NoteIEN);
3667	if CsltIEN <= 0 then exit;
3668	CsltActionRec := GetActionMenuLevel(CsltIEN);
3669	if not CsltActionRec.IsClinicalProcedure then exit;
3670	if not IsClinProcTitle(TitleForNote(NoteIEN)) then exit;
3671	SignRec := GetSavedCPFields(NoteIEN);
3672	Result := LacksClinProcFields(SignRec, CsltActionRec, ErrMsg);
3673	end;
3674
3675	function TfrmConsults.GetTitleText(AnIndex: Integer): string;
3676	{ returns non-tabbed text for the title of a note given the ItemIndex in lstNotes }
3677	var
3678	x: string;
3679	begin
3680	with lstNotes do
3681	x := MakeConsultNoteDisplayText(Items[AnIndex]);
3682	(* x := FormatFMDateTime('mmm dd,yy', MakeFMDateTime(Piece(Items[AnIndex], U, 3))) +
3683	' ' + Piece(Items[AnIndex], U, 2);*)
3684	Result := x;
3685	end;
3686
3687	(*function TfrmConsults.MakeTitleText(IsAddendum: Boolean = False): string;
3688	{ returns display text for list box based on FEditNote }
3689	begin
3690	Result := FormatFMDateTime('mmm dd,yy', FEditNote.DateTime) + U;
3691	if IsAddendum and (CompareText(Copy(FEditNote.TitleName, 1, 8), 'Addendum') <> 0)
3692	then Result := Result + 'Addendum to ';
3693	Result := Result + FEditNote.TitleName + ', ' + FEditNote.LocationName + ', ' +
3694	FEditNote.AuthorName;
3695	end;*)
3696
3697	function TfrmConsults.VerifyNoteTitle: Boolean;
3698	const
3699	VNT_UNKNOWN = 0;
3700	VNT_NO = 1;
3701	VNT_YES = 2;
3702	var
3703	AParam: string;
3704	begin
3705	if FVerifyNoteTitle = VNT_UNKNOWN then
3706	begin
3707	AParam := GetUserParam('ORWOR VERIFY NOTE TITLE');
3708	if AParam = '1' then FVerifyNoteTitle := VNT_YES else FVerifyNoteTitle := VNT_NO;
3709	end;
3710	Result := FVerifyNoteTitle = VNT_YES;
3711	end;
3712
3713	procedure TfrmConsults.SetSubjectVisible(ShouldShow: Boolean);
3714	{ hide/show subject & resize panel accordingly - leave 6 pixel margin above memNewNote }
3715	begin
3716	if ShouldShow then
3717	begin
3718	lblSubject.Visible := True;
3719	txtSubject.Visible := True;
3720	pnlFields.Height := txtSubject.Top + txtSubject.Height + 6;
3721	end else
3722	begin
3723	lblSubject.Visible := False;
3724	txtSubject.Visible := False;
3725	pnlFields.Height := lblVisit.Top + lblVisit.Height + 6;
3726	end;
3727	end;
3728
3729
3730	procedure TfrmConsults.timAutoSaveTimer(Sender: TObject);
3731	begin
3732	inherited;
3733	DoAutoSave;
3734	end;
3735
3736	procedure TfrmConsults.DoAutoSave(Suppress: integer = 1);
3737	var
3738	ErrMsg: string;
3739	begin
3740	if fFrame.frmFrame.DLLActive = True then Exit;
3741	if (EditingIndex > -1) and FChanged then
3742	begin
3743	StatusText('Autosaving note...');
3744	//PutTextOnly(ErrMsg, memResults.Lines, lstNotes.GetIEN(EditingIndex));
3745	timAutoSave.Enabled := False;
3746	try
3747	SetText(ErrMsg, memResults.Lines, lstNotes.GetIEN(EditingIndex), Suppress);
3748	finally
3749	timAutoSave.Enabled := True;
3750	end;
3751	FChanged := False;
3752	StatusText('');
3753	end;
3754	if ErrMsg <> '' then
3755	InfoBox(TX_SAVE_ERROR1 + ErrMsg + TX_SAVE_ERROR2, TC_SAVE_ERROR, MB_OK or MB_ICONWARNING);
3756	//Assert(ErrMsg = '', 'AutoSave: ' + ErrMsg);
3757	end;
3758
3759	procedure TfrmConsults.DoLeftPanelCustomShiftTab;
3760	begin
3761	if ShiftTabIsPressed then begin
3762	FocusToRightPanel := True;
3763	FindNextControl(frmFrame.pnlPatient, False, True, False).SetFocus;
3764	end;
3765	end;
3766
3767	procedure TfrmConsults.cmdChangeClick(Sender: TObject);
3768	var
3769	LastTitle, LastConsult: Integer;
3770	(OKPressed, )IsIDChild, UseClinProcTitles: Boolean;
3771	x, AClassName: string;
3772	begin
3773	inherited;
3774	FcmdChangeOKPressed := False;
3775	IsIDChild := uIDNotesActive and (FEditNote.IDParent > 0);
3776	LastTitle := FEditNote.Title;
3777	LastConsult := FEditNote.PkgIEN;
3778	with MenuAccessRec do
3779	UseClinProcTitles := ((IsClinicalProcedure) and
3780	(ClinProcFlag in [CP_NO_INSTRUMENT, CP_INSTR_INCOMPLETE, CP_INSTR_COMPLETE]));
3781	if UseClinProcTitles then AClassName := DCL_CLINPROC else AClassName := DCL_CONSULTS;
3782	if Sender <> Self then
3783	FcmdChangeOKPressed := ExecuteNoteProperties(FEditNote, CT_CONSULTS, IsIDChild, False, AClassName,
3784	MenuAccessRec.ClinProcFlag)
3785	else FcmdChangeOKPressed := True;
3786	if not FcmdChangeOKPressed then Exit;
3787	// update display fields & uPCEEdit
3788	lblNewTitle.Caption := ' ' + FEditNote.TitleName + ' ';
3789	if (FEditNote.Addend > 0) and (CompareText(Copy(lblNewTitle.Caption, 2, 8), 'Addendum') <> 0)
3790	then lblNewTitle.Caption := ' Addendum to:' + lblNewTitle.Caption;
3791	with lblNewTitle do bvlNewTitle.SetBounds(Left - 1, Top - 1, Width + 2, Height + 2);
3792	lblRefDate.Caption := FormatFMDateTime('mmm dd,yyyy@hh:nn', FEditNote.DateTime);
3793	lblAuthor.Caption := FEditNote.AuthorName;
3794	if uPCEEdit.Inpatient then x := 'Adm: ' else x := 'Vst: ';
3795	x := x + FormatFMDateTime('mm/dd/yy', FEditNote.VisitDate) + ' ' + FEditNote.LocationName;
3796	lblVisit.Caption := x;
3797	if Length(FEditNote.CosignerName) > 0
3798	then lblCosigner.Caption := 'Expected Cosigner: ' + FEditNote.CosignerName
3799	else lblCosigner.Caption := '';
3800	uPCEEdit.NoteTitle := FEditNote.Title;
3801	// modify signature requirements if author or cosigner changed
3802	if (User.DUZ <> FEditNote.Author) and (User.DUZ <> FEditNote.Cosigner)
3803	then Changes.ReplaceSignState(CH_CON, lstNotes.ItemID, CH_SIGN_NA)
3804	else Changes.ReplaceSignState(CH_CON, lstNotes.ItemID, CH_SIGN_YES);
3805	x := lstNotes.Items[EditingIndex];
3806	SetPiece(x, U, 2, lblNewTitle.Caption);
3807	SetPiece(x, U, 3, FloatToStr(FEditNote.DateTime));
3808	tvCsltNotes.Selected.Text := MakeConsultNoteDisplayText(x);
3809	TORTreeNode(tvCsltNotes.Selected).StringData := x;
3810	lstNotes.Items[EditingIndex] := x;
3811	Changes.ReplaceText(CH_CON, lstNotes.ItemID, GetTitleText(EditingIndex));
3812	if LastConsult <> FEditNote.PkgIEN then
3813	//if LastConsult <> FEditNote.Consult then
3814	begin
3815	// try to lock the new consult, reset to previous if unable
3816	if (FEditNote.PkgIEN > 0) and not LockConsultRequest(FEditNote.PkgIEN) then
3817	//if (FEditNote.Consult > 0) and not LockConsultRequest(FEditNote.Consult) then
3818	begin
3819	Infobox(TX_NO_ORD_CHG, TC_NO_ORD_CHG, MB_OK);
3820	FEditNote.PkgIEN := LastConsult;
3821	//FEditNote.Consult := LastConsult;
3822	end else
3823	begin
3824	// unlock the previous consult
3825	if LastConsult > 0 then UnlockOrderIfAble(GetConsultOrderIEN(LastConsult));
3826	if FEditNote.PkgIEN = 0 then FOrderID := '';
3827	//if FEditNote.Consult = 0 then FOrderID := '';
3828	end;
3829	end;
3830	if LastTitle <> FEditNote.Title then mnuActLoadBoilerClick(Self);
3831	end;
3832
3833	procedure TfrmConsults.pnlFieldsResize(Sender: TObject);
3834	{ center the reference date on the panel }
3835	begin
3836	inherited;
3837	lblRefDate.Left := (pnlFields.Width - lblRefDate.Width) div 2;
3838	if lblRefDate.Left < (lblNewTitle.Left + lblNewTitle.Width + 6)
3839	then lblRefDate.Left := (lblNewTitle.Left + lblNewTitle.Width);
3840	end;
3841
3842
3843	procedure TfrmConsults.AssignRemForm;
3844	begin
3845	with RemForm do
3846	begin
3847	Form := Self;
3848	PCEObj := uPCEEdit;
3849	RightPanel := pnlRight;
3850	CanFinishProc := CanFinishReminder;
3851	DisplayPCEProc := DisplayPCE;
3852	Drawers := frmDrawers;
3853	NewNoteRE := memResults;
3854	NoteList := lstNotes;
3855	end;
3856	end;
3857
3858	function TfrmConsults.CanFinishReminder: boolean;
3859	begin
3860	if(EditingIndex < 0) then
3861	Result := FALSE
3862	else
3863	Result := (lstNotes.ItemIndex = EditingIndex);
3864	end;
3865
3866	procedure TfrmConsults.mnuActChangeClick(Sender: TObject);
3867	begin
3868	inherited;
3869	if (FEditingIndex < 0) or (lstNotes.ItemIndex <> FEditingIndex) then Exit;
3870	cmdChangeClick(Sender);
3871	end;
3872
3873	procedure TfrmConsults.mnuActLoadBoilerClick(Sender: TObject);
3874	var
3875	NoteEmpty: Boolean;
3876	BoilerText: TStringList;
3877	DocInfo: string;
3878
3879	procedure AssignBoilerText;
3880	begin
3881	ExecuteTemplateOrBoilerPlate(BoilerText, FEditNote.Title, ltTitle, Self, 'Title: ' + FEditNote.TitleName, DocInfo);
3882	QuickCopyWith508Msg(BoilerText, memResults);
3883	FChanged := False;
3884	end;
3885
3886	begin
3887	inherited;
3888	if (FEditingIndex < 0) or (lstNotes.ItemIndex <> FEditingIndex) then Exit;
3889	BoilerText := TStringList.Create;
3890	try
3891	NoteEmpty := memResults.Text = '';
3892	LoadBoilerPlate(BoilerText, FEditNote.Title);
3893	if (BoilerText.Text <> '') or
3894	assigned(GetLinkedTemplate(IntToStr(FEditNote.Title), ltTitle)) then
3895	begin
3896	DocInfo := MakeXMLParamTIU(IntToStr(lstNotes.ItemIEN), FEditNote);
3897	if NoteEmpty then AssignBoilerText else
3898	begin
3899	case QueryBoilerPlate(BoilerText) of
3900	0: { do nothing } ; // ignore
3901	1: begin
3902	ExecuteTemplateOrBoilerPlate(BoilerText, FEditNote.Title, ltTitle, Self, 'Title: ' + FEditNote.TitleName, DocInfo);
3903	QuickCopyWith508Msg(BoilerText, memResults); // append
3904	end;
3905	2: AssignBoilerText; // replace
3906	end;
3907	end;
3908	end else
3909	begin
3910	if Sender = mnuActLoadBoiler
3911	then InfoBox(TX_NO_BOIL, TC_NO_BOIL, MB_OK)
3912	else
3913	begin
3914	if not NoteEmpty then
3915	if not FChanged and (InfoBox(TX_BLR_CLEAR, TC_BLR_CLEAR, MB_YESNO) = ID_YES)
3916	then memResults.Lines.Clear;
3917	end;
3918	end; {if BoilerText.Text <> ''}
3919	finally
3920	BoilerText.Free;
3921	end;
3922	end;
3923
3924	procedure TfrmConsults.popNoteMemoSaveContinueClick(Sender: TObject);
3925	begin
3926	inherited;
3927	FChanged := True;
3928	DoAutoSave;
3929	end;
3930
3931	procedure TfrmConsults.ProcessMedResults(ActionType: string);
3932	var
3933	FormTitle, ErrMsg: string;
3934	(i, )AConsult: integer;
3935	const
3936	TX_ATTACH = 'Attach Medicine Result to: ';
3937	TX_REMOVE = 'Remove Medicine Result from: ';
3938	TX_NO_ATTACH_RESULTS = 'There are no results available to associate with this procedure.';
3939	TX_NO_REMOVE_RESULTS = 'There are no medicine results currently associated with this procedure.';
3940	TC_NO_RESULTS = 'No Results';
3941	begin
3942	inherited;
3943	with lstConsults, MedResult do
3944	begin
3945	FillChar(MedResult, SizeOf(MedResult), 0);
3946	if ItemIEN = 0 then Exit;
3947	AConsult := ItemIEN;
3948	if not LockConsultRequest(AConsult) then Exit;
3949	lstNotes.Enabled := False ;
3950	lstConsults.Enabled := False ;
3951	tvConsults.Enabled := False;
3952	if ActionType = 'ATTACH' then
3953	begin
3954	FormTitle := TX_ATTACH + Piece(DisplayText[ItemIndex], #9, 3);
3955	ErrMsg := TX_NO_ATTACH_RESULTS;
3956	end
3957	else if ActionType = 'REMOVE' then
3958	begin
3959	FormTitle := TX_REMOVE + Piece(DisplayText[ItemIndex], #9, 3);
3960	ErrMsg := TX_NO_REMOVE_RESULTS;
3961	end;
3962	Action := ActionType;
3963	if SelectMedicineResult(ItemIEN, FormTitle, MedResult) then
3964	begin
3965	if ResultPtr <> '' then
3966	begin
3967	if ActionType = 'ATTACH' then
3968	AttachMedicineResult(ItemIEN, ResultPtr, DateTimeofAction, ResponsiblePerson, AlertsTo.Recipients)
3969	else if ActionType = 'REMOVE' then
3970	RemoveMedicineResult(ItemIEN, ResultPtr, DateTimeofAction, ResponsiblePerson);
3971	UpdateList ; {update consult list after success}
3972	ItemIndex := 0 ;
3973	{ItemIndex may have changed - need to look up by IEN}
3974	with tvConsults do Selected := FindPieceNode(IntToStr(AConsult), 1, U, Items.GetFirstNode);
3975	tvConsultsClick(Self);
3976	end
3977	else
3978	InfoBox(ErrMsg, TC_NO_RESULTS, MB_OK or MB_ICONWARNING);
3979	end;
3980	end;
3981	lstNotes.Enabled := True ;
3982	lstConsults.Enabled := True ;
3983	tvConsults.Enabled := True;
3984	FOrderID := GetConsultOrderIEN(AConsult);
3985	UnlockOrderIfAble(FOrderID);
3986	FOrderID := '';
3987	end;
3988
3989	procedure TfrmConsults.mnuActAttachMedClick(Sender: TObject);
3990	begin
3991	inherited;
3992	ProcessMedResults('ATTACH');
3993	end;
3994
3995	procedure TfrmConsults.mnuActRemoveMedClick(Sender: TObject);
3996	begin
3997	inherited;
3998	ProcessMedResults('REMOVE');
3999	end;
4000
4001	procedure TfrmConsults.mnuEditDialgFieldsClick(Sender: TObject);
4002	begin
4003	inherited;
4004	EditDialogFields;
4005	end;
4006
4007	procedure TfrmConsults.UpdateNoteTreeView(DocList: TStringList; Tree: TORTreeView; AContext: integer);
4008	var
4009	i: integer;
4010	begin
4011	with Tree do
4012	begin
4013	uChanging := True;
4014	Items.BeginUpdate;
4015	for i := 0 to DocList.Count - 1 do
4016	begin
4017	if Piece(DocList[i], U, 14) = '0' then continue; // v16.8 fix RV
4018	//if Piece(DocList[i], U, 14) <> IntToStr(AContext) then continue;
4019	lstNotes.Items.Add(DocList[i]);
4020	end;
4021	FCurrentNoteContext.Status := IntToStr(AContext);
4022	BuildDocumentTree(DocList, '0', Tree, nil, FCurrentNoteContext, CT_CONSULTS);
4023	Items.EndUpdate;
4024	uChanging := False;
4025	end;
4026	end;
4027
4028	procedure TfrmConsults.tvCsltNotesChange(Sender: TObject; Node: TTreeNode);
4029	var
4030	x, WhyNot: string;
4031	begin
4032	if uChanging then Exit;
4033	//This gives the change a chance to occur when keyboarding, so that WindowEyes
4034	//doesn't use the old value.
4035	Application.ProcessMessages;
4036	with tvCsltNotes do
4037	begin
4038	if (Selected = nil) then Exit;
4039	if uIDNotesActive then
4040	begin
4041	mnuActDetachFromIDParent.Enabled := (Selected.ImageIndex in [IMG_ID_CHILD, IMG_ID_CHILD_ADD]);
4042	popNoteListDetachFromIDParent.Enabled := mnuActDetachFromIDParent.Enabled;
4043	if (Selected.ImageIndex in [IMG_SINGLE, IMG_PARENT, IMG_ID_CHILD, IMG_ID_CHILD_ADD]) then
4044	mnuActAttachtoIDParent.Enabled := CanBeAttached(PDocTreeObject(Selected.Data)^.DocID, WhyNot)
4045	else
4046	mnuActAttachtoIDParent.Enabled := False;
4047	popNoteListAttachtoIDParent.Enabled := mnuActAttachtoIDParent.Enabled;
4048	if (Selected.ImageIndex in [IMG_SINGLE, IMG_PARENT,
4049	IMG_IDNOTE_OPEN, IMG_IDNOTE_SHUT,
4050	IMG_IDPAR_ADDENDA_OPEN, IMG_IDPAR_ADDENDA_SHUT]) then
4051	mnuActAddIDEntry.Enabled := CanReceiveAttachment(PDocTreeObject(Selected.Data)^.DocID, WhyNot)
4052	else
4053	mnuActAddIDEntry.Enabled := False;
4054	popNoteListAddIDEntry.Enabled := mnuActAddIDEntry.Enabled
4055	end;
4056	popNoteListExpandSelected.Enabled := Selected.HasChildren;
4057	popNoteListCollapseSelected.Enabled := Selected.HasChildren;
4058	if (Selected.ImageIndex = IMG_TOP_LEVEL) then
4059	begin
4060	pnlResults.Visible := False;
4061	pnlResults.SendToBack;
4062	pnlRead.Visible := True;
4063	pnlRead.BringToFront ;
4064	memConsult.TabStop := True;
4065	UpdateReminderFinish;
4066	ShowPCEControls(False);
4067	frmDrawers.DisplayDrawers(FALSE);
4068	cmdPCE.Visible := FALSE;
4069	popNoteMemoEncounter.Visible := FALSE;
4070	lstConsults.Enabled := True ;
4071	tvConsults.Enabled := True;
4072	lstNotes.Enabled := True;
4073	lblTitle.Caption := '';
4074	lblTitle.Hint := lblTitle.Caption;
4075	Exit;
4076	end;
4077	x := TORTreeNode(Selected).StringData;
4078	if StrToIntDef(Piece(Piece(x, U, 1), ';', 1), 0) > 0 then
4079	begin
4080	memConsult.Clear;
4081	lstNotes.SelectByID(Piece(x, U, 1));
4082	lstNotesClick(Self);
4083	SendMessage(memConsult.Handle, WM_VSCROLL, SB_TOP, 0);
4084	end;
4085	end;
4086	end;
4087
4088	procedure TfrmConsults.tvCsltNotesCollapsed(Sender: TObject; Node: TTreeNode);
4089	begin
4090	with Node do
4091	begin
4092	if (ImageIndex in [IMG_GROUP_OPEN, IMG_IDNOTE_OPEN, IMG_IDPAR_ADDENDA_OPEN]) then
4093	ImageIndex := ImageIndex - 1;
4094	if (SelectedIndex in [IMG_GROUP_OPEN, IMG_IDNOTE_OPEN, IMG_IDPAR_ADDENDA_OPEN]) then
4095	SelectedIndex := SelectedIndex - 1;
4096	end;
4097	end;
4098
4099	procedure TfrmConsults.tvCsltNotesExpanded(Sender: TObject; Node: TTreeNode);
4100
4101	function SortByTitle(Node1, Node2: TTreeNode; Data: Longint): Integer; stdcall;
4102	begin
4103	{ Within an ID parent node, sorts in ascending order by title
4104	BUT - addenda to parent document are always at the top of the sort, in date order}
4105	if (Copy(PDocTreeObject(Node1.Data)^.DocTitle, 1, 8) = 'Addendum') and
4106	(Copy(PDocTreeObject(Node2.Data)^.DocTitle, 1, 8) = 'Addendum') then
4107	begin
4108	Result := AnsiStrIComp(PChar(PDocTreeObject(Node1.Data)^.DocFMDate),
4109	PChar(PDocTreeObject(Node2.Data)^.DocFMDate));
4110	end
4111	else if Copy(PDocTreeObject(Node1.Data)^.DocTitle, 1, 8) = 'Addendum' then Result := -1
4112	else if Copy(PDocTreeObject(Node2.Data)^.DocTitle, 1, 8) = 'Addendum' then Result := 1
4113	else
4114	begin
4115	if Data = 0 then
4116	Result := AnsiStrIComp(PChar(PDocTreeObject(Node1.Data)^.DocTitle),
4117	PChar(PDocTreeObject(Node2.Data)^.DocTitle))
4118	else
4119	Result := -AnsiStrIComp(PChar(PDocTreeObject(Node1.Data)^.DocTitle),
4120	PChar(PDocTreeObject(Node2.Data)^.DocTitle));
4121	end
4122	end;
4123
4124	function SortByDate(Node1, Node2: TTreeNode; Data: Longint): Integer; stdcall;
4125	begin
4126	{ Within an ID parent node, sorts in ascending order by document date
4127	BUT - addenda to parent document are always at the top of the sort, in date order}
4128	if (Copy(PDocTreeObject(Node1.Data)^.DocTitle, 1, 8) = 'Addendum') and
4129	(Copy(PDocTreeObject(Node2.Data)^.DocTitle, 1, 8) = 'Addendum') then
4130	begin
4131	Result := AnsiStrIComp(PChar(PDocTreeObject(Node1.Data)^.DocFMDate),
4132	PChar(PDocTreeObject(Node2.Data)^.DocFMDate));
4133	end
4134	else if Copy(PDocTreeObject(Node1.Data)^.DocTitle, 1, 8) = 'Addendum' then Result := -1
4135	else if Copy(PDocTreeObject(Node2.Data)^.DocTitle, 1, 8) = 'Addendum' then Result := 1
4136	else
4137	begin
4138	if Data = 0 then
4139	Result := AnsiStrIComp(PChar(PDocTreeObject(Node1.Data)^.DocFMDate),
4140	PChar(PDocTreeObject(Node2.Data)^.DocFMDate))
4141	else
4142	Result := -AnsiStrIComp(PChar(PDocTreeObject(Node1.Data)^.DocFMDate),
4143	PChar(PDocTreeObject(Node2.Data)^.DocFMDate));
4144	end;
4145	end;
4146
4147	begin
4148	with Node do
4149	begin
4150	if Assigned(Data) then
4151	if (Pos('<', PDocTreeObject(Data)^.DocHasChildren) > 0) then
4152	begin
4153	if (PDocTreeObject(Node.Data)^.OrderByTitle) then
4154	CustomSort(@SortByTitle, 0)
4155	else
4156	CustomSort(@SortByDate, 0);
4157	end;
4158	if (ImageIndex in [IMG_GROUP_SHUT, IMG_IDNOTE_SHUT, IMG_IDPAR_ADDENDA_SHUT]) then
4159	ImageIndex := ImageIndex + 1;
4160	if (SelectedIndex in [IMG_GROUP_SHUT, IMG_IDNOTE_SHUT, IMG_IDPAR_ADDENDA_SHUT]) then
4161	SelectedIndex := SelectedIndex + 1;
4162	end;
4163	end;
4164
4165	procedure TfrmConsults.tvCsltNotesDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
4166	var
4167	AnItem: TORTreeNode;
4168	begin
4169	Accept := False;
4170	if not uIDNotesActive then exit;
4171	AnItem := TORTreeNode(tvCsltNotes.GetNodeAt(X, Y));
4172	if (AnItem = nil) or (AnItem.ImageIndex in [IMG_GROUP_OPEN, IMG_GROUP_SHUT, IMG_TOP_LEVEL]) then Exit;
4173	with tvCsltNotes.Selected do
4174	if (ImageIndex in [IMG_SINGLE, IMG_PARENT, IMG_ID_CHILD, IMG_ID_CHILD_ADD]) then
4175	Accept := (AnItem.ImageIndex in [IMG_SINGLE, IMG_PARENT,
4176	IMG_IDNOTE_OPEN, IMG_IDNOTE_SHUT,
4177	IMG_IDPAR_ADDENDA_OPEN, IMG_IDPAR_ADDENDA_SHUT])
4178	else if (ImageIndex in [IMG_IDNOTE_OPEN, IMG_IDNOTE_SHUT, IMG_IDPAR_ADDENDA_OPEN, IMG_IDPAR_ADDENDA_SHUT]) then
4179	Accept := (AnItem.ImageIndex in [IMG_GROUP_OPEN, IMG_GROUP_SHUT, IMG_TOP_LEVEL])
4180	else if (ImageIndex in [IMG_ADDENDUM, IMG_GROUP_OPEN, IMG_GROUP_SHUT, IMG_TOP_LEVEL]) then
4181	Accept := False;
4182	end;
4183
4184	procedure TfrmConsults.tvCsltNotesDragDrop(Sender, Source: TObject; X, Y: Integer);
4185	var
4186	HT: THitTests;
4187	ADestNode: TORTreeNode;
4188	Saved: boolean;
4189	begin
4190	if not uIDNotesActive then
4191	begin
4192	CancelDrag;
4193	exit;
4194	end;
4195	if tvCsltNotes.Selected = nil then exit;
4196	if EditingIndex <> -1 then
4197	begin
4198	SaveCurrentNote(Saved);
4199	if not Saved then Exit;
4200	end;
4201	HT := tvCsltNotes.GetHitTestInfoAt(X, Y);
4202	ADestNode := TORTreeNode(tvCsltNotes.GetNodeAt(X, Y));
4203	DoAttachIDChild(TORTreeNode(tvCsltNotes.Selected), ADestNode);
4204	end;
4205
4206	procedure TfrmConsults.tvCsltNotesStartDrag(Sender: TObject;
4207	var DragObject: TDragObject);
4208	const
4209	TX_CAP_NO_DRAG = 'Item cannot be moved';
4210	var
4211	WhyNot: string;
4212	Saved: boolean;
4213	begin
4214	if (tvCsltNotes.Selected.ImageIndex in [IMG_ADDENDUM, IMG_GROUP_OPEN, IMG_GROUP_SHUT, IMG_TOP_LEVEL]) or
4215	(not uIDNotesActive) or
4216	(lstNotes.ItemIEN = 0) then
4217	begin
4218	CancelDrag;
4219	Exit;
4220	end;
4221	if EditingIndex <> -1 then
4222	begin
4223	SaveCurrentNote(Saved);
4224	if not Saved then Exit;
4225	end;
4226	if not CanBeAttached(PDocTreeObject(tvCsltNotes.Selected.Data)^.DocID, WhyNot) then
4227	begin
4228	InfoBox(WhyNot, TX_CAP_NO_DRAG, MB_OK);
4229	CancelDrag;
4230	end;
4231	end;
4232
4233	procedure TfrmConsults.popNoteListExpandAllClick(Sender: TObject);
4234	begin
4235	inherited;
4236	if PopupComponent(Sender, popNoteList) is TTreeView then
4237	TTreeView(PopupComponent(Sender, popNoteList)).FullExpand;
4238	end;
4239
4240	procedure TfrmConsults.popNoteListCollapseAllClick(Sender: TObject);
4241	begin
4242	inherited;
4243	if PopupComponent(Sender, popNoteList) is TTreeView then
4244	with TTreeView(PopupComponent(Sender, popNoteList)) do
4245	begin
4246	Selected := nil;
4247	FullCollapse;
4248	Selected := TopItem;
4249	end;
4250	lblTitle.Caption := '';
4251	lblTitle.Hint := lblTitle.Caption;
4252	memConsult.Clear;
4253	end;
4254
4255	procedure TfrmConsults.popNoteListExpandSelectedClick(Sender: TObject);
4256	begin
4257	inherited;
4258	if PopupComponent(Sender, popNoteList) is TTreeView then
4259	with TTreeView(PopupComponent(Sender, popNoteList)) do
4260	begin
4261	if Selected = nil then exit;
4262	with Selected do if HasChildren then Expand(True);
4263	end;
4264	end;
4265
4266	procedure TfrmConsults.popNoteListCollapseSelectedClick(Sender: TObject);
4267	begin
4268	inherited;
4269	if PopupComponent(Sender, popNoteList) is TTreeView then
4270	with TTreeView(PopupComponent(Sender, popNoteList)) do
4271	begin
4272	if Selected = nil then exit;
4273	with Selected do if HasChildren then Collapse(True);
4274	end;
4275	end;
4276
4277	procedure TfrmConsults.EnableDisableIDNotes;
4278	begin
4279	uIDNotesActive := False; //IDNotesInstalled; {not for Consults in v15}
4280	mnuActDetachFromIDParent.Visible := uIDNotesActive;
4281	popNoteListDetachFromIDParent.Visible := uIDNotesActive;
4282	mnuActAddIDEntry.Visible := uIDNotesActive;
4283	popNoteListAddIDEntry.Visible := uIDNotesActive;
4284	mnuActAttachtoIDParent.Visible := uIDNotesActive;
4285	popNoteListAttachtoIDParent.Visible := uIDNotesActive;
4286	if uIDNotesActive then
4287	tvCsltNotes.DragMode := dmAutomatic
4288	else
4289	tvCsltNotes.DragMode := dmManual;
4290	end;
4291
4292
4293	procedure TfrmConsults.tvCsltNotesClick(Sender: TObject);
4294	begin
4295	inherited;
4296	if tvCsltNotes.Selected = nil then exit;
4297	if (tvCsltNotes.Selected.ImageIndex in [IMG_TOP_LEVEL, IMG_GROUP_OPEN, IMG_GROUP_SHUT]) then
4298	begin
4299	lblTitle.Caption := '';
4300	lblTitle.Hint := lblTitle.Caption;
4301	memConsult.Clear;
4302	end;
4303	end;
4304
4305	// =========================== Consults Treeview Code ==================================
4306
4307	procedure TfrmConsults.LoadConsults;
4308	var
4309	tmpList: TStringList;
4310	ANode: TTreeNode;
4311	begin
4312	tmpList := TStringList.Create;
4313	try
4314
4315	FCsltList.Clear;
4316	uChanging := True;
4317	RedrawSuspend(memConsult.Handle);
4318	tvConsults.Items.BeginUpdate;
4319	lstConsults.Items.Clear;
4320	KillDocTreeObjects(tvConsults);
4321	tvConsults.Items.Clear;
4322	tvConsults.Items.EndUpdate;
4323	tvCsltNotes.Items.BeginUpdate;
4324	KillDocTreeObjects(tvCsltNotes);
4325	tvCsltNotes.Items.Clear;
4326	tvCsltNotes.Items.EndUpdate;
4327	lstNotes.Clear;
4328	memConsult.Clear;
4329	memConsult.Invalidate;
4330	lblTitle.Caption := '';
4331	lblTitle.Hint := lblTitle.Caption;
4332	with FCurrentContext do
4333	begin
4334	GetConsultsList(tmpList, StrToFMDateTime(BeginDate), StrToFMDateTime(EndDate), Service, Status, Ascending);
4335	CreateListItemsforConsultTree(FCsltList, tmpList, ViewContext, GroupBy, Ascending);
4336	UpdateConsultsTreeView(FCsltList, tvConsults);
4337	FastAssign(tmpList, lstConsults.Items);
4338	end;
4339	with tvConsults do
4340	begin
4341	uChanging := True;
4342	Items.BeginUpdate;
4343	ANode := Items.GetFirstNode;
4344	if ANode <> nil then Selected := ANode.getFirstChild;
4345	memConsult.Clear;
4346	//RemoveParentsWithNoChildren(tvConsults, FCurrentContext);
4347	Items.EndUpdate;
4348	uChanging := False;
4349	if (Self.Active) and (Selected <> nil) then tvConsultsChange(Self, Selected);
4350	end;
4351	finally
4352	RedrawActivate(memConsult.Handle);
4353	tmpList.Free;
4354	end;
4355	end;
4356
4357	procedure TfrmConsults.UpdateConsultsTreeView(DocList: TStringList; Tree: TORTreeView);
4358	begin
4359	with Tree do
4360	begin
4361	uChanging := True;
4362	Items.BeginUpdate;
4363	FastAddStrings(DocList, lstConsults.Items);
4364	BuildConsultsTree(Tree, DocList, '0', nil, FCurrentContext);
4365	Items.EndUpdate;
4366	uChanging := False;
4367	end;
4368	end;
4369
4370	procedure TfrmConsults.tvConsultsExpanded(Sender: TObject; Node: TTreeNode);
4371	begin
4372	inherited;
4373	with Node do
4374	begin
4375	if (ImageIndex in [IMG_GMRC_GROUP_SHUT]) then
4376	ImageIndex := ImageIndex + 1;
4377	if (SelectedIndex in [IMG_GMRC_GROUP_SHUT]) then
4378	SelectedIndex := SelectedIndex + 1;
4379	end;
4380	end;
4381
4382	procedure TfrmConsults.tvConsultsCollapsed(Sender: TObject; Node: TTreeNode);
4383	begin
4384	inherited;
4385	with Node do
4386	begin
4387	if (ImageIndex in [IMG_GMRC_GROUP_OPEN]) then
4388	ImageIndex := ImageIndex - 1;
4389	if (SelectedIndex in [IMG_GMRC_GROUP_OPEN]) then
4390	SelectedIndex := SelectedIndex - 1;
4391	end;
4392	end;
4393
4394	procedure TfrmConsults.tvConsultsClick(Sender: TObject);
4395	begin
4396	inherited;
4397	with tvConsults do
4398	begin
4399	if Selected = nil then exit;
4400	if (Selected.ImageIndex in [IMG_GMRC_TOP_LEVEL, IMG_GMRC_GROUP_OPEN, IMG_GMRC_GROUP_SHUT]) then
4401	begin
4402	lblTitle.Caption := '';
4403	lblTitle.Hint := lblTitle.Caption;
4404	memConsult.Clear;
4405	KillDocTreeObjects(tvCsltNotes);
4406	tvCsltNotes.Items.Clear;
4407	lstNotes.Items.Clear;
4408	end
4409	else
4410	tvConsultsChange(Self, Selected);
4411	end;
4412	end;
4413
4414	procedure TfrmConsults.tvConsultsChange(Sender: TObject; Node: TTreeNode);
4415	var
4416	x: string;
4417	begin
4418	inherited;
4419	if uChanging then Exit;
4420	with tvConsults do
4421	begin
4422	if (Selected = nil) then Exit;
4423	if (tvConsults.Selected.ImageIndex in [IMG_GMRC_TOP_LEVEL, IMG_GMRC_GROUP_OPEN, IMG_GMRC_GROUP_SHUT]) then
4424	begin
4425	mnuActConsultRequest.Enabled := False;
4426	mnuActConsultResults.Enabled := False;
4427	frmFrame.mnuFilePrint.Enabled := False;
4428	frmFrame.mnuFilePrintSelectedItems.Enabled := False;
4429	end
4430	else
4431	begin
4432	frmFrame.mnuFilePrint.Enabled := True;
4433	frmFrame.mnuFilePrintSelectedItems.Enabled := True;
4434	end;
4435	popNoteListExpandSelected.Enabled := Selected.HasChildren;
4436	popNoteListCollapseSelected.Enabled := Selected.HasChildren;
4437	lstConsults.Enabled := True ;
4438	tvConsults.Enabled := True;
4439	lstNotes.Enabled := True;
4440	if (Selected.ImageIndex in [IMG_GMRC_TOP_LEVEL, IMG_GMRC_GROUP_OPEN, IMG_GMRC_GROUP_SHUT]) then
4441	begin
4442	pnlResults.Visible := False;
4443	pnlResults.SendToBack;
4444	pnlRead.Visible := True;
4445	pnlRead.BringToFront ;
4446	memConsult.TabStop := True;
4447	UpdateReminderFinish;
4448	ShowPCEControls(False);
4449	frmDrawers.DisplayDrawers(FALSE);
4450	cmdPCE.Visible := FALSE;
4451	popNoteMemoEncounter.Visible := FALSE;
4452	lstConsults.Enabled := True ;
4453	tvConsults.Enabled := True;
4454	KillDocTreeObjects(tvCsltNotes);
4455	tvCsltNotes.Items.Clear;
4456	lstNotes.Clear;
4457	lstNotes.Enabled := True;
4458	lblTitle.Caption := '';
4459	lblTitle.Hint := lblTitle.Caption;
4460	Exit;
4461	end;
4462	x := TORTreeNode(Selected).StringData;
4463	if StrToIntDef(Piece(x, U, 1), 0) > 0 then
4464	begin
4465	memConsult.Clear;
4466	lstConsults.SelectByID(Piece(x, U, 1));
4467	lstConsultsClick(Self);
4468	//tvConsults.SetFocus;
4469	SendMessage(memConsult.Handle, WM_VSCROLL, SB_TOP, 0);
4470	end;
4471	end;
4472	end;
4473
4474	procedure TfrmConsults.popNoteListPopup(Sender: TObject);
4475	var
4476	ShowIt: boolean;
4477	begin
4478	inherited;
4479	ShowIt := uIDNotesActive and (PopupComponent(Sender, popNoteList) = tvCsltNotes);
4480	popNoteListDetachFromIDParent.Visible := ShowIt;
4481	popNoteListAddIDEntry.Visible := ShowIt;
4482	end;
4483
4484	procedure TfrmConsults.mnuIconLegendClick(Sender: TObject);
4485	begin
4486	inherited;
4487	ShowIconLegend(ilConsults);
4488	end;
4489
4490	procedure TfrmConsults.mnuActAttachtoIDParentClick(Sender: TObject);
4491	var
4492	AChildNode: TORTreeNode;
4493	AParentID: string;
4494	Saved: boolean;
4495	SavedDocID, SavedConsultID: string;
4496	begin
4497	if lstNotes.ItemIEN = 0 then exit;
4498	SavedDocID := lstNotes.ItemID;
4499	if EditingIndex <> -1 then
4500	begin
4501	SaveCurrentNote(Saved);
4502	if not Saved then Exit;
4503	with tvConsults do Selected := FindPieceNode(SavedConsultID, 1, U, Items.GetFirstNode);
4504	tvConsultsClick(Self);
4505	with tvCsltNotes do Selected := FindPieceNode(SavedDocID, 1, U, Items.GetFirstNode);
4506	end;
4507	if tvCsltNotes.Selected = nil then exit;
4508	AChildNode := TORTreeNode(tvCsltNotes.Selected);
4509	AParentID := SelectParentNodeFromList(tvCsltNotes);
4510	if AParentID = '' then exit;
4511	with tvCsltNotes do Selected := FindPieceNode(AParentID, 1, U, Items.GetFirstNode);
4512	DoAttachIDChild(AChildNode, TORTreeNode(tvCsltNotes.Selected));
4513	end;
4514
4515	procedure TfrmConsults.DoAttachIDChild(AChild, AParent: TORTreeNode);
4516	const
4517	TX_ATTACH_CNF = 'Confirm Attachment';
4518	TX_ATTACH_FAILURE = 'Attachment failed';
4519	var
4520	ErrMsg, WhyNot: string;
4521	SavedDocID: string;
4522	begin
4523	if (AChild = nil) or (AParent = nil) then exit;
4524	ErrMsg := '';
4525	if not CanBeAttached(PDocTreeObject(AChild.Data)^.DocID, WhyNot) then
4526	ErrMsg := ErrMsg + WhyNot + CRLF + CRLF;
4527	if not CanReceiveAttachment(PDocTreeObject(AParent.Data)^.DocID, WhyNot) then
4528	ErrMsg := ErrMsg + WhyNot;
4529	if ErrMsg <> '' then
4530	begin
4531	InfoBox(ErrMsg, TX_ATTACH_FAILURE, MB_OK);
4532	Exit;
4533	end
4534	else
4535	begin
4536	WhyNot := '';
4537	if (InfoBox('ATTACH: ' + AChild.Text + CRLF + CRLF +
4538	' TO: ' + AParent.Text + CRLF + CRLF +
4539	'Are you sure?', TX_ATTACH_CNF, MB_YESNO or MB_DEFBUTTON2 or MB_ICONQUESTION) <> IDYES)
4540	then Exit;
4541	SavedDocID := PDocTreeObject(AParent.Data)^.DocID;
4542	end;
4543	if AChild.ImageIndex in [IMG_ID_CHILD, IMG_ID_CHILD_ADD] then
4544	begin
4545	if DetachEntryFromParent(PDocTreeObject(AChild.Data)^.DocID, WhyNot) then
4546	begin
4547	if AttachEntryToParent(PDocTreeObject(AChild.Data)^.DocID, PDocTreeObject(AParent.Data)^.DocID, WhyNot) then
4548	begin
4549	tvConsultsChange(Self, tvConsults.Selected);
4550	with tvCsltNotes do Selected := FindPieceNode(SavedDocID, U, Items.GetFirstNode);
4551	if tvCsltNotes.Selected <> nil then tvCsltNotes.Selected.Expand(False);
4552	end
4553	else
4554	InfoBox(WhyNot, TX_ATTACH_FAILURE, MB_OK);
4555	end
4556	else
4557	begin
4558	WhyNot := StringReplace(WhyNot, 'ATTACH', 'DETACH', [rfIgnoreCase]);
4559	WhyNot := StringReplace(WhyNot, 'to an ID', 'from an ID', [rfIgnoreCase]);
4560	InfoBox(WhyNot, TX_DETACH_FAILURE, MB_OK);
4561	Exit;
4562	end;
4563	end
4564	else
4565	begin
4566	if AttachEntryToParent(PDocTreeObject(AChild.Data)^.DocID, PDocTreeObject(AParent.Data)^.DocID, WhyNot) then
4567	begin
4568	tvConsultsChange(Self, tvConsults.Selected);
4569	with tvCsltNotes do Selected := FindPieceNode(SavedDocID, U, Items.GetFirstNode);
4570	if tvCsltNotes.Selected <> nil then tvCsltNotes.Selected.Expand(False);
4571	end
4572	else
4573	InfoBox(WhyNot, TX_ATTACH_FAILURE, MB_OK);
4574	end;
4575	end;
4576
4577	procedure TfrmConsults.tvConsultsKeyUp(Sender: TObject; var Key: Word;
4578	Shift: TShiftState);
4579	begin
4580	inherited;
4581	if Key in [VK_UP, VK_DOWN] then tvConsultsChange(Self, tvConsults.Selected);
4582	end;
4583
4584	function TfrmConsults.UserIsSigner(NoteIEN: integer): boolean;
4585	var
4586	Signers: TStringList;
4587	i: integer;
4588	begin
4589	Result := False;
4590	if NoteIEN <= 0 then exit;
4591	Signers := TStringList.Create;
4592	try
4593	FastAssign(GetCurrentSigners(NoteIEN), Signers);
4594	for i := 0 to Signers.Count - 1 do
4595	if Piece(Signers[i], U, 1) = IntToStr(User.DUZ) then
4596	begin
4597	Result := True;
4598	break;
4599	end;
4600	finally
4601	Signers.Free;
4602	end;
4603	end;
4604
4605	procedure TfrmConsults.memResultsKeyDown(Sender: TObject; var Key: Word;
4606	Shift: TShiftState);
4607	begin
4608	inherited;
4609	if (Key = VK_TAB) then
4610	begin
4611	if ssShift in Shift then
4612	begin
4613	FindNextControl(Sender as TWinControl, False, True, False).SetFocus; //previous control
4614	Key := 0;
4615	end
4616	else if ssCtrl in Shift then
4617	begin
4618	FindNextControl(Sender as TWinControl, True, True, False).SetFocus; //next control
4619	Key := 0;
4620	end;
4621	end;
4622	if (key = VK_ESCAPE) then begin
4623	FindNextControl(Sender as TWinControl, False, True, False).SetFocus; //previous control
4624	key := 0;
4625	end;
4626	end;
4627
4628	procedure TfrmConsults.sptHorzCanResize(Sender: TObject; var NewSize: Integer;
4629	var Accept: Boolean);
4630	begin
4631	inherited;
4632	if pnlResults.Visible then
4633	if NewSize > frmConsults.ClientWidth - memResults.Constraints.MinWidth - sptHorz.Width then
4634	NewSize := frmConsults.ClientWidth - memResults.Constraints.MinWidth - sptHorz.Width;
4635	end;
4636
4637	procedure TfrmConsults.popNoteMemoPreviewClick(Sender: TObject);
4638	begin
4639	frmDrawers.mnuPreviewTemplateClick(Sender);
4640	end;
4641
4642	procedure TfrmConsults.popNoteMemoInsTemplateClick(Sender: TObject);
4643	begin
4644	inherited;
4645	frmDrawers.mnuInsertTemplateClick(Sender);
4646	end;
4647
4648	procedure TfrmConsults.lstConsultsToPrint;
4649	var
4650	AParentID: string;
4651	SavedDocID: string;
4652	Saved: boolean;
4653	begin
4654	inherited;
4655	if lstConsults.ItemIEN = 0 then exit;
4656	SavedDocID := lstNotes.ItemID;
4657	if EditingIndex <> -1 then
4658	begin
4659	SaveCurrentNote(Saved);
4660	if not Saved then Exit;
4661	LoadConsults;
4662	with tvConsults do Selected := FindPieceNode(SavedDocID, U, Items.GetFirstNode);
4663	end;
4664	if tvConsults.Selected = nil then exit;
4665	AParentID := frmPrintList.SelectParentFromList(tvConsults,CT_CONSULTS);
4666	if AParentID = '' then exit;
4667	with tvConsults do Selected := FindPieceNode(AParentID, 1, U, Items.GetFirstNode);
4668	end;
4669
4670	procedure TfrmConsults.tvConsultsExit(Sender: TObject);
4671	begin
4672	inherited;
4673	FocusToRightPanel := True;
4674	if TabIsPressed then
4675	FindNextControl(pnlLeft, False, True, False).SetFocus;
4676	end;
4677
4678	procedure TfrmConsults.frmFramePnlPatientExit(Sender: TObject);
4679	begin
4680	FOldFramePnlPatientExit(Sender);
4681	if ShiftTabIsPressed then
4682	FindNextControl( pnlRight, False, True, False).SetFocus;
4683	end;
4684
4685	procedure TfrmConsults.FormHide(Sender: TObject);
4686	begin
4687	inherited;
4688	frmFrame.pnlPatient.OnExit := FOldFramePnlPatientExit;
4689	end;
4690
4691	procedure TfrmConsults.FormShow(Sender: TObject);
4692	var
4693	i : integer;
4694	begin
4695	inherited;
4696	FOldFramePnlPatientExit := frmFrame.pnlPatient.OnExit;
4697	frmFrame.pnlPatient.OnExit := frmFramePnlPatientExit;
4698	{Below is a fix for ClearQuest Defect HDS0000948, Kind of Kloogy I looked
4699	and looked for side effects and a better solution and this was the best!}
4700	if (EditingIndex = -1) or (lstNotes.ItemIndex <> EditingIndex) then
4701	frmDrawers.Hide;
4702	{This TStaticText I am looking for doesn't have a Name! So
4703	I have to loop through the panel's controls and disable the TStaticText.}
4704	with pnlAction do begin
4705	for i := 0 to (ControlCount -1) do
4706	begin
4707	if Controls[i] is TStaticText then
4708	if (Controls[i] as TStaticText).Caption = 'Consult Notes' then
4709	(Controls[i] as TStaticText).Enabled := False;
4710	end;
4711	end
4712	{End of ClearQuest Defect HDS0000948 Fixes}
4713	end;
4714
4715	procedure TfrmConsults.ViewInfo(Sender: TObject);
4716	begin
4717	inherited;
4718	frmFrame.ViewInfo(Sender);
4719	end;
4720
4721	procedure TfrmConsults.mnuViewInformationClick(Sender: TObject);
4722	begin
4723	inherited;
4724	mnuViewDemo.Enabled := frmFrame.pnlPatient.Enabled;
4725	mnuViewVisits.Enabled := frmFrame.pnlVisit.Enabled;
4726	mnuViewPrimaryCare.Enabled := frmFrame.pnlPrimaryCare.Enabled;
4727	mnuViewMyHealtheVet.Enabled := not (Copy(frmFrame.laMHV.Hint, 1, 2) = 'No');
4728	mnuInsurance.Enabled := not (Copy(frmFrame.laVAA2.Hint, 1, 2) = 'No');
4729	mnuViewFlags.Enabled := frmFrame.lblFlag.Enabled;
4730	mnuViewRemoteData.Enabled := frmFrame.lblCirn.Enabled;
4731	mnuViewReminders.Enabled := frmFrame.pnlReminders.Enabled;
4732	mnuViewPostings.Enabled := frmFrame.pnlPostings.Enabled;
4733	end;
4734
4735	initialization
4736	SpecifyFormIsNotADialog(TfrmConsults);
4737	uPCEEdit := TPCEData.Create;
4738	uPCEShow := TPCEData.Create;
4739
4740	finalization
4741	uPCEEdit.Free;
4742	uPCEShow.Free;
4743
4744	end.

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

Download in other formats: