source: cprs/trunk/CPRS-Chart/Consults/fConsults.pas@ 773

Last change on this file since 773 was 456, checked in by Kevin Toppenberg, 16 years ago

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