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

Last change on this file since 1705 was 1698, checked in by healthsevak, 10 years ago

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