Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

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

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

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

Download in other formats: