Module

fPtDemo

Path

C:\CPRS\CPRS30\fPtDemo.pas

Last Modified

7/15/2014 3:26:38 PM

Units Used in Interface

Name Comments
fBase508Form -
uReports -

Units Used in Implementation

Name Comments
rCover -
rReports -
uCore -

Classes

Name Comments
TfrmPtDemo -

Procedures

Name Owner Declaration Scope Comments
cmdCloseClick TfrmPtDemo procedure cmdCloseClick(Sender: TObject); Public/Published -
cmdNewPtClick TfrmPtDemo procedure cmdNewPtClick(Sender: TObject); Public/Published -
cmdPrintClick TfrmPtDemo procedure cmdPrintClick(Sender: TObject); Public/Published -
FormCreate TfrmPtDemo procedure FormCreate(Sender: TObject); Public/Published -
PatientInquiry - procedure PatientInquiry(var NewPt: Boolean); Interfaced Displays patient demographics, returns true in NewPt if the user pressed 'Select New' btn


Module Source

1     unit fPtDemo;
2     
3     interface
4     
5     uses
6       Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7       StdCtrls, ExtCtrls, ORCtrls, ORFn, ComCtrls, fBase508Form,
8       VA508AccessibilityManager, uReports;
9     
10    type
11      TfrmPtDemo = class(TfrmBase508Form)
12        lblFontTest: TLabel;
13        memPtDemo: TRichEdit;
14        pnlTop: TORAutoPanel;
15        cmdNewPt: TButton;
16        cmdClose: TButton;
17        cmdPrint: TButton;
18        dlgPrintReport: TPrintDialog;
19        procedure cmdCloseClick(Sender: TObject);
20        procedure cmdNewPtClick(Sender: TObject);
21        procedure FormCreate(Sender: TObject);
22        procedure cmdPrintClick(Sender: TObject);
23      private
24        { Private declarations }
25        FNewPt: Boolean;
26      public
27        { Public declarations }
28      end;
29    
30    procedure PatientInquiry(var NewPt: Boolean);
31    
32    implementation
33    
34    {$R *.DFM}
35    
36    uses rCover, rReports, Printers, uCore;
37    
38    procedure PatientInquiry(var NewPt: Boolean);
39    { displays patient demographics, returns true in NewPt if the user pressed 'Select New' btn }
40    var
41      frmPtDemo: TfrmPtDemo;
42    begin
43      if StrToInt64Def(Patient.DFN, 0) <= 0 then exit;
44      frmPtDemo := TfrmPtDemo.Create(Application);
45      try
46        with frmPtDemo do
47        begin
48          frmPtDemo.ShowModal;
49          NewPt := FNewPt;
50        end; {with frmPtDemo}
51      finally
52        frmPtDemo.Release;
53      end;
54    end;
55    
56    procedure TfrmPtDemo.FormCreate(Sender: TObject);
57    var
58      i, MaxWidth, AWidth, AHeight: Integer;
59      Rect: TRect;
60    begin
61      FNewPt := False;
62      LoadDemographics(memPtDemo.Lines);
63      memPtDemo.SelStart := 0;
64      ResizeAnchoredFormToFont(self);
65      MaxWidth := 350;                                // make sure at least 350 wide
66      for i := 0 to memPtDemo.Lines.Count - 1 do
67      begin
68        AWidth := lblFontTest.Canvas.TextWidth(memPtDemo.Lines[i]);
69        if AWidth > MaxWidth then MaxWidth := AWidth;
70      end;
71      { width = borders + inset of memo box (left=8) }
72      MaxWidth := MaxWidth + (GetSystemMetrics(SM_CXFRAME) * 2)
73                           + GetSystemMetrics(SM_CXVSCROLL) + 16;
74      { height = height of lines + title bar + borders + 4 lines (room for buttons) }
75      AHeight := ((memPtDemo.Lines.Count + 4) * (lblFontTest.Height + 1))
76                 + (GetSystemMetrics(SM_CYFRAME) * 3) + GetSystemMetrics(SM_CYCAPTION);
77      AHeight := HigherOf(AHeight, 250);              // make sure at least 250 high
78      if AHeight > (Screen.Height - 120) then AHeight := Screen.Height - 120;
79      if MaxWidth > Screen.Width then MaxWidth := Screen.Width;
80      Width := MaxWidth;
81      Height := AHeight;
82      Constraints.MinHeight := pnlTop.Height + GetSystemMetrics(SM_CYCAPTION) + GetSystemMetrics(SM_CYHSCROLL) + 7;
83      Rect := BoundsRect;
84      ForceInsideWorkArea(Rect);
85      BoundsRect := Rect;
86    end;
87    
88    procedure TfrmPtDemo.cmdNewPtClick(Sender: TObject);
89    begin
90      FNewPt := True;
91      Close;
92    end;
93    
94    procedure TfrmPtDemo.cmdCloseClick(Sender: TObject);
95    begin
96      Close;
97    end;
98    
99    procedure TfrmPtDemo.cmdPrintClick(Sender: TObject);
100   var
101     AHeader: TStringList;
102     memPrintReport: TRichEdit;
103     StartLine, MaxLines, LastLine, ThisPage, i: integer;
104     ErrMsg: string;
105     RemoteSiteID: string;    //for Remote site printing
106     RemoteQuery: string;    //for Remote site printing
107   const
108     PAGE_BREAK = '**PAGE BREAK**';
109   begin
110     RemoteSiteID := '';
111     RemoteQuery := '';
112     if dlgPrintReport.Execute then
113       begin
114         AHeader := TStringList.Create;
115         CreatePatientHeader(AHeader, Self.Caption);
116         memPrintReport := CreateReportTextComponent(Self);
117         try
118           MaxLines := 60 - AHeader.Count;
119           LastLine := 0;
120           ThisPage := 0;
121           with memPrintReport do
122             begin
123               StartLine := 4;
124               repeat
125                 with Lines do
126                   begin
127                     for i := StartLine to MaxLines do
128                       //if i < memPtDemo.Lines.Count - 1 then
129                       if i < memPtDemo.Lines.Count then
130                         Add(memPtDemo.Lines[LastLine + i])
131                       else
132                         Break;
133                     LastLine := LastLine + i;
134                     Add(' ');
135                     Add(' ');
136                     Add(StringOfChar('-', 74));
137                     if LastLine >= memPtDemo.Lines.Count - 1 then
138                       Add('End of report')
139                     else
140                       begin
141                         ThisPage := ThisPage + 1;
142                         Add('Page ' + IntToStr(ThisPage));
143                         Add(PAGE_BREAK);
144                         StartLine := 0;
145                       end;
146                   end;
147                 until LastLine >= memPtDemo.Lines.Count - 1;
148               PrintWindowsReport(memPrintReport, PAGE_BREAK, Self.Caption, ErrMsg, True);
149             end;
150         finally
151           memPrintReport.Free;
152           AHeader.Free;
153         end;
154       end;
155     memPtDemo.SelStart := 0;
156     memPtDemo.Invalidate;
157   end;
158   
159   end.

Module Calls (2 levels)


fPtDemo
 ├fBase508Form
 │ ├uConst
 │ └uHelpManager
 ├uReports
 ├rCover
 │ ├uConst
 │ ├fFrame
 │ ├uCore
 │ ├rMeds
 │ └uReminders
 ├rReports
 │ ├uCore...
 │ ├rCore
 │ └uReports
 └uCore...

Module Called-By (2 levels)


                    fPtDemo
                   fFrame┘ 
              CPRSChart┤   
                  fPage┤   
                uOrders┤   
                fODBase┤   
                UBACore┤   
                fOrders┤   
                   uPCE┤   
      fBALocalDiagnoses┤   
             fEncVitals┤   
                fVitals┤   
                 fCover┤   
                 rCover┤   
              fPtSelMsg┤   
                 fPtSel┤   
            fOrdersSign┤   
         fPrintLocation┤   
                  fMeds┤   
                fRptBox┤   
                 fNotes┤   
               fReports┤   
                 fEncnt┤   
                 fProbs┤   
          fReportsPrint┤   
                fGraphs┤   
              fConsults┤   
                fDCSumm┤   
        fReminderDialog┤   
                  fLabs┤   
              fLabPrint┤   
                fReview┤   
            fIconLegend┤   
           fOrdersPrint┤   
               fSurgery┤   
uVA508CPRSCompatibility┤   
           fOrdersRenew┤   
             fODConsult┤   
                fODProc┤   
                 fODRad┤   
                 fODLab┤   
                fODMeds┤   
               fODMedIV┤   
              fODVitals┤   
                fODAuto┤   
                 fOMSet┤   
         fOrdersRelease┤   
              fODMedNVA┤   
         fOrdersOnChart┤   
             fOCSession┤   
              fODActive┤   
               fPCEEdit┘