source: cprs/branches/tmg-cprs/CPRS-Chart/Encounter/fEncounterFrame.pas

Last change on this file was 496, checked in by Kevin Toppenberg, 15 years ago

Fixed missing TDKLang. Class, Added email demographic, Fixed field error in demographis

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