Module

fMHTest

Path

C:\CPRS\CPRS30\fMHTest.pas

Last Modified

7/15/2014 3:26:38 PM

Units Used in Interface

Name Comments
fBase508Form -
rCore -
uConst -
uCore -
uDlgComponents -

Units Used in Implementation

Name Comments
fFrame -
rReminders -

Classes

Name Comments
TfrmMHTest -
TMHQuestion -

Procedures

Name Owner Declaration Scope Comments
AdjDY - procedure AdjDY(Ht: integer); Local -
btnClearClick TfrmMHTest procedure btnClearClick(Sender: TObject); Public/Published -
btnOKClick TfrmMHTest procedure btnOKClick(Sender: TObject); Public/Published -
BuildControls TfrmMHTest procedure BuildControls; Private -
BuildControls TMHQuestion procedure BuildControls(var Y: integer; Wide: integer); Public TMHQuestion
CloseMHDLL - procedure CloseMHDLL; Interfaced -
FormCreate TfrmMHTest procedure FormCreate(Sender: TObject); Public/Published
Function TfrmMHTest.Answers: string;
var
  i, XCnt: integer;
  ans: string;

begin
  Result := '';
  XCnt := 0;
  for i := 0 to FObjs.Count-1 do
  begin
    ans := TMHQuestion(FObjs[i]).FAnswer;
    if(ans = Skipped) then
      inc(XCnt);
    Result := Result + ans;
  end;
  if(XCnt = FObjs.Count) then
    Result := '';
end;

function TfrmMHTest.LoadTest(InitialAnswers, TestName: string): boolean;
var
  TstData: TStringList;
  lNum, i, idx: integer;
  Line, LastLine, Inp, Code: string;
  Txt, Spec, p, Spidx, tmp: string;
  RSpec, First, TCodes: boolean;
  QObj: TMHQuestion;

  procedure ParseText;
  var
    i, tlen: integer;

  begin
    Code := '';
    i := 1;
    tlen := length(Txt);
    while(i <= tlen) do
    begin
      while(i <= tlen) and (Txt[i] = ' ') do inc(i);
      if(i > tlen) then
      begin
        Txt := '';
        exit;
      end;
      if(i > 1) then
      begin
        delete(Txt,1,i-1);
        i := 1;
      end;
      if(Spec = 'I') then exit;
      tlen := length(Txt);
      if(tlen < 3) then exit;
      Code := copy(Txt,i,1);
      if(pos(Code, (UpperCaseLetters + LowerCaseLetters + Digits)) = 0) then
      begin
        Code := '';
        exit;
      end;
      inc(i);
      while(i <= tlen) and (Txt[i] = ' ') do inc(i);
      if(Txt[i] in ['.','=']) then
      begin
        if(pos(Code, QObj.FAllowedAnswers) > 0) then
        begin
          inc(i);
          while(i <= tlen) and (Txt[i] = ' ') do inc(i);
          if(i <= tlen) then
            delete(Txt,1,i-1)
          else
            Code := '';
          exit;
        end
        else
        begin
          Code := '';
          exit;
        end;
      end
      else
      begin
        Code := '';
        exit;
      end;
    end;
  end;

  procedure AddTxt2Str(var X: string);
  begin
    if(Txt <> '') then
    begin
      if(X <> '') then
      begin
        X := X + ' ';
        if(copy(Txt, length(Txt), 1) = '.') then
          X := X + ' ';
      end;
      X := X + Txt;
    end;
  end;

begin
  Result := TRUE;
  TstData := TStringList.Create;
  try
    FastAssign(LoadMentalHealthTest(TestName), TstData);
    if TstData.Strings[0] = '1' then MHA3 := True
    else MHA3 := False;
    Screen.Cursor := crHourGlass;
    try
      TstData.Add('99999;X;0');
      idx := 1;
      FMaxLines := 0;
      FInfoText := '';
      LastLine := U;
      First := TRUE;
      RSpec := FALSE;
      TCodes := FALSE;
      QObj := nil;
      while (idx < TstData.Count) do
      begin
        Inp := TstData[idx];
        if(pos('[ERROR]', Inp) > 0) then
        begin
          Result := FALSE;
          break;
        end;
        p := Piece(Inp, U, 1);
        Line := Piece(p, ';', 1);
        Spec := Piece(p, ';', 2);
        SpIdx := Piece(p, ';', 3);
        if(LastLine <> Line) then
        begin
          LastLine := Line;
          if(First) then
            First := FALSE
          else
          begin
            if(not RSpec) then
            begin
              Result := FALSE;
              break;
            end;
          end;
          if(Spec = 'X') then break;
          lNum := StrToIntDef(Line, 0);
          if(lNum <= 0) then
          begin
            Result := FALSE;
            break;
          end;
          RSpec := FALSE;
          TCodes := FALSE;
          QObj := TMHQuestion(FObjs[FObjs.Add(TMHQuestion.Create)]);
          QObj.FLine := lNum;
          if(FMaxLines < lNum) then
            FMaxLines := lNum;
        end;
        Txt := Piece(Inp, U, 2);
        ParseText;
        if(Txt <> '') then
        begin
          if(Spec = 'I') then
          begin
           if MHA3 = True then AddTxt2Str(QObj.FText)
           else
           AddTxt2Str(FInfoText);;
          end
          else
          if(Spec = 'R') then
          begin
            RSpec := TRUE;
            if(spIdx = '0') then
              QObj.FAllowedAnswers := Txt
            else
            if(Code = '') then
              QObj.FAnswerText := Txt
            else
            begin
              QObj.FSeeAnswers := FALSE;
              FAnswers.Add(Code + U + Txt);
              inc(QObj.FAnswerCount);
            end;
          end
          else
          if(Spec = 'T') then
          begin
            if(Code = '') then
            begin
              if(TCodes) then
              begin
                tmp := FAnswers[FAnswers.Count-1];
                AddTxt2Str(tmp);
                FAnswers[FAnswers.Count-1] := tmp;
              end
              else
                AddTxt2Str(QObj.FText);
            end
            else
            begin
              TCodes := TRUE;
              FAnswers.Add(Code + U + Txt);
              inc(QObj.FAnswerCount);
            end;
          end;
        end;
        inc(idx);
      end;
    finally
      Screen.Cursor := crDefault;
    end;
  finally
    TstData.Free;
  end;
  if(not Result) then
    InfoBox('Error encountered loading ' + TestName, 'Error', MB_OK)
  else
  begin
    for i := 0 to FObjs.Count-1 do
    begin
      with TMHQuestion(FObjs[i]) do
      begin
        tmp := copy(InitialAnswers,i+1,1);
        if(tmp <> '') then
          FAnswer := tmp;
      end;
    end;
  end;
end;
FormDestroy TfrmMHTest procedure FormDestroy(Sender: TObject); Public/Published -
FormKeyDown TfrmMHTest procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); Public/Published -
FormShow TfrmMHTest procedure FormShow(Sender: TObject); Public/Published -
GetRLbl - procedure GetRLbl; Local -
GotoQ TfrmMHTest procedure GotoQ(x: integer); Private -
LoadMHDLL - procedure LoadMHDLL; Global MHDLLAUXName = 'YS_MHA_AUX.DLL';
OnChange TMHQuestion procedure OnChange(Sender: TObject); Protected -
ProcessMsg - procedure ProcessMsg; Global -
RemoveMHTest - procedure RemoveMHTest(TestName: string); Interfaced -
sbMainResize TfrmMHTest procedure sbMainResize(Sender: TObject); Public/Published -
UnloadMHDLL - procedure UnloadMHDLL; Global -

Functions

Name Owner Declaration Scope Comments
CallMHDLL TfrmMHTest function CallMHDLL(TestName: string; Required: boolean): String; Public
Procedure TfrmMHTest.GetQText(QText: TStringList);
var
  i, lx: integer;

begin
  if(FObjs.Count > 99) then
    lx := 5
  else
  if(FObjs.Count > 9) then
    lx := 4
  else
    lx := 3;
  for i := 0 to FObjs.Count-1 do
    QText.Add(copy(IntToStr(i+1) + '.      ', 1, lx) + TMHQuestion(FObjs[i]).Question);
end;
CheckforMHDll - function CheckforMHDll: boolean; Interfaced -
CurrentQ TfrmMHTest function CurrentQ: integer; Private
Function Answers: string;
    procedure GetQText(QText: TStringList);
    function LoadTest(InitialAnswers, TestName: string): boolean;
GetCtrl - function GetCtrl(SubTag: integer): TControl; Local -
PerformMHTest - function PerformMHTest(InitialAnswers, TestName: string; QText: TStringList; Required: boolean): string; Interfaced -
Question TMHQuestion function Question: string; Public -
SaveMHTest - function SaveMHTest(TestName, Date, Loc: string): boolean; Interfaced -

Global Variables

Name Type Declaration Comments
FFirstCtrl TList FFirstCtrl: TList; -
frmMHTest TfrmMHTest frmMHTest: TfrmMHTest; -
FYPos TList FYPos: TList; -
MHDLLHandle THandle MHDLLHandle: THandle = 0; -

Constants

Name Declaration Scope Comments
BevelTag 3 Global -
CheckBoxTag 10 Global -
CloseProc TCloseProc = nil Global -
ComboBoxTag 2 Global -
Gap 2 Global -
LineNumberTag 1 Global -
MaxQ 100 Global Max # of allowed answers for one question
MHDLLName 'YS_MHA_A.DLL' Global -
NumberThreshhold 5 Global Min # of questions on test before each has a line number
QGap 4 Global -
QuestionLabelTag 4 Global -
RemoveTempVistaFile TRemoveTempVistaFile = nil Global -
SaveProc TSaveProc = nil Global -
SHARE_DIR '\VISTA\Common Files\' Global -
ShowProc TShowProc = nil Global -
Skipped 'X' Global -


Module Source

1     unit fMHTest;
2     
3     {$DEFINE CCOWBROKER}
4     
5     interface
6     
7     uses
8       Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
9       StdCtrls, ExtCtrls, ORCtrls, ORFn, uConst, fBase508Form, uDlgComponents,
10      VA508AccessibilityManager, uCore, orNet, TRPCB, StrUtils, rCore, VAUtils
11      ;
12    
13    type
14    TShowProc = procedure(
15       RPCBrokerV: TRPCBroker;
16      InstrumentName,
17      PatientDFN,
18      OrderedBy,
19      OrderedByDUZ,
20      AdministeredBy,
21      AdministeredByDUZ,
22      Location,
23      LocationIEN: string;
24      Required: boolean;
25      var ProgressNote: string); stdcall;
26    
27    TSaveProc = procedure(
28       RPCBrokerV: TRPCBroker;
29      InstrumentName,
30      PatientDFN,
31      OrderedByDUZ,
32      AdministeredByDUZ,
33      AdminDate,
34      LocationIEN: string;
35      var Status: string); stdcall;
36    
37    TRemoveTempVistaFile = procedure(
38       RPCBrokerV: TRPCBroker;
39      InstrumentName,
40      PatientDFN: string); stdcall;
41    
42    TCloseProc = procedure;
43    
44    TUsedMHDll = record
45      Checked: boolean;
46      Display: boolean;
47    end;
48    
49    type
50      TfrmMHTest = class(TfrmBase508Form)
51        sbMain: TScrollBox;
52        pnlBottom: TPanel;
53        btnCancel: TButton;
54        btnOK: TButton;
55        btnClear: TButton;
56        procedure FormDestroy(Sender: TObject);
57        procedure FormCreate(Sender: TObject);
58        procedure FormShow(Sender: TObject);
59        procedure sbMainResize(Sender: TObject);
60        procedure btnOKClick(Sender: TObject);
61        procedure FormKeyDown(Sender: TObject; var Key: Word;
62          Shift: TShiftState);
63        procedure btnClearClick(Sender: TObject);
64      private
65        FIDCount: integer;
66        FAnswers: TStringList;
67        FObjs: TList;
68        FInfoText: string;
69        FInfoLabel: TMentalHealthMemo;
70        FBuilt: boolean;
71        //FMaxLines: integer;
72        FBuildingControls: boolean;
73        procedure BuildControls;
74        {function Answers: string;
75        procedure GetQText(QText: TStringList);
76        function LoadTest(InitialAnswers, TestName: string): boolean; }
77        function CurrentQ: integer;
78        procedure GotoQ(x: integer);
79      public
80      MHTestComp: string;
81      MHA3: boolean;
82      function CallMHDLL(TestName: string; Required: boolean): String;
83      end;
84    
85    function PerformMHTest(InitialAnswers, TestName: string; QText: TStringList; Required: boolean): string;
86    function SaveMHTest(TestName, Date, Loc: string): boolean;
87    procedure RemoveMHTest(TestName: string);
88    function CheckforMHDll: boolean;
89    procedure CloseMHDLL;
90    
91    var
92      MHDLLHandle: THandle = 0;
93    
94    implementation
95    
96    uses fFrame,rReminders, VA508AccessibilityRouter;
97    
98    {$R *.DFM}
99    
100   const
101     MaxQ    = 100; // Max # of allowed answers for one question
102     LineNumberTag = 1;
103     ComboBoxTag = 2;
104     BevelTag = 3;
105     QuestionLabelTag = 4;
106     CheckBoxTag = 10;
107   
108     NumberThreshhold = 5; // min # of questions on test before each has a line number
109     Skipped = 'X';
110     QGap = 4;
111     Gap = 2;
112   
113     ShowProc                    : TShowProc = nil;
114     SaveProc                    : TSaveProc = nil;
115     RemoveTempVistaFile         : TRemoveTempVistaFile = nil;
116     CloseProc                   : TCloseProc = nil;
117     SHARE_DIR = '\VISTA\Common Files\';
118   var
119     frmMHTest: TfrmMHTest;
120     FFirstCtrl: TList;
121     FYPos: TList;
122     //UsedMHDll: TUsedMHDll; comment out to clear compiler hint after commenting out code in CheckforMHDll /WAT
123   
124   type
125     TMHQuestion = class(TObject)
126     private
127       FSeeAnswers: boolean;
128       FAnswerText: string;
129       FText: string;
130       FAllowedAnswers: string;
131       FAnswerIndex: integer;
132       FAnswerCount: integer;
133       FID: integer;
134       FAnswer: string;
135       FObjects: TList;
136       //FLine: integer;
137     protected
138       procedure OnChange(Sender: TObject);
139     public
140       constructor Create;
141       destructor Destroy; override;
142       function Question: string;
143       procedure BuildControls(var Y: integer; Wide: integer);
144       property AllowedAnswers: string read FAllowedAnswers;
145       property Answer: string read FAnswer;
146       property AnswerCount: integer read FAnswerCount;
147       property AnswerIndex: integer read FAnswerIndex;
148       property AnswerText: string read FAnswerText;
149       property SeeAnswers: boolean read FSeeAnswers;
150       property ID: integer read FID;
151       property Text: string read FText;
152     end;
153   
154   const
155     MHDLLName = 'YS_MHA_A.DLL';
156     //MHDLLAUXName = 'YS_MHA_AUX.DLL';
157   
158   procedure LoadMHDLL;
159   var
160     MHPath: string;
161   
162   begin
163     if MHDLLHandle = 0 then
164     begin
165       MHPath := GetProgramFilesPath + SHARE_DIR + MHDLLName;
166       MHDLLHandle := LoadLibrary(PChar(MHPath));
167     end;
168   end;
169   
170   procedure UnloadMHDLL;
171   begin
172     if MHDLLHandle <> 0 then
173     begin
174       FreeLibrary(MHDLLHandle);
175       MHDLLHandle := 0;
176     end;
177   end;
178   
179   procedure ProcessMsg;
180   var
181     SaveCursor: TCursor;
182     
183   begin
184     if(Screen.Cursor = crHourGlass) then
185     begin
186       SaveCursor := Screen.Cursor;
187       Screen.Cursor := crDefault;
188       try
189         Application.ProcessMessages;
190       finally
191         Screen.Cursor := SaveCursor;
192       end;
193     end
194     else
195       Application.ProcessMessages;
196   end;
197   
198   function PerformMHTest(InitialAnswers, TestName: string; QText: TStringList; Required: boolean): string;
199   var
200   str,scores, tempStr: string;
201   begin
202     Result := InitialAnswers;
203     str := frmMHTest.CallMHDLL(testName, Required);
204     if str <> '' then
205       begin
206         if Piece(str,U,1) = 'COMPLETE' then
207           begin
208            Scores := Piece(str, U, 4);
209            if QText <> nil then
210              begin
211                tempStr := Piece(Str, U, 5);
212                if Pos('GAF Score', tempStr) = 0 then tempStr := Copy(tempStr, 2, Length(tempStr));
213                tempStr := AnsiReplaceStr(tempStr,'1156','Response not required due to responses to other questions.');
214                tempStr := AnsiReplaceStr(tempStr,'*','~~');
215                PiecesToList(tempStr,'~',QText);
216              end;
217            Result := 'New MH dll^COMPLETE^'+ Scores;
218           end
219         else if Piece(str,U,1) = 'INCOMPLETE' then
220           begin
221             Result := 'New MH dll^INCOMPLETE^';
222           end
223         else if (Piece(str,U,1) = 'CANCELLED') or (Piece(str, U, 1) = 'NOT STARTED') then
224           begin
225             Result := 'New MH dll^CANCELLED^';
226           end;
227         frmMHTest.Free;
228         exit;
229       end;
230   {  frmMHTest := TfrmMHTest.Create(Application);
231     try
232       frmMHTest.Caption := TestName;
233       if(frmMHTest.LoadTest(InitialAnswers, TestName)) then
234       begin
235         if(frmMHTest.ShowModal = mrOK) then
236         begin
237           Result := frmMHTest.Answers;
238           if(assigned(QText)) then
239           begin
240             QText.Clear;
241             if(Result <> '') then
242               frmMHTest.GetQText(QText);
243           end;
244         end;
245       end;
246         if frmMHTest.MHTestComp = '' then frmMHTest.MHTestComp := '0';
247         Result := Result + U + frmMHTest.MHTestComp;
248         if Result = U then Result := '';
249     finally
250       frmMHTest.Free;
251     end; }
252   end;
253   
254   function SaveMHTest(TestName, date, Loc: string): boolean;
255   var
256     save: string;
257   begin
258     LoadMHDLL;
259     Result := true;
260     if MHDLLHandle = 0 then
261       begin
262         InfoBox(MHDLLName + ' not available', 'Error', MB_OK);
263         Exit;
264       end
265     else
266       begin
267         try
268           @SaveProc := GetProcAddress(MHDLLHandle, 'SaveInstrument');
269   
270           if @SaveProc = nil then
271             begin
272             // function not found.. misspelled?
273               infoBox('Save Instrument Function not found within ' + MHDLLName + '.', 'Error', MB_OK);
274               Exit;
275             end;
276   
277           if Assigned(SaveProc) then
278            begin
279             try
280               SaveProc(RPCBrokerV,
281               UpperCase(TestName), //InstrumentName
282               Patient.DFN, //PatientDFN
283               InttoStr(User.duz), //OrderedByDUZ
284               InttoStr(User.duz), //AdministeredByDUZ
285               date,
286               Loc + 'V', //LocationIEN
287               save);
288             finally
289               if RPCBrokerV.CurrentContext <> 'OR CPRS GUI CHART' then
290                  begin
291                    if RPCBrokerV.CreateContext('OR CPRS GUI CHART') = false then
292                       infoBox('Error switching broker context','Error', MB_OK);
293                  end;
294             end;  {inner try..finally}
295            end;
296         finally
297           UnloadMHDLL;
298         end; {try..finally}
299     end;
300   end;
301   
302   procedure RemoveMHTest(TestName: string);
303   begin
304     LoadMHDLL;
305     if MHDLLHandle = 0 then
306       begin
307         InfoBox(MHDLLName + ' not available', 'Error', MB_OK);
308         Exit;
309       end
310     else
311       begin
312         try
313           @RemoveTempVistaFile := GetProcAddress(MHDLLHandle, 'RemoveTempVistaFile');
314   
315           if @RemoveTempVistaFile = nil then
316             begin
317             // function not found.. misspelled?
318               InfoBox('Remove Temp File function not found within ' + MHDLLName + '.', 'Error', MB_OK);
319               Exit;
320             end;
321   
322           if Assigned(RemoveTempVistaFile) then
323            begin
324             try
325               RemoveTempVistaFile(RPCBrokerV,
326               UpperCase(TestName), //InstrumentName
327               Patient.DFN);
328             finally
329               if RPCBrokerV.CurrentContext <> 'OR CPRS GUI CHART' then
330                  begin
331                    if RPCBrokerV.CreateContext('OR CPRS GUI CHART') = false then
332                       infoBox('Error switching broker context','Error', MB_OK);
333                  end;
334             end;  {inner try..finally}
335            end;
336         finally
337           UnloadMHDLL;
338         end; {try..finally}
339     end;
340   end;
341   
342   function CheckforMHDll: boolean;
343   begin
344     Result := True;
345       {if (UsedMHDll.Checked = True) and (UsedMHDll.Display = False) then Exit
346     else if UsedMHDll.Checked = false then
347       begin
348         UsedMHDll.Display := UsedMHDllRPC;
349         UsedMHDll.Checked := True;
350         if UsedMHDll.Display = false then
351           begin
352             Result := False;
353             exit;
354           end;
355       end;  }
356     if MHDLLHandle = 0 then // if not 0 the DLL already loaded - result = true
357     begin
358       LoadMHDLL;
359       if MHDLLHandle = 0 then
360         Result := false
361       else
362         UnloadMHDLL;
363     end;
364   end;
365   
366   procedure CloseMHDLL;
367   begin
368     if MHDLLHandle = 0 then Exit;
369     try
370       @CloseProc := GetProcAddress(MHDLLHandle, 'CloseDLL');
371       if Assigned(CloseProc) then
372       begin
373         CloseProc;
374       end;
375     finally
376       UnloadMHDLL;
377     end; {try..finally}
378   end;
379   
380   { TfrmMHTest }
381   
382   {function TfrmMHTest.Answers: string;
383   var
384     i, XCnt: integer;
385     ans: string;
386   
387   begin
388     Result := '';
389     XCnt := 0;
390     for i := 0 to FObjs.Count-1 do
391     begin
392       ans := TMHQuestion(FObjs[i]).FAnswer;
393       if(ans = Skipped) then
394         inc(XCnt);
395       Result := Result + ans;
396     end;
397     if(XCnt = FObjs.Count) then
398       Result := '';
399   end;
400   }
401   {function TfrmMHTest.LoadTest(InitialAnswers, TestName: string): boolean;
402   var
403     TstData: TStringList;
404     lNum, i, idx: integer;
405     Line, LastLine, Inp, Code: string;
406     Txt, Spec, p, Spidx, tmp: string;
407     RSpec, First, TCodes: boolean;
408     QObj: TMHQuestion;
409   
410     procedure ParseText;
411     var
412       i, tlen: integer;
413   
414     begin
415       Code := '';
416       i := 1;
417       tlen := length(Txt);
418       while(i <= tlen) do
419       begin
420         while(i <= tlen) and (Txt[i] = ' ') do inc(i);
421         if(i > tlen) then
422         begin
423           Txt := '';
424           exit;
425         end;
426         if(i > 1) then
427         begin
428           delete(Txt,1,i-1);
429           i := 1;
430         end;
431         if(Spec = 'I') then exit;
432         tlen := length(Txt);
433         if(tlen < 3) then exit;
434         Code := copy(Txt,i,1);
435         if(pos(Code, (UpperCaseLetters + LowerCaseLetters + Digits)) = 0) then
436         begin
437           Code := '';
438           exit;
439         end;
440         inc(i);
441         while(i <= tlen) and (Txt[i] = ' ') do inc(i);
442         if(Txt[i] in ['.','=']) then
443         begin
444           if(pos(Code, QObj.FAllowedAnswers) > 0) then
445           begin
446             inc(i);
447             while(i <= tlen) and (Txt[i] = ' ') do inc(i);
448             if(i <= tlen) then
449               delete(Txt,1,i-1)
450             else
451               Code := '';
452             exit;
453           end
454           else
455           begin
456             Code := '';
457             exit;
458           end;
459         end
460         else
461         begin
462           Code := '';
463           exit;
464         end;
465       end;
466     end;
467   
468     procedure AddTxt2Str(var X: string);
469     begin
470       if(Txt <> '') then
471       begin
472         if(X <> '') then
473         begin
474           X := X + ' ';
475           if(copy(Txt, length(Txt), 1) = '.') then
476             X := X + ' ';
477         end;
478         X := X + Txt;
479       end;
480     end;
481   
482   begin
483     Result := TRUE;
484     TstData := TStringList.Create;
485     try
486       FastAssign(LoadMentalHealthTest(TestName), TstData);
487       if TstData.Strings[0] = '1' then MHA3 := True
488       else MHA3 := False;
489       Screen.Cursor := crHourGlass;
490       try
491         TstData.Add('99999;X;0');
492         idx := 1;
493         FMaxLines := 0;
494         FInfoText := '';
495         LastLine := U;
496         First := TRUE;
497         RSpec := FALSE;
498         TCodes := FALSE;
499         QObj := nil;
500         while (idx < TstData.Count) do
501         begin
502           Inp := TstData[idx];
503           if(pos('[ERROR]', Inp) > 0) then
504           begin
505             Result := FALSE;
506             break;
507           end;
508           p := Piece(Inp, U, 1);
509           Line := Piece(p, ';', 1);
510           Spec := Piece(p, ';', 2);
511           SpIdx := Piece(p, ';', 3);
512           if(LastLine <> Line) then
513           begin
514             LastLine := Line;
515             if(First) then
516               First := FALSE
517             else
518             begin
519               if(not RSpec) then
520               begin
521                 Result := FALSE;
522                 break;
523               end;
524             end;
525             if(Spec = 'X') then break;
526             lNum := StrToIntDef(Line, 0);
527             if(lNum <= 0) then
528             begin
529               Result := FALSE;
530               break;
531             end;
532             RSpec := FALSE;
533             TCodes := FALSE;
534             QObj := TMHQuestion(FObjs[FObjs.Add(TMHQuestion.Create)]);
535             QObj.FLine := lNum;
536             if(FMaxLines < lNum) then
537               FMaxLines := lNum;
538           end;
539           Txt := Piece(Inp, U, 2);
540           ParseText;
541           if(Txt <> '') then
542           begin
543             if(Spec = 'I') then
544             begin
545              if MHA3 = True then AddTxt2Str(QObj.FText)
546              else
547              AddTxt2Str(FInfoText);;
548             end
549             else
550             if(Spec = 'R') then
551             begin
552               RSpec := TRUE;
553               if(spIdx = '0') then
554                 QObj.FAllowedAnswers := Txt
555               else
556               if(Code = '') then
557                 QObj.FAnswerText := Txt
558               else
559               begin
560                 QObj.FSeeAnswers := FALSE;
561                 FAnswers.Add(Code + U + Txt);
562                 inc(QObj.FAnswerCount);
563               end;
564             end
565             else
566             if(Spec = 'T') then
567             begin
568               if(Code = '') then
569               begin
570                 if(TCodes) then
571                 begin
572                   tmp := FAnswers[FAnswers.Count-1];
573                   AddTxt2Str(tmp);
574                   FAnswers[FAnswers.Count-1] := tmp;
575                 end
576                 else
577                   AddTxt2Str(QObj.FText);
578               end
579               else
580               begin
581                 TCodes := TRUE;
582                 FAnswers.Add(Code + U + Txt);
583                 inc(QObj.FAnswerCount);
584               end;
585             end;
586           end;
587           inc(idx);
588         end;
589       finally
590         Screen.Cursor := crDefault;
591       end;
592     finally
593       TstData.Free;
594     end;
595     if(not Result) then
596       InfoBox('Error encountered loading ' + TestName, 'Error', MB_OK)
597     else
598     begin
599       for i := 0 to FObjs.Count-1 do
600       begin
601         with TMHQuestion(FObjs[i]) do
602         begin
603           tmp := copy(InitialAnswers,i+1,1);
604           if(tmp <> '') then
605             FAnswer := tmp;
606         end;
607       end;
608     end;
609   end;
610   }
611   procedure TfrmMHTest.FormCreate(Sender: TObject);
612   begin
613     ResizeAnchoredFormToFont(self);
614     FAnswers := TStringList.Create;
615     FObjs := TList.Create;
616     FFirstCtrl := TList.Create;
617     FYPos := TList.Create;
618   end;
619   
620   procedure TfrmMHTest.FormDestroy(Sender: TObject);
621   begin
622     KillObj(@FFirstCtrl);
623     KillObj(@FYPos);
624     KillObj(@FObjs, TRUE);
625     KillObj(@FAnswers);
626   end;
627   
628   procedure TfrmMHTest.BuildControls;
629   var
630     i, Wide, Y: integer;
631     BoundsRect: TRect;
632   begin
633     if(not FBuildingControls) then
634     begin
635       FBuildingControls := TRUE;
636       try
637       Wide := sbMain.Width - (Gap * 2) - ScrollBarWidth - 4;
638       Y := gap - sbMain.VertScrollBar.Position;
639       if MHA3 = False then
640        begin
641        if(not assigned(FInfoLabel)) then
642         begin
643           FInfoLabel := TMentalHealthMemo.Create(Self);
644           FInfoLabel.Color := clBtnFace;
645           FInfoLabel.BorderStyle := bsNone;
646           FInfoLabel.ReadOnly := TRUE;
647           FInfoLabel.TabStop := ScreenReaderSystemActive;
648           FInfoLabel.Parent := sbMain;
649           FInfoLabel.WordWrap := TRUE;
650           FInfoLabel.Text := FInfoText;
651           FInfoLabel.Left := Gap;
652           UpdateColorsFor508Compliance(FInfoLabel);
653         end;
654         BoundsRect := FInfoLabel.BoundsRect;
655         //Wide := sbMain.Width - (Gap * 2) - ScrollBarWidth - 4;
656         //Y := gap - sbMain.VertScrollBar.Position;
657         BoundsRect.Top := Y;
658         BoundsRect.Right := BoundsRect.Left + Wide;
659         WrappedTextHeightByFont(Canvas, FInfoLabel.Font, FInfoLabel.Text, BoundsRect);
660         BoundsRect.Right := BoundsRect.Left + Wide;
661         FInfoLabel.BoundsRect := BoundsRect;
662         ProcessMsg;
663         inc(Y, FInfoLabel.Height + QGap);
664         for i := 0 to FObjs.Count-1 do
665           TMHQuestion(FObjs[i]).BuildControls(Y, Wide);
666        end
667        else
668          begin
669            inc(Y, 1);
670            for i := 0 to FObjs.Count-1 do TMHQuestion(FObjs[i]).BuildControls(Y, Wide);
671          end;
672       finally
673         FBuildingControls := FALSE;
674       end;
675     end;
676     amgrMain.RefreshComponents;
677   end;
678   
679   {procedure TfrmMHTest.GetQText(QText: TStringList);
680   var
681     i, lx: integer;
682   
683   begin
684     if(FObjs.Count > 99) then
685       lx := 5
686     else
687     if(FObjs.Count > 9) then
688       lx := 4
689     else
690       lx := 3;
691     for i := 0 to FObjs.Count-1 do
692       QText.Add(copy(IntToStr(i+1) + '.      ', 1, lx) + TMHQuestion(FObjs[i]).Question);
693   end;
694   }
695   function TfrmMHTest.CallMHDLL(TestName: string; Required: boolean): String;
696   var                               
697     ProgressNote : string;
698   begin
699     ProgressNote := '';
700    { if (UsedMHDll.Checked = True) and (UsedMHDll.Display = False) then Exit
701     else if UsedMHDll.Checked = false then
702       begin
703         UsedMHDll.Display := UsedMHDllRPC;
704         UsedMHDll.Checked := True;
705         if UsedMHDll.Display = false then exit;
706       end; }
707     LoadMHDLL;
708     Result := '';
709     if MHDLLHandle = 0 then
710       begin
711         InfoBox('Mental Health DLL not found.' + CRLF +
712                     CRLF + 'Contact IRM to install the ' + MHDLLName +  ' file on this machine.', 'Warning', MB_OK);
713         //InfoBox(MHDLLName + ' not available.' + CRLF +
714         //                    'CPRS will continue processing the MH test using the previous format.' +
715         //            CRLF + CRLF + 'Contact IRM to install the ' + MHDLLName +
716         //                          ' file on this machine.', 'Warning', MB_OK);
717         Exit;
718       end
719     else
720       begin
721         try
722           @ShowProc := GetProcAddress(MHDLLHandle, 'ShowInstrument');
723   
724           if @ShowProc = nil then
725             begin
726             // function not found.. misspelled?
727               InfoBox('Function ShowInstrument not found within ' + MHDLLName +
728                       ' not available', 'Error', MB_OK);
729               Exit;
730             end;
731   
732           if Assigned(ShowProc) then
733              begin
734                Result := '';
735                try
736                  ShowProc(RPCBrokerV,
737                  UpperCase(TestName), //InstrumentName
738                  Patient.DFN, //PatientDFN
739                  '', //OrderedByName
740                  InttoStr(User.duz), //OrderedByDUZ
741                  User.Name, //AdministeredByName
742                  InttoStr(User.duz), //AdministeredByDUZ
743                  Encounter.LocationName, //Location
744                  InttoStr(Encounter.Location) + 'V', //LocationIEN
745                  Required,
746                  ProgressNote);
747                  Result := ProgressNote;
748              finally
749   //           if RPCBrokerV.CurrentContext <> 'OR CPRS GUI CHART' then
750                  begin
751                    if RPCBrokerV.CreateContext('OR CPRS GUI CHART') = false then
752                       infoBox('Error switching broker context','Error', MB_OK);
753                   end;
754                  end; {inner try ..finally}
755               end;
756         finally
757           UnloadMHDLL;
758         end; {try..finally}
759         //Result := ProgressNote;
760     end;
761   end;
762   
763   function TfrmMHTest.CurrentQ: integer;
764   var
765     i, j: integer;
766     ctrl: TWinControl;
767     MHQ: TMHQuestion;
768   
769   begin
770     Result := 0;
771     ctrl := ActiveControl;
772     if(not assigned(Ctrl)) then
773       exit;
774     for i := 0 to FObjs.Count-1 do
775     begin
776       MHQ := TMHQuestion(FObjs[i]);
777       for j := 0 to MHQ.FObjects.Count-1 do
778       begin
779         if(Ctrl = MHQ.FObjects[j]) then
780         begin
781           Result := i;
782           exit;
783         end;
784       end;
785     end;
786   end;
787   
788   procedure TfrmMHTest.GotoQ(x: integer);
789   begin
790     if(ModalResult <> mrNone) then exit;
791     if(x < 0) then x := 0;
792     if(x >= FYPos.Count) then
793     begin
794       btnOK.Default := TRUE;
795       btnOK.SetFocus;
796     end
797     else
798     begin
799       btnOK.Default := FALSE;
800       sbMain.VertScrollBar.Position := Integer(FYPos[x]) - 2;
801       TWinControl(FFirstCtrl[x]).SetFocus;
802     end;
803   end;
804   
805   procedure TfrmMHTest.FormKeyDown(Sender: TObject; var Key: Word;
806     Shift: TShiftState);
807   begin
808     inherited;
809     if Key = VK_PRIOR then
810     begin
811       GotoQ(CurrentQ - 1);
812       Key := 0;
813     end
814     else
815     if (Key = VK_NEXT) or (Key = VK_RETURN) then
816     begin
817       GotoQ(CurrentQ + 1);
818       Key := 0;
819     end;
820   end;
821   
822   { TMHQuestion }
823   
824   procedure TMHQuestion.BuildControls(var Y: integer; Wide: integer);
825   var
826     RCombo: TComboBox;
827     LNLbl, RLbl: TMentalHealthMemo;
828     Bvl: TBevel;
829     cb: TORCheckBox;
830     ans, idx, DX, MaxDX, MaxDY: integer;
831     Offset: integer;
832     txt: string;
833     QNum: integer;
834   
835     function GetCtrl(SubTag: integer): TControl;
836     var
837       i: integer;
838   
839     begin
840       Result := nil;
841       for i := 0 to FObjects.Count-1 do
842       begin
843         if(TControl(FObjects[i]).Tag = (FID + SubTag)) then
844         begin
845           Result := TControl(FObjects[i]);
846           break;
847         end;
848       end;
849     end;
850   
851     procedure AdjDY(Ht: integer);
852     begin
853       if(MaxDY < Ht) then
854         MaxDY := Ht;
855     end;
856   
857     procedure GetRLbl;
858     var
859       BoundsRect: TRect;
860     begin
861       if(FText <> '') then
862       begin
863         RLbl := TMentalHealthMemo(GetCtrl(QuestionLabelTag));
864         if(not assigned(RLbl)) then
865         begin
866           RLbl := TMentalHealthMemo.Create(frmMHTest);
867           RLbl.Color := clBtnFace;
868           RLbl.BorderStyle := bsNone;
869           RLbl.ReadOnly := TRUE;
870           RLbl.TabStop := ScreenReaderSystemActive;
871           RLbl.Parent := frmMHTest.sbMain;
872           RLbl.Tag := FID + QuestionLabelTag;
873           RLbl.WordWrap := TRUE;
874           RLbl.Text := FText;
875           FObjects.Add(RLbl);
876           UpdateColorsFor508Compliance(RLbl);
877         end;
878         BoundsRect.Top := Y;
879         BoundsRect.Left := Offset;
880         BoundsRect.Right := Wide;
881         WrappedTextHeightByFont(frmMHTest.Canvas, RLbl.Font, RLbl.Text, BoundsRect);
882         BoundsRect.Right := Wide;
883         RLbl.BoundsRect := BoundsRect;
884         ProcessMsg;
885       end
886       else
887         RLbl := nil;
888     end;
889   
890   begin
891     QNum := (FID div MaxQ)-1;
892     while(FFirstCtrl.Count <= QNum) do
893       FFirstCtrl.Add(nil);
894     while(FYPos.Count <= QNum) do
895       FYPos.Add(nil);
896     FYPos[QNum] := Pointer(Y);
897     ans := pos(FAnswer, FAllowedAnswers) - 1;
898     Offset := Gap;
899     if(not assigned(FObjects)) then
900       FObjects := TList.Create;
901     MaxDY := 0;
902     if(frmMHTest.FObjs.Count >= NumberThreshhold) then
903     begin
904       LNLbl := TMentalHealthMemo(GetCtrl(LineNumberTag));
905       if(not assigned(LNLbl)) then
906       begin
907         LNLbl := TMentalHealthMemo.Create(frmMHTest);
908         LNLbl.Color := clBtnFace;
909         LNLbl.BorderStyle := bsNone;
910         LNLbl.ReadOnly := TRUE;
911         LNLbl.TabStop := ScreenReaderSystemActive;
912         LNLbl.Parent := frmMHTest.sbMain;
913         LNLbl.Tag := FID + LineNumberTag;
914         LNLbl.Text := IntToStr(QNum+1) + '.';
915         if ScreenReaderSystemActive then
916           frmMHTest.amgrMain.AccessText[LNLbl] := 'Question';      
917         LNLbl.Width := TextWidthByFont(LNLbl.Font.Handle, LNLbl.Text);
918         LNLbl.Height := TextHeightByFont(LNLbl.Font.Handle, LNLbl.Text);
919         FObjects.Add(LNLbl);
920         UpdateColorsFor508Compliance(LNLbl);
921       end;
922       LNLbl.Top := Y;
923       LNLbl.Left := Offset;
924       inc(Offset, MainFontSize * 4);
925       AdjDY(LNLbl.Height);
926     end;
927   
928     Bvl := TBevel(GetCtrl(BevelTag));
929     if(not assigned(Bvl)) then
930     begin
931       Bvl := TBevel.Create(frmMHTest);
932       Bvl.Parent := frmMHTest.sbMain;
933       Bvl.Tag := FID + BevelTag;
934       Bvl.Shape := bsFrame;
935       FObjects.Add(Bvl);
936       UpdateColorsFor508Compliance(Bvl);
937     end;
938     Bvl.Top := Y;
939     Bvl.Left := Offset;
940     Bvl.Width := Wide - Offset;
941     inc(Offset, Gap * 2);
942     inc(Y, Gap * 2);
943     dec(Wide, Offset + (Gap * 2));
944   
945     GetRLbl;
946     if(assigned(RLbl)) then
947     begin
948       MaxDY := RLbl.Height;
949       inc(Y, MaxDY + Gap * 2);
950     end;
951   
952     if(FSeeAnswers) then
953     begin
954       for idx := 0 to FAnswerCount-1 do
955       begin
956         cb := TORCheckBox(GetCtrl(CheckBoxTag + idx));
957         if(not assigned(cb)) then
958         begin
959           cb := TORCheckBox.Create(frmMHTest);
960           if(idx = 0) then
961             FFirstCtrl[QNum] := cb;
962           cb.Parent := frmMHTest.sbMain;
963           cb.Tag := FID + CheckBoxTag + idx;
964           cb.GroupIndex := FID;
965           cb.WordWrap := TRUE;
966           cb.AutoSize := TRUE;
967           if(idx = ans) then
968             cb.Checked := TRUE;
969           cb.OnClick := OnChange;
970           cb.Caption := Piece(frmMHTest.FAnswers[FAnswerIndex + idx], U, 2);
971           FObjects.Add(cb);
972           UpdateColorsFor508Compliance(cb);
973         end;
974         cb.Top := Y;
975         cb.Left := Offset;
976         cb.WordWrap := TRUE;
977         cb.Width := Wide;
978         cb.AutoAdjustSize;
979         cb.WordWrap := (not cb.SingleLine);
980         inc(Y, cb.Height + Gap);
981       end;
982     end
983     else
984     begin
985       RCombo := TComboBox(GetCtrl(ComboBoxTag));
986       if(not assigned(RCombo)) then
987       begin
988         RCombo := TComboBox.Create(frmMHTest);
989         FFirstCtrl[QNum] := RCombo;
990         RCombo.Parent := frmMHTest.sbMain;
991         RCombo.Tag := FID + ComboBoxTag;
992         FObjects.Add(RCombo);
993         MaxDX := 0;
994         for idx := 0 to FAnswerCount-1 do
995         begin
996           txt := Piece(frmMHTest.FAnswers[FAnswerIndex + idx], U, 2);
997           RCombo.Items.Add(txt);
998           DX := TextWidthByFont(frmMHTest.sbMain.Font.Handle, txt);
999           if(MaxDX < DX) then
1000            MaxDX := DX;
1001        end;
1002        RCombo.ItemIndex := ans;
1003        RCombo.Width := MaxDX + 24;
1004        RCombo.OnChange := OnChange;
1005        UpdateColorsFor508Compliance(RCombo);
1006      end;
1007      RCombo.Top := Y;
1008      RCombo.Left := Offset;
1009      inc(Y, RCombo.Height + (Gap * 2));
1010    end;
1011    Bvl.Height := Y - Bvl.Top;
1012    inc(Y, QGap);
1013  end;
1014  
1015  constructor TMHQuestion.Create;
1016  begin
1017    inherited;
1018    FSeeAnswers := TRUE;
1019    FAnswerText := '';
1020    FText := '';
1021    FAllowedAnswers := '';
1022    FAnswerIndex := frmMHTest.FAnswers.Count;
1023    FAnswerCount := 0;
1024    inc(frmMHTest.FIDCount, MaxQ);
1025    FID := frmMHTest.FIDCount;
1026    FAnswer := Skipped;
1027  end;
1028  
1029  destructor TMHQuestion.Destroy;
1030  begin
1031    KillObj(@FObjects, TRUE);
1032    inherited;
1033  end;
1034  
1035  procedure TMHQuestion.OnChange(Sender: TObject);
1036  var
1037    idx: integer;
1038    cb: TCheckBox;
1039    cbo: TComboBox;
1040  
1041  begin
1042    if(Sender is TCheckBox) then
1043    begin
1044      cb := TCheckBox(Sender);
1045      if(cb.Checked) then
1046      begin
1047        idx := cb.Tag - CheckBoxTag + 1;
1048        idx := idx mod MaxQ;
1049        FAnswer := copy(FAllowedAnswers, idx, 1);
1050      end
1051      else
1052        FAnswer := Skipped;
1053    end
1054    else
1055    if(Sender is TComboBox) then
1056    begin
1057      cbo := TComboBox(Sender);
1058      idx := cbo.ItemIndex + 1;
1059      if(idx = 0) or (cbo.Text = '') then
1060        FAnswer := Skipped
1061      else
1062        FAnswer := copy(FAllowedAnswers, idx, 1);
1063    end;
1064  end;
1065  
1066  procedure TfrmMHTest.FormShow(Sender: TObject);
1067  begin
1068    if(not FBuilt) then
1069    begin
1070      Screen.Cursor := crHourGlass;
1071      try
1072        BuildControls;
1073        FBuilt := TRUE;
1074      finally
1075        Screen.Cursor := crDefault;
1076      end;
1077    end;
1078  end;
1079  
1080  procedure TfrmMHTest.sbMainResize(Sender: TObject);
1081  begin
1082    if(FBuilt) then
1083      BuildControls;
1084  end;
1085  
1086  function TMHQuestion.Question: string;
1087  var
1088    idx: integer;
1089    echar: string;
1090  
1091  begin
1092    Result := trim(FText);
1093    echar := copy(Result, length(Result), 1);
1094    if(echar <> ':') and (echar <> '?') then
1095    begin
1096      if(echar = '.') then
1097        delete(Result, length(result), 1);
1098      Result := Result + ':';
1099    end;
1100    if(FAnswer = Skipped) then
1101      Result := Result + ' Not rated'
1102    else
1103    begin
1104      idx := pos(FAnswer, FAllowedAnswers) + FAnswerIndex - 1;
1105      if(idx >= 0) and (idx < frmMHTest.FAnswers.Count) then
1106        Result := Result + ' ' + Piece(frmMHTest.FAnswers[idx],U,2);
1107    end;
1108  end;
1109  
1110  procedure TfrmMHTest.btnOKClick(Sender: TObject);
1111  var
1112    i, XCnt, First: integer;
1113    msg, ans, TestStatus: string;
1114  
1115  begin
1116    msg := '';
1117    ans := '';
1118    XCnt := 0;
1119    First := -1;
1120    TestStatus := '2';
1121    MHTestComp := '2';
1122    for i := 0 to FObjs.Count-1 do
1123    begin
1124      ans := ans + TMHQuestion(Fobjs[i]).FAnswer;
1125      if(TMHQuestion(FObjs[i]).FAnswer = Skipped) then
1126      begin
1127        if(First < 0) then First := i;
1128        inc(XCnt);
1129        if(msg <> '') then
1130          msg := msg + ', ';
1131        msg := msg + IntToStr(i+1);
1132      end;
1133    end;
1134    if(XCnt = FObjs.Count) then ModalResult := mrOK;
1135    TestStatus := VerifyMentalHealthTestComplete(Self.Caption, ans);
1136    if Piece(TestStatus,U,1) <> '2' then
1137      begin
1138        if Piece(TestStatus,U,1)='1' then
1139          begin
1140            ModalResult := mrOK;
1141            MHTestComp := '1';
1142            EXIT;
1143          end;
1144        if Piece(TestStatus,U,1)='0' then
1145          begin
1146            MHTestComp := '0';
1147            msg := Piece(TestStatus,u,2);
1148            msg := 'The following questions have not been answered:' + CRLF + CRLF + '    ' + msg;
1149            if(InfoBox(msg + CRLF + CRLF + 'Answer skipped questions?', 'Skipped Questions',
1150             MB_YESNO or MB_ICONQUESTION) = IDYES) then GotoQ(First)
1151            else
1152              ModalResult := mrOK;
1153              EXIT;
1154          end;
1155      end;
1156    if(XCnt = 0) then
1157      ModalResult := mrOK
1158    else
1159    begin
1160      if(XCnt = FObjs.Count) then
1161        ModalResult := mrOK
1162      else
1163      begin
1164        msg := 'The following questions have not been answered:' + CRLF + CRLF + '    ' + msg;
1165        if(InfoBox(msg + CRLF + CRLF + 'Answer skipped questions?', 'Skipped Questions',
1166           MB_YESNO or MB_ICONQUESTION) = IDYES) then
1167          GotoQ(First)
1168        else
1169          ModalResult := mrOK;
1170      end;
1171    end;
1172  end;
1173  
1174  procedure TfrmMHTest.btnClearClick(Sender: TObject);
1175  var
1176    i: integer;
1177  
1178  begin
1179    for i := 0 to sbMain.ControlCount-1 do
1180    begin
1181      if(sbMain.Controls[i] is TCheckBox) then
1182        TCheckBox(sbMain.Controls[i]).Checked := FALSE
1183      else
1184      if(sbMain.Controls[i] is TComboBox) then
1185      begin
1186        with TComboBox(sbMain.Controls[i]) do
1187        begin
1188          ItemIndex := -1;
1189          OnChange(sbMain.Controls[i]);
1190        end;
1191      end; 
1192    end;
1193  end;
1194  
1195  end.

Module Calls (2 levels)


fMHTest
 ├uConst
 ├fBase508Form
 │ ├uConst
 │ └uHelpManager
 ├uDlgComponents
 │ └uCore
 ├uCore...
 └rReminders
   ├fMHTest...
   ├uCore...
   ├uReminders
   └rCore

Module Called-By (2 levels)


                    fMHTest
                   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┘ │ 
               uReminders┤ 
              fFrame...┤ │ 
               fDrawers┤ │ 
              fCover...┤ │ 
              rCover...┤ │ 
              fNotes...┤ │ 
           fConsults...┤ │ 
        fTemplateEditor┤ │ 
     fReminderDialog...┤ │ 
          fReminderTree┤ │ 
             rReminders┤ │ 
            fSurgery...┤ │ 
         fRemCoverSheet┘ │ 
       fReminderDialog...┤ 
            rReminders...┘