Context Navigation

fConsults.pas@ 1806

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

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

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

Context Navigation

source: cprs/branches/foia-cprs/CPRS-Chart/Consults/fConsults.pas@ 1806

Download in other formats: