Module

fSkinTest

Path

C:\CPRS\CPRS30\Encounter\fSkinTest.pas

Last Modified

7/15/2014 3:26:36 PM

Initialization Code

initialization
  SpecifyFormIsNotADialog(TfrmSkinTests);

end.

Units Used in Interface

Name Comments
fPCEBase -
fPCEBaseMain -
fPCELex -
fPCEOther -
rCore -
rPCE -
uPCE -

Units Used in Implementation

Name Comments
fEncounterFrame -

Classes

Name Comments
TfrmSkinTests -

Procedures

Name Owner Declaration Scope Comments
cboSkinResultsChange TfrmSkinTests procedure cboSkinResultsChange(Sender: TObject); Public/Published -
edtDTGivenChange TfrmSkinTests procedure edtDTGivenChange(Sender: TObject); Public/Published
Var
  DtRead: TFMDateTime;
  ASkinTest: TPCESkin;
begin
  inherited;
  if lstSkinSelect.ItemIndex < 0 then Exit;

  with lstSkinSelect do ASkinTest := TPCESkin(Items.Objects[ItemIndex]);
  DtRead := StrToFMDateTime(edtReading.text);
  with lstSkinSelect do if (ItemIndex > -1) then
  begin
    ASkinTest.DTRead := DTRead;
    Items[ItemIndex] := ASkinTest.ItemStr;
  end;
end;
edtDtReadChange TfrmSkinTests procedure edtDtReadChange(Sender: TObject); Public/Published -
EdtReadingChange TfrmSkinTests procedure EdtReadingChange(Sender: TObject); Public/Published
//Name:procedure TfrmSkinTests.EdtReadingChange(Sender: TObject);
//Created: Jan 1999
//By: Robert Bott
//Location: ISL
//Description:Change the reading assigned to the skin test.
///////////////////////////////////////////////////////////////////////////////
FormCreate TfrmSkinTests procedure FormCreate(Sender: TObject); Public/Published
Var
  DtGiven: TFMDateTime;
  ASkinTest: TPCESkin;
begin
  inherited;
  if lstSkinSelect.ItemIndex < 0 then Exit;

  with lstSkinSelect do ASkinTest := TPCESkin(Items.Objects[ItemIndex]);
  DtGiven := StrToFMDateTime(edtDTGiven.text);
  with lstSkinSelect do if (ItemIndex > -1) then
  begin
    ASkinTest.DTGiven := DTGIven;
    Items[ItemIndex] := ASkinTest.ItemStr;
  end;
end;


procedure TfrmSkinTests.CheckSkinRules;
begin
  //Results must be between 0 and 40
  if StrToInt(EdtReading.Text) < 0 then EdtReading.text := '0';
  if StrToInt(EdtReading.Text) > 40 then EdtReading.text := '40';

(*  //if reading >10, result must be "positive"
  if (StrToInt(EdtReading.Text) > 9) and
    (CompareText(Piece(cboSkinResults.items[cboSkinResults.itemindex],U,1),'P') <> 0) then
    begin
      if (Piece(cboSkinResults.items[cboSkinResults.itemindex],U,1) = '@') then    // not selected
      begin
        cboSkinResults.SelectById('P');
      end
      else
      begin
        Show508Message('If the reading is over 9, the results are required to be positive.');
        cboSkinResults.SelectById('P');
       end;
    end;
end;
UpdateControls TfrmSkinTests procedure UpdateControls; override; Protected -
UpdateNewItemStr TfrmSkinTests procedure UpdateNewItemStr(var x: string); override; Protected -
UpDnReadingChanging TfrmSkinTests procedure UpDnReadingChanging(Sender: TObject; var AllowChange: Boolean); Public/Published -

Global Variables

Name Type Declaration Comments
frmSkinTests TfrmSkinTests frmSkinTests: TfrmSkinTests; -


Module Source

1     unit fSkinTest;
2     
3     interface
4     
5     uses
6       Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
7       fPCEBase, ORCtrls, StdCtrls, ComCtrls, CheckLst, ExtCtrls, Buttons, uPCE, rPCE, ORFn,
8       fPCELex, fPCEOther, rCore, fPCEBaseMain, VA508AccessibilityManager;
9     
10    type
11      TfrmSkinTests = class(TfrmPCEBaseMain)
12        lblSkinResults: TLabel;
13        lblDTRead: TLabel;
14        lblReading: TLabel;
15        lblDTGiven: TLabel;
16        UpDnReading: TUpDown;
17        EdtReading: TCaptionEdit;
18        edtDtRead: TCaptionEdit;
19        edtDTGiven: TCaptionEdit;
20        cboSkinResults: TORComboBox;
21        procedure cboSkinResultsChange(Sender: TObject);
22        procedure EdtReadingChange(Sender: TObject);
23        procedure edtDtReadChange(Sender: TObject);
24        procedure edtDTGivenChange(Sender: TObject);
25        procedure FormCreate(Sender: TObject);
26        procedure UpDnReadingChanging(Sender: TObject;
27          var AllowChange: Boolean);
28      private
29      protected
30        procedure UpdateNewItemStr(var x: string); override;
31        procedure UpdateControls; override;
32      public
33      end;
34    
35    var
36      frmSkinTests: TfrmSkinTests;
37    
38    implementation
39    
40    {$R *.DFM}
41    
42    uses
43      fEncounterFrame, VA508AccessibilityRouter;
44    
45    procedure TfrmSkinTests.cboSkinResultsChange(Sender: TObject);
46    var
47      i: integer;
48    
49    begin
50      if(NotUpdating) and (cboSkinResults.Text <> '') then
51      begin
52        for i := 0 to lbGrid.Items.Count-1 do
53          if(lbGrid.Selected[i]) then
54            TPCESkin(lbGrid.Items.Objects[i]).Results := cboSkinResults.ItemID;
55        GridChanged;
56      end;
57    end;
58    
59    {///////////////////////////////////////////////////////////////////////////////
60    //Name:procedure TfrmSkinTests.EdtReadingChange(Sender: TObject);
61    //Created: Jan 1999
62    //By: Robert Bott
63    //Location: ISL
64    //Description:Change the reading assigned to the skin test.
65    ///////////////////////////////////////////////////////////////////////////////}
66    procedure TfrmSkinTests.EdtReadingChange(Sender: TObject);
67    var
68      x, i: integer;
69    
70    begin
71      if(NotUpdating) then
72      begin
73        x := StrToIntDef(EdtReading.Text, 0);
74        for i := 0 to lbGrid.Items.Count-1 do
75          if(lbGrid.Selected[i]) then
76            TPCESkin(lbGrid.Items.Objects[i]).Reading := x;
77        GridChanged;
78      end;
79    end;
80    
81    procedure TfrmSkinTests.edtDtReadChange(Sender: TObject);
82    begin
83    end;
84    (*
85    var
86      DtRead: TFMDateTime;
87      ASkinTest: TPCESkin;
88    begin
89      inherited;
90      if lstSkinSelect.ItemIndex < 0 then Exit;
91    
92      with lstSkinSelect do ASkinTest := TPCESkin(Items.Objects[ItemIndex]);
93      DtRead := StrToFMDateTime(edtReading.text);
94      with lstSkinSelect do if (ItemIndex > -1) then
95      begin
96        ASkinTest.DTRead := DTRead;
97        Items[ItemIndex] := ASkinTest.ItemStr;
98      end;
99    end;
100   *)
101   
102   procedure TfrmSkinTests.edtDTGivenChange(Sender: TObject);
103   begin
104   end;
105   (*
106   var
107     DtGiven: TFMDateTime;
108     ASkinTest: TPCESkin;
109   begin
110     inherited;
111     if lstSkinSelect.ItemIndex < 0 then Exit;
112   
113     with lstSkinSelect do ASkinTest := TPCESkin(Items.Objects[ItemIndex]);
114     DtGiven := StrToFMDateTime(edtDTGiven.text);
115     with lstSkinSelect do if (ItemIndex > -1) then
116     begin
117       ASkinTest.DTGiven := DTGIven;
118       Items[ItemIndex] := ASkinTest.ItemStr;
119     end;
120   end;
121   *)
122   (*
123   procedure TfrmSkinTests.CheckSkinRules;
124   begin
125     //Results must be between 0 and 40
126     if StrToInt(EdtReading.Text) < 0 then EdtReading.text := '0';
127     if StrToInt(EdtReading.Text) > 40 then EdtReading.text := '40';
128   
129   (*  //if reading >10, result must be "positive"
130     if (StrToInt(EdtReading.Text) > 9) and
131       (CompareText(Piece(cboSkinResults.items[cboSkinResults.itemindex],U,1),'P') <> 0) then
132       begin
133         if (Piece(cboSkinResults.items[cboSkinResults.itemindex],U,1) = '@') then    // not selected
134         begin
135           cboSkinResults.SelectById('P');
136         end
137         else
138         begin
139           Show508Message('If the reading is over 9, the results are required to be positive.');
140           cboSkinResults.SelectById('P');
141          end;
142       end;
143   end;
144   *)
145   
146   procedure TfrmSkinTests.FormCreate(Sender: TObject);
147   begin
148     inherited;
149     FTabName := CT_SkinNm;
150     FPCEListCodesProc := ListSkinCodes;
151     FPCEItemClass := TPCESkin;
152     FPCECode := 'SK';
153     PCELoadORCombo(cboSkinResults);
154   end;
155   
156   procedure TfrmSkinTests.UpdateNewItemStr(var x: string);
157   begin
158     SetPiece(x, U, pnumSkinResults, NoPCEValue);
159     SetPiece(x, U, pnumSkinReading, '0');
160   //  SetPiece(x, U, pnumSkinDTRead);
161   //  SetPiece(x, U, pnumSkinDTGiven);
162   end;
163   
164   procedure TfrmSkinTests.UpdateControls;
165   var
166     ok, First: boolean;
167     SameRes, SameRead: boolean;
168     i: integer;
169     Res: string;
170     Read: integer;
171     Obj: TPCESkin;
172   
173   begin
174     inherited;
175     if(NotUpdating) then
176     begin
177       BeginUpdate;
178       try
179         ok := (lbGrid.SelCount > 0);
180         lblSkinResults.Enabled := ok;
181         lblReading.Enabled := ok;
182         cboSkinResults.Enabled := ok;
183         EdtReading.Enabled := ok;
184         UpDnReading.Enabled := ok;
185         if(ok) then
186         begin
187           First := TRUE;
188           SameRes := TRUE;
189           SameRead := TRUE;
190           Res := NoPCEValue;
191           Read := 0;
192           for i := 0 to lbGrid.Items.Count-1 do
193           begin
194             if lbGrid.Selected[i] then
195             begin
196               Obj := TPCESkin(lbGrid.Items.Objects[i]);
197               if(First) then
198               begin
199                 First := FALSE;
200                 Res := Obj.Results;
201                 Read := Obj.Reading;
202               end
203               else
204               begin
205                 if(SameRes) then
206                   SameRes := (Res = Obj.Results);
207                 if(SameRead) then
208                   SameRead := (Read = Obj.Reading);
209               end;
210             end;
211           end;
212           if(SameRes) then
213             cboSkinResults.SelectByID(Res)
214           else
215             cboSkinResults.Text := '';
216           if(SameRead) then
217           begin
218             UpDnReading.Position := Read;
219             EdtReading.Text := IntToStr(Read);
220             EdtReading.SelStart := length(EdtReading.Text);
221           end
222           else
223           begin
224             UpDnReading.Position := 0;
225             EdtReading.Text := '';
226           end;
227         end
228         else
229         begin
230           cboSkinResults.Text := '';
231           EdtReading.Text := '';
232         end;
233       finally
234         EndUpdate;
235       end;
236     end;
237   end;
238   
239   procedure TfrmSkinTests.UpDnReadingChanging(Sender: TObject;
240     var AllowChange: Boolean);
241   begin
242     inherited;
243     if(UpDnReading.Position = 0) then
244       EdtReadingChange(Sender);
245   end;
246   
247   initialization
248     SpecifyFormIsNotADialog(TfrmSkinTests);
249   
250   end.

Module Calls (2 levels)


fSkinTest
 ├fPCEBase
 │ ├uConst
 │ ├fAutoSz
 │ ├fBase508Form
 │ └fEncounterFrame
 ├uPCE
 │ ├uConst
 │ ├uCore
 │ ├rPCE
 │ ├rCore
 │ ├rTIU
 │ ├fEncounterFrame...
 │ ├uVitals
 │ ├fFrame
 │ ├fPCEProvider
 │ └rVitals
 ├rPCE...
 ├fPCEBaseMain
 │ ├fPCEBaseGrid
 │ ├rPCE...
 │ ├uPCE...
 │ ├fPCELex
 │ ├fPCEOther
 │ ├fEncounterFrame...
 │ ├fHFSearch
 │ ├fBase508Form...
 │ └UBAConst
 └fEncounterFrame...

Module Called-By (2 levels)


        fSkinTest
fEncounterFrame┘ 
         uPCE┤   
         rPCE┤   
     fPCEBase┤   
   fVisitType┤   
   fDiagnoses┤   
 fPCEBaseMain┤   
   fProcedure┤   
    fPCEOther┤   
fImmunization┤   
 fSkinTest...┤   
   fPatientEd┤   
fHealthFactor┤   
        fExam┤   
   fEncVitals┤   
       fNotes┤   
    fConsults┤   
      fDCSumm┤   
     fSurgery┤   
         fGAF┤   
     fPCEEdit┤   
    fHFSearch┘