Context Navigation

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

Last change on this file since 1693 was 1693, checked in by healthsevak, 9 years ago
Committing the files for first time to this new branch
File size: 181.7 KB

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

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

Download in other formats: