Context Navigation

fConsults.pas@ 1698

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

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

Context Navigation

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

Download in other formats: