source: cprs/trunk/CPRS-Chart/Encounter/fEncounterFrame.pas@ 829

Last change on this file since 829 was 829, checked in by Kevin Toppenberg, 14 years ago

Upgrade to version 27
File size: 26.8 KB
Line 
1unit fEncounterFrame;
2
3interface
4
5uses
6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7 Tabs, ComCtrls, ExtCtrls, Menus, StdCtrls, Buttons, fPCEBase,
8 fVisitType, fDiagnoses, fProcedure, fImmunization, fSkinTest, fPatientEd,
9 fHealthFactor, fExam, uPCE, rPCE, rTIU, ORCtrls, ORFn, fEncVitals, rvitals, fBase508Form,
10 VA508AccessibilityManager;
11
12const
13 //tab names
14 CT_VisitNm = 'Visit Type';
15 CT_DiagNm = 'Diagnoses';
16 CT_ProcNm = 'Procedures';
17 CT_ImmNm = 'Immunizations';
18 CT_SkinNm = 'Skin Tests';
19 CT_PedNm = 'Patient Ed';
20 CT_HlthNm = 'Health Factors';
21 CT_XamNm = 'Exams';
22 CT_VitNm = 'Vitals';
23 CT_GAFNm = 'GAF';
24
25 //numbers assigned to tabs to make changes easier
26 //they must be sequential
27 CT_NOPAGE = -1;
28 CT_UNKNOWN = 0;
29 CT_VISITTYPE = 1; CT_FIRST = 1;
30 CT_DIAGNOSES = 2;
31 CT_PROCEDURES = 3;
32 CT_IMMUNIZATIONS = 4;
33 CT_SKINTESTS = 5;
34 CT_PATIENTED = 6;
35 CT_HEALTHFACTORS = 7;
36 CT_EXAMS = 8;
37 CT_VITALS = 9;
38 CT_GAF = 10; CT_LAST = 10;
39
40 NUM_TABS = 3;
41 TAG_VTYPE = 10;
42 TAG_DIAG = 20;
43 TAG_PROC = 30;
44 TAG_IMMUNIZ = 40;
45 TAG_SKIN = 50;
46 TAG_PED = 60;
47 TAG_HF = 70;
48 TAG_XAM = 80;
49 TAG_TRT = 90;
50
51 TX_NOSECTION = '-1^No sections found';
52 TX_PROV_REQ = 'A primary encounter provider must be selected before encounter data can' + CRLF +
53 'be saved. Select the Primary Encounter Provider on the VISIT TYPE tab.' + CRLF +
54 'Otherwise, press <Cancel> to quit without saving data.';
55
56 TC_PROV_REQ = 'Missing Primary Provider for Encounter';
57
58type
59 TfrmEncounterFrame = class(TfrmBase508Form)
60 StatusBar1: TStatusBar;
61 pnlPage: TPanel;
62 Bevel1: TBevel;
63 TabControl: TTabControl;
64
65 procedure tabPageChange(Sender: TObject; NewTab: Integer;
66 var AllowChange: Boolean);
67 procedure FormResize(Sender: TObject);
68 procedure SectionClick(Sender: TObject);
69 procedure FormDestroy(Sender: TObject);
70 procedure FormCreate(Sender: TObject);
71 procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
72 procedure TabControlChange(Sender: TObject);
73 procedure TabControlChanging(Sender: TObject;
74 var AllowChange: Boolean);
75 procedure FormKeyDown(Sender: TObject; var Key: Word;
76 Shift: TShiftState);
77 procedure FormClose(Sender: TObject; var Action: TCloseAction);
78 procedure FormCanResize(Sender: TObject; var NewWidth,
79 NewHeight: Integer; var Resize: Boolean);
80 procedure FormShow(Sender: TObject);
81 procedure TabControlEnter(Sender: TObject);
82
83 private
84 FAutoSave: boolean;
85 FSaveNeeded: boolean;
86 FChangeSource: Integer;
87 FCancel: Boolean; //Indicates the cancel button has been pressed;
88 FAbort: boolean; // indicates that neither OK or Cancel has been pressed
89 FormList: TStringList; //Holds the types of any forms that will be used
90 //in the frame. They must be available at compile time
91 FLastPage: TfrmPCEBase;
92 FGiveMultiTabMessage: boolean;
93 procedure CreateChildForms(Sender: TObject; Location: integer);
94 procedure SynchPCEData;
95 procedure SwitchToPage(NewForm: TfrmPCEBase); //was tfrmPage
96 function PageIDToForm(PageID: Integer): TfrmPCEBase;
97 function PageIDToTab(PageID: Integer): string;
98 procedure LoadFormList(Location: integer);
99 procedure CreateForms;
100 procedure AddTabs;
101 function FormListContains(item: string): Boolean;
102 procedure SendData;
103 procedure UpdateEncounter(PCE: TPCEData);
104 procedure SetFormFonts;
105
106 public
107 procedure SelectTab(NewTabName: string);
108 property ChangeSource: Integer read FChangeSource;
109 property Forms: tstringlist read FormList;
110 property Cancel: Boolean read FCancel write FCancel;
111 property Abort: Boolean read FAbort write FAbort;
112 end;
113
114var
115 frmEncounterFrame: TfrmEncounterFrame;
116 uSCCond: TSCConditions;
117 uVisitType: TPCEProc; // contains info for visit type page
118 uEncPCEData: TPCEData;
119 uProviders: TPCEProviderList;
120
121// Returns true if PCE data still needs to be saved - vitals/gaf are always saved
122function UpdatePCE(PCEData: TPCEData; SaveOnExit: boolean = TRUE): boolean;
123
124implementation
125
126uses
127 uCore,
128 fGAF, uConst,
129 rCore, fPCEProvider, rMisc, VA508AccessibilityRouter, VAUtils;
130
131{$R *.DFM}
132
133{///////////////////////////////////////////////////////////////////////////////
134//Name: function TfrmEncounterFrame.PageIDToTab(PageID: Integer): String;
135//Created: Jan 1999
136//By: Robert Bott
137//Location: ISL
138//Description: returns the tab index that corresponds to a given PageID .
139///////////////////////////////////////////////////////////////////////////////}
140function TfrmEncounterFrame.PageIDToTab(PageID: Integer): String;
141begin
142 result := '';
143 case PageID of
144 CT_NOPAGE: Result := '';
145 CT_UNKNOWN: Result := '';
146 CT_VISITTYPE: Result := CT_VisitNm;
147 CT_DIAGNOSES: Result := CT_DiagNm;
148 CT_PROCEDURES: Result := CT_ProcNm;
149 CT_IMMUNIZATIONS: Result := CT_ImmNm;
150 CT_SKINTESTS: Result := CT_SkinNm;
151 CT_PATIENTED: Result := CT_PedNm;
152 CT_HEALTHFACTORS: Result := CT_HlthNm;
153 CT_EXAMS: Result := CT_XamNm;
154 CT_VITALS: Result := CT_VitNm;
155 CT_GAF: Result := CT_GAFNm;
156
157 end;
158end;
159
160
161{///////////////////////////////////////////////////////////////////////////////
162//Name: function TfrmEncounterFrame.PageIDToForm(PageID: Integer): TfrmPCEBase;
163//Created: Jan 1999
164//By: Robert Bott
165//Location: ISL
166//Description: return the form name based on the PageID}
167///////////////////////////////////////////////////////////////////////////////}
168function TfrmEncounterFrame.PageIDToForm(PageID: Integer): TfrmPCEBase;
169begin
170 case PageID of
171 CT_VISITTYPE: Result := frmVisitType;
172 CT_DIAGNOSES: Result := frmDiagnoses;
173 CT_PROCEDURES: Result := frmProcedures;
174 CT_IMMUNIZATIONS: Result := frmImmunizations;
175 CT_SKINTESTS: Result := frmSkinTests;
176 CT_PATIENTED: Result := frmPatientEd;
177 CT_HEALTHFACTORS: Result := frmHealthFactors;
178 CT_EXAMS: Result := frmExams;
179 CT_VITALS: Result := frmEncVitals;
180 CT_GAF: Result := frmGAF;
181 else //not a valid form
182 result := frmPCEBase;
183 end;
184end;
185
186
187{///////////////////////////////////////////////////////////////////////////////
188//Name: procedure TfrmEncounterFrame.CreatChildForms(Sender: TObject);
189//Created: Jan 1999
190//By: Robert Bott
191//Location: ISL
192//Description: Finds out what pages to display, has the pages and tabs created.
193///////////////////////////////////////////////////////////////////////////////}
194procedure TfrmEncounterFrame.CreateChildForms(Sender: TObject; Location: integer);
195begin
196 //load FormList with a list of all forms to display.
197 inherited;
198 LoadFormList(Location);
199 AddTabs;
200 CreateForms;
201end;
202
203
204
205{///////////////////////////////////////////////////////////////////////////////
206//Name: TfrmEncounterFrame.LoadFormList;
207//Created: Jan 1999
208//By: Robert Bott
209//Location: ISL
210//Description: Loads Formlist with the forms to create, will be replaced by RPC call.
211///////////////////////////////////////////////////////////////////////////////}
212procedure TfrmEncounterFrame.LoadFormList(Location: integer);
213begin
214 //change this to an RPC in RPCE.pas
215 FormList.clear;
216 FormList.add(CT_VisitNm);
217 FormList.add(CT_DiagNm);
218 FormList.add(CT_ProcNm);
219 formList.add(CT_VitNm);
220 formList.add(CT_ImmNm);
221 formList.add(CT_SkinNm);
222 formList.add(CT_PedNm);
223 formList.add(CT_HlthNm);
224 formList.add(CT_XamNm);
225 if MHClinic(Location) then
226 formList.add(CT_GAFNm);
227 end;
228
229
230{///////////////////////////////////////////////////////////////////////////////
231//Name: function TfrmEncounterFrame.FormListContains(item: string): Boolean;
232//Created: 12/06/98
233//By: Robert Bott
234//Location: ISL
235//Description: Returns a boolean value indicating if a given string exists in
236// the formlist.
237///////////////////////////////////////////////////////////////////////////////}
238function TfrmEncounterFrame.FormListContains(item: string): Boolean;
239begin
240 result := false;
241 if (FormList.IndexOf(item) <> -1 ) then
242 result := true;
243end;
244
245{///////////////////////////////////////////////////////////////////////////////
246//Name: procedure TfrmEncounterFrame.CreateForms;
247//Created: Jan 1999
248//By: Robert Bott
249//Location: ISL
250//Description: Creates all of the forms in the list.
251///////////////////////////////////////////////////////////////////////////////}
252procedure TfrmEncounterFrame.CreateForms;
253var
254 i: integer;
255begin
256 //could this be placed in a loop using PagedIdToTab & PageIDToFOrm & ?
257
258 if FormListContains(CT_VisitNm) then
259 frmVisitType := TfrmVisitType.CreateLinked(pnlPage);
260 if FormListContains(CT_DiagNm) then
261 frmDiagnoses := TfrmDiagnoses.CreateLinked(pnlPage);
262 if FormListContains(CT_ProcNm) then
263 frmProcedures := TfrmProcedures.CreateLinked(pnlPage);
264 if FormListContains(CT_VitNm) then
265 frmEncVitals := TfrmEncVitals.CreateLinked(pnlPage);
266 if FormListContains(CT_ImmNm) then
267 frmImmunizations := TfrmImmunizations.CreateLinked(pnlPage);
268 if FormListContains(CT_SkinNm) then
269 frmSkinTests := TfrmSkinTests.CreateLinked(pnlPage);
270 if FormListContains(CT_PedNm) then
271 frmPatientEd := TfrmPatientEd.CreateLinked(pnlPage);
272 if FormListContains(CT_HlthNm) then
273 frmHealthFactors := TfrmHEalthFactors.CreateLinked(pnlPage);
274 if FormListContains(CT_XamNm) then
275 frmExams := TfrmExams.CreateLinked(pnlPage);
276 if FormListContains(CT_GAFNm) then
277 frmGAF := TfrmGAF.CreateLinked(pnlPage);
278 //must switch based on caption, as all tabs may not be present.
279 for i := CT_FIRST to CT_LAST do
280 begin
281 if Formlist.IndexOf(PageIdToTab(i)) <> -1 then
282 PageIDToForm(i).Visible := (Formlist.IndexOf(PageIdToTab(i)) = 0);
283 end;
284end;
285
286
287{///////////////////////////////////////////////////////////////////////////////
288//Name: TfrmEncounterFrame.SwitchToPage(NewForm: tfrmPCEBase);
289//Created: Jan 1999
290//By: Robert Bott
291//Location: ISL
292//Description: Brings the selected page to the front for display.
293///////////////////////////////////////////////////////////////////////////////}
294procedure TfrmEncounterFrame.SwitchToPage(NewForm: tfrmPCEBase);// was TfrmPage);
295{ unmerge/merge menus, bring page to top of z-order, call form-specific OnDisplay code }
296begin
297 if (NewForm = nil) or (FLastPage = NewForm) then Exit;
298 if Assigned(FLastPage) then
299 FLastPage.Hide;
300 FLastPage := NewForm;
301// KeyPreview := (NewForm = frmEncVitals);
302 NewForm.DisplayPage; // this calls BringToFront for the form
303end;
304
305
306
307{///////////////////////////////////////////////////////////////////////////////
308//Name: procedure TfrmEncounterFrame.tabPageChange(Sender: TObject; NewTab: Integer; var AllowChange: Boolean);
309//Created: Jan 1999
310//By: Robert Bott
311//Location: ISL
312//Description: Finds the page, and calls SwithToPage to display it.
313///////////////////////////////////////////////////////////////////////////////}
314procedure TfrmEncounterFrame.tabPageChange(Sender: TObject; NewTab: Integer; var AllowChange: Boolean);
315{ switches to form linked to NewTab }
316var
317 i: integer;
318begin
319//must switch based on caption, as all tabs may not be present.
320for i := CT_FIRST to CT_LAST do
321 begin
322 With Formlist do
323 if NewTab = IndexOf(PageIdToTab(i)) then
324 begin
325 PageIDToForm(i).show;
326 SwitchToPage(PageIDToForm(i));
327 end;
328 end;
329end;
330
331{ Resize and Font-Change procedures --------------------------------------------------------- }
332
333{///////////////////////////////////////////////////////////////////////////////
334//Name: procedure TfrmEncounterFrame.FormResize(Sender: TObject);
335//Created: Jan 1999
336//By: Robert Bott
337//Location: ISL
338//Description: Resizes all windows when parent changes.
339///////////////////////////////////////////////////////////////////////////////}
340procedure TfrmEncounterFrame.FormResize(Sender: TObject);
341var
342 i: integer;
343begin
344 for i := CT_FIRST to CT_LAST do
345 if (FormList.IndexOf(PageIdToTab(i)) <> -1) then
346 MoveWindow(PageIdToForm(i).Handle, 0, 0, pnlPage.ClientWidth, pnlpage.ClientHeight, true);
347 self.repaint;
348end;
349
350{///////////////////////////////////////////////////////////////////////////////
351//Name: procedure TfrmEncounterFrame.AddTabs;
352//Created: Jan 1999
353//By: Robert Bott
354//Location: ISL
355//Description: adds a tab for each page that will be displayed
356///////////////////////////////////////////////////////////////////////////////}
357procedure TfrmEncounterFrame.AddTabs;
358
359var
360 i: integer;
361begin
362 TabControl.Tabs.Clear;
363 for I := 0 to (Formlist.count - 1) do
364 TabControl.Tabs.Add(Formlist.Strings[i]);
365end;
366
367
368{///////////////////////////////////////////////////////////////////////////////
369//Name: procedure UpdatePCE(PCEData: TPCEData);
370//Created: Jan 1999
371//By: Robert Bott
372//Location: ISL
373//Description: The main call to open the encounter frame and capture encounter
374// information.
375///////////////////////////////////////////////////////////////////////////////}
376function UpdatePCE(PCEData: TPCEData; SaveOnExit: boolean = TRUE): boolean;
377var
378// FontHeight,
379// FontWidth: Integer;
380 AUser: string;
381
382begin
383 frmEncounterFrame := TfrmEncounterFrame.Create(Application);
384 try
385 frmEncounterFrame.FAutoSave := SaveOnExit;
386
387 uEncPCEData := PCEData;
388 if(uEncPCEData.Empty and ((uEncPCEData.Location = 0) or (uEncPCEData.VisitDateTime = 0)) and
389 (not Encounter.NeedVisit)) then
390 uEncPCEData.UseEncounter := TRUE;
391 frmEncounterFrame.Caption := 'Encounter Form for ' + ExternalName(uEncPCEData.Location, 44) +
392 ' (' + FormatFMDateTime('mmm dd,yyyy@hh:nn', uEncPCEData.VisitDateTime) + ')';
393
394 uProviders.Assign(uEncPCEData.Providers);
395 SetDefaultProvider(uProviders, uEncPCEData);
396 AUser := IntToStr(uProviders.PendingIEN(FALSE));
397 if(AUser <> '0') and (uProviders.IndexOfProvider(AUser) < 0) and
398 AutoCheckout(uEncPCEData.Location) then
399 uProviders.AddProvider(AUser, uProviders.PendingName(FALSE), FALSE);
400
401 frmEncounterFrame.CreateChildForms(frmEncounterFrame, PCEData.Location);
402 ResizeAnchoredFormToFont(frmEncounterFrame);
403 SetFormPosition(frmEncounterFrame);
404
405 with frmEncounterFrame do
406 begin
407 SetRPCEncLocation(PCEData.Location);
408 SynchPCEData;
409 TabControl.Tabindex := 0;
410 TabControlChange(TabControl);
411
412 ShowModal;
413 Result := FSaveNeeded;
414 end;
415 finally
416 // frmEncounterFrame.Free; v22.11 (JD and SM)
417 frmEncounterFrame.Release;
418 //frmEncounterFrame := nil; access violation source? removed 7/28/03 RV
419 end;
420end;
421
422{///////////////////////////////////////////////////////////////////////////////
423//Name: TfrmEncounterFrame.SectionClick(Sender: TObject);
424//Created: Jan 1999
425//By: Robert Bott
426//Location: ISL
427//Description: Call the procedure apropriate for the selected tab
428///////////////////////////////////////////////////////////////////////////////}
429procedure TfrmEncounterFrame.SectionClick(Sender: TObject);
430begin
431 with Sender as TListBox do case Tag of
432 TAG_VTYPE: if FormListContains(CT_VisitNm) then
433 begin
434 with frmVisitType do
435 lstVTypeSectionClick(Sender);
436 end;
437 end;
438end;
439
440{///////////////////////////////////////////////////////////////////////////////
441//Name: procedure TfrmEncounterFrame.SynchPCEData;
442//Created: Jan 1999
443//By: Robert Bott
444//Location: ISL
445//Description: Synchronize any existing PCE data with what is displayed in the form.
446///////////////////////////////////////////////////////////////////////////////}
447procedure TfrmEncounterFrame.SynchPCEData;
448
449 procedure InitList(AListBox: TORListBox);
450 var
451 DoClick: boolean;
452
453 begin
454 with AListBox do
455 begin
456 DoClick := TRUE;
457 case Tag of
458 TAG_VTYPE: begin
459 if FormListContains(CT_VisitNm) then
460 ListVisitTypeSections(Items);
461 DoClick := AutoSelectVisit(PCERPCEncLocation);
462 end;
463 end;
464 if Items.Count > 0 then
465 begin
466 if DoClick then
467 begin
468 ItemIndex := 0;
469 SectionClick(AListBox);
470 end;
471 end
472 else Items.Add(TX_NOSECTION);
473 end;
474 end;
475
476begin
477 if FormListContains(CT_VisitNm) then
478 with frmVisitType do
479 begin
480 InitList(frmVisitType.lstVTypeSection); // set up Visit Type page
481 ListSCDisabilities(memSCDisplay.Lines);
482 uSCCond := EligbleConditions;
483 frmVisitType.fraVisitRelated.InitAllow(uSCCond);
484 end;
485 with uEncPCEData do // load any existing data from PCEData
486 begin
487 if FormListContains(CT_VisitNm) then
488 frmVisitType.fraVisitRelated.InitRelated(uEncPCEData);
489 if FormListContains(CT_DiagNm) then
490 frmDiagnoses.InitTab(CopyDiagnoses, ListDiagnosisSections);
491 if FormListContains(CT_ProcNm) then
492 frmProcedures.InitTab(CopyProcedures, ListProcedureSections);
493 if FormListContains(CT_ImmNm) then
494 frmImmunizations.InitTab(CopyImmunizations,ListImmunizSections);
495 if FormListContains(CT_SkinNm) then
496 frmSkinTests.InitTab(CopySkinTests, ListSkinSections);
497 if FormListContains(CT_PedNm) then
498 frmPatientEd.InitTab(CopyPatientEds, ListPatientSections);
499 if FormListContains(CT_HlthNm) then
500 frmHealthFactors.InitTab(CopyHealthFactors, ListHealthSections);
501 if FormListContains(CT_XamNm) then
502 frmExams.InitTab(CopyExams, ListExamsSections);
503 uVisitType.Assign(VisitType);
504 if FormListContains(CT_VisitNm) then
505 with frmVisitType do
506 begin
507 MatchVType;
508 end;
509 end;
510end;
511
512
513{///////////////////////////////////////////////////////////////////////////////
514//Name: procedure TfrmEncounterFrame.FormDestroy(Sender: TObject);
515//Created: Jan 1999
516//By: Robert Bott
517//Location: ISL
518//Description: Free up objects in memory when destroying form.
519///////////////////////////////////////////////////////////////////////////////}
520procedure TfrmEncounterFrame.FormDestroy(Sender: TObject);
521var
522 i: integer;
523
524begin
525 inherited;
526 for i := ComponentCount-1 downto 0 do
527 if(Components[i] is TForm) then
528 TForm(Components[i]).Free;
529
530 formlist.clear;
531 KillObj(@uProviders);
532 uVisitType.Free;
533 Formlist.free;
534end;
535
536
537{///////////////////////////////////////////////////////////////////////////////
538//Name: procedure TfrmEncounterFrame.FormCreate(Sender: TObject);
539//Created: Jan 1999
540//By: Robert Bott
541//Location: ISL
542//Description: Create instances of the objects needed.
543///////////////////////////////////////////////////////////////////////////////}
544procedure TfrmEncounterFrame.FormCreate(Sender: TObject);
545begin
546 uProviders := TPCEProviderList.Create;
547 uVisitType := TPCEProc.create;
548 //uVitalOld := TStringList.create;
549 //uVitalNew := TStringList.create;
550 FormList := TStringList.create;
551 fCancel := False;
552 FAbort := TRUE;
553 SetFormFonts;
554 FGiveMultiTabMessage := ScreenReaderSystemActive;
555end;
556
557
558{///////////////////////////////////////////////////////////////////////////////
559//Name: procedure TfrmEncounterFrame.SendData;
560//Created: Jan 1999
561//By: Robert Bott
562//Location: ISL
563//Description: Send Data back to the M side sor storing.
564///////////////////////////////////////////////////////////////////////////////}
565procedure TfrmEncounterFrame.SendData;
566//send PCE data to the RPC
567var
568 StoreMessage: string;
569 GAFScore: integer;
570 GAFDate: TFMDateTime;
571 GAFStaff: Int64;
572
573begin
574 inherited;
575 // do validation for vitals & anything else here
576
577 //process vitals
578 if FormListContains(CT_VitNm) then
579 begin
580 with frmEncVitals do
581 if HasData then
582 begin
583 if AssignVitals then
584 begin
585 StoreMessage := ValAndStoreVitals(frmEncVitals.VitalNew);
586 if (Storemessage <> 'True') then
587 begin
588 ShowMsg(storemessage);
589// exit;
590 end;
591 end;
592 end;
593 end;
594
595 if(FormListContains(CT_GAFNm)) then
596 begin
597 frmGAF.GetGAFScore(GAFScore, GAFDate, GAFStaff);
598 if(GAFScore > 0) then
599 SaveGAFScore(GAFScore, GAFDate, GAFStaff);
600 end;
601
602 //PCE
603
604 UpdateEncounter(uEncPCEData);
605 with uEncPCEData do
606 begin
607 if FAutoSave then
608 Save
609 else
610 FSaveNeeded := TRUE;
611 end;
612 Close;
613end;
614
615{///////////////////////////////////////////////////////////////////////////////
616//Name: procedure TfrmEncounterFrame.FormCloseQuery(Sender: TObject;
617//Created: Jan 1999
618//By: Robert Bott
619//Location: ISL
620//Description: Check to see if the Cancel button was pressed, if not, call
621// procedure to send the data to the server.
622///////////////////////////////////////////////////////////////////////////////}
623procedure TfrmEncounterFrame.FormCloseQuery(Sender: TObject;
624 var CanClose: Boolean);
625
626const
627 TXT_SAVECHANGES = 'Save Changes?';
628
629var
630 TmpPCEData: TPCEData;
631 ask, ChangeOK: boolean;
632
633begin
634 CanClose := True;
635 if(FAbort) then
636 FCancel := (InfoBox(TXT_SAVECHANGES, TXT_SAVECHANGES, MB_YESNO) = ID_NO);
637 if FCancel then Exit; //*KCM*
638
639 if(uProviders.PrimaryIdx >= 0) then
640 ask := TRUE
641 else
642 begin
643 TmpPCEData := TPCEData.Create;
644 try
645 uEncPCEData.CopyPCEData(TmpPCEData);
646 UpdateEncounter(TmpPCEData);
647 ask := TmpPCEData.NeedProviderInfo;
648 finally
649 TmpPCEData.Free;
650 end;
651 end;
652 if ask and (NoPrimaryPCEProvider(uProviders, uEncPCEData)) then
653 begin
654 InfoBox(TX_PROV_REQ, TC_PROV_REQ, MB_OK or MB_ICONWARNING);
655 CanClose := False;
656 Exit;
657 end;
658
659 uVisitType.Provider := uProviders.PrimaryIEN; {RV - v20.1}
660
661 if FormListContains(CT_VitNm) then
662 CanClose := frmEncVitals.OK2SaveVitals;
663
664 if CanClose and FormListContains(CT_ProcNm) then
665 begin
666 CanClose := frmProcedures.OK2SaveProcedures;
667 if not CanClose then
668 begin
669 tabPageChange(Self, FormList.IndexOf(CT_ProcNm), ChangeOK);
670 SwitchToPage(PageIDToForm(CT_PROCEDURES));
671 TabControl.TabIndex := FormList.IndexOf(CT_ProcNm);
672 end;
673 end;
674
675 if CanClose then SendData; //*KCM*
676
677end;
678
679procedure TfrmEncounterFrame.TabControlChange(Sender: TObject);
680var
681 i: integer;
682begin
683//must switch based on caption, as all tabs may not be present.
684 if (sender as tTabControl).tabindex = -1 then exit;
685
686 if TabControl.CanFocus and Assigned(FLastPage) and not TabControl.Focused then
687 TabControl.SetFocus; //CQ: 14845
688
689 for i := CT_FIRST to CT_LAST do
690 begin
691 with Formlist do
692 with sender as tTabControl do
693 if Tabindex = IndexOf(PageIdToTab(i)) then
694 begin
695 PageIDToForm(i).show;
696 SwitchToPage(PageIDToForm(i));
697 Exit;
698 end;
699 end;
700end;
701
702procedure TfrmEncounterFrame.TabControlChanging(Sender: TObject;
703 var AllowChange: Boolean);
704begin
705 if(assigned(FLastPage)) then
706 FLastPage.AllowTabChange(AllowChange);
707end;
708
709procedure TfrmEncounterFrame.UpdateEncounter(PCE: TPCEData);
710begin
711 with PCE do
712 begin
713 if FormListContains(CT_VisitNm) then
714 begin
715 VisitType := uVisitType;
716 frmVisitType.fraVisitRelated.GetRelated(uEncPCEData);
717 Providers.Merge(uProviders);
718 end;
719
720 if FormListContains(CT_DiagNm) then
721 SetDiagnoses(frmDiagnoses.lbGrid.Items);
722 if FormListContains(CT_ProcNm) then
723 SetProcedures(frmProcedures.lbGrid.Items);
724 if FormListContains(CT_ImmNm) then
725 SetImmunizations(frmImmunizations.lbGrid.Items);
726 if FormListContains(CT_SkinNm) then
727 SetSkinTests(frmSkinTests.lbGrid.Items);
728 if FormListContains(CT_PedNm) then
729 SetPatientEds(frmPatientEd.lbGrid.Items);
730 if FormListContains(CT_HlthNm) then
731 SetHealthFactors(frmHealthFactors.lbGrid.Items);
732 if FormListContains(CT_XamNm) then
733 SetExams(frmExams.lbGrid.Items);
734 end;
735end;
736
737procedure TfrmEncounterFrame.SelectTab(NewTabName: string);
738var
739 AllowChange: boolean;
740begin
741 AllowChange := True;
742 tabControl.TabIndex := FormList.IndexOf(NewTabName);
743 tabPageChange(Self, tabControl.TabIndex, AllowChange);
744end;
745
746procedure TfrmEncounterFrame.TabControlEnter(Sender: TObject);
747begin
748 if FGiveMultiTabMessage then // CQ#15483
749 begin
750 FGiveMultiTabMessage := FALSE;
751 GetScreenReader.Speak('Multi tab form');
752 end;
753end;
754
755procedure TfrmEncounterFrame.FormKeyDown(Sender: TObject; var Key: Word;
756 Shift: TShiftState);
757var
758 CanChange: boolean;
759begin
760 inherited;
761 if (Key = VK_ESCAPE) then
762 begin
763 Key := 0;
764 FLastPage.btnCancel.Click;
765 end
766 else if Key = VK_TAB then
767 begin
768 if ssCtrl in Shift then
769 begin
770 CanChange := True;
771 if Assigned(TabControl.OnChanging) then
772 TabControl.OnChanging(TabControl, CanChange);
773 if CanChange then
774 begin
775 if ssShift in Shift then
776 begin
777 if TabControl.TabIndex < 1 then
778 TabControl.TabIndex := TabControl.Tabs.Count -1
779 else
780 TabControl.TabIndex := TabControl.TabIndex - 1;
781 end
782 else
783 TabControl.TabIndex := (TabControl.TabIndex + 1) mod TabControl.Tabs.Count;
784 if Assigned(TabControl.OnChange) then
785 TabControl.OnChange(TabControl);
786 end;
787 Key := 0;
788 end;
789 end;
790end;
791
792procedure TfrmEncounterFrame.SetFormFonts;
793var
794 NewFontSize: integer;
795begin
796 NewFontSize := MainFontsize;
797 if FormListContains(CT_VisitNm) then
798 frmVisitType.Font.Size := NewFontSize;
799 if FormListContains(CT_DiagNm) then
800 frmDiagnoses.Font.Size := NewFontSize;
801 if FormListContains(CT_ProcNm) then
802 frmProcedures.Font.Size := NewFontSize;
803 if FormListContains(CT_ImmNm) then
804 frmImmunizations.Font.Size := NewFontSize;
805 if FormListContains(CT_SkinNm) then
806 frmSkinTests.Font.Size := NewFontSize;
807 if FormListContains(CT_PedNm) then
808 frmPatientEd.Font.Size := NewFontSize;
809 if FormListContains(CT_HlthNm) then
810 frmHealthFactors.Font.Size := NewFontSize;
811 if FormListContains(CT_XamNm) then
812 frmExams.Font.Size := NewFontSize;
813 if FormListContains(CT_VitNm) then
814 frmEncVitals.Font.Size := NewFontSize;
815 if FormListContains(CT_GAFNm) then
816 frmGAF.SetFontSize(NewFontSize);
817end;
818
819procedure TfrmEncounterFrame.FormClose(Sender: TObject;
820 var Action: TCloseAction);
821begin
822 SaveUserBounds(Self);
823end;
824
825procedure TfrmEncounterFrame.FormCanResize(Sender: TObject; var NewWidth,
826 NewHeight: Integer; var Resize: Boolean);
827begin
828 //CQ4740
829 if NewWidth < 200 then
830 begin
831 NewWidth := 200;
832 Resize := false;
833 end;
834end;
835
836procedure TfrmEncounterFrame.FormShow(Sender: TObject);
837begin
838 inherited;
839 if TabControl.CanFocus then
840 TabControl.SetFocus;
841end;
842
843end.
Note: See TracBrowser for help on using the repository browser.