source: cprs/branches/foia-cprs/CPRS-Chart/Encounter/fEncounterFrame.pas@ 459

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

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