Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

fConsults.pas@ 453

Last change on this file since 453 was 453, checked in by Kevin Toppenberg, 16 years ago
Initial upload of TMG-CPRS 1.0.26.69
File size: 211.6 KB

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

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

Context Navigation

source: cprs/branches/tmg-cprs/CPRS-Chart/Consults/fConsults.pas@ 453

Download in other formats: