10. EPMO Open Source Coordination Office Redaction File Detail Report

Produced by Araxis Merge on 9/25/2018 2:12:58 PM Central Daylight Time. See www.araxis.com for information about Merge. This report uses XHTML and CSS2, and is best viewed with a modern standards-compliant browser. For optimum results when printing this report, use landscape orientation and enable printing of background images and colours in your browser.

10.1 Files compared

# Location File Last Modified
1 build 3.zip\build 3\MHLTH_YS_137_Source\Delphi\MHA fMHA_Main.pas Thu Sep 6 11:30:20 2018 UTC
2 build 3.zip\build 3\MHLTH_YS_137_Source\Delphi\MHA fMHA_Main.pas Fri Sep 14 17:29:21 2018 UTC

10.2 Comparison summary

Description Between
Files 1 and 2
Text Blocks Lines
Unchanged 2 3218
Changed 1 2
Inserted 0 0
Removed 0 0

10.3 Comparison options

Whitespace
Character case Differences in character case are significant
Line endings Differences in line endings (CR and LF characters) are ignored
CR/LF characters Not shown in the comparison detail

10.4 Active regular expressions

No regular expressions were active.

10.5 Comparison detail

  1   unit fMHA_ Main;
  2  
  3   // 3/13/20 13: Added  feature to  check YS_ MHA_AUX.dl l to ensur e it
  4   // exists  and is cur rent.
  5  
  6   // 3/28/20 12: Correc ted Admini sterAllIte ms so that  default v alues in s pin-edit
  7   // would n ot crash w hen evalua ting for r ule. The O nExit even t for the  spin-edit
  8   // will im mediately  move to th e next ite m, so if t he next it em is to b e disabled
  9   // by skip -logic, a  crash occu rs. Correc ted in Ins trument Di splay too.
  10  
  11   // 3/29/20 12: Expand ed the gra ph functio n so that  min and ma x scores w ere more
  12   // visible . Added on e or minus  one to ma x and min  ordinates.
  13  
  14   // 6/15/20 12: An AUD C score, w hen two di gits long,  would app ear as "1~ " instead  of
  15   // "10". B ug fixed i n YS_MHA_A UX.dll.
  16  
  17   // 6/22/20 12: Correc ted ASI bu g. When th e user sta rts a Lite  ASI, and  stops to
  18   // finish  later, the  FULL ASI  is present ed instead  of the Li te ASI whe n the user
  19   // restart s the inco mplete for m.
  20  
  21   // 6/6/201 3: Patch 1 08, in ord er to repo rt totals  on 2 repor ts in addi tion to th e scale
  22   // sub-tot als have a dded code  in uMHA_Re port_OPS t o execute  logic if t he instrum ent name
  23   // is eith er 'YBOCSI I'or 'SIP- 2L'
  24  
  25   // Patch 1 08: Remove d ability  to adminis ter a GAF
  26   //             Remove d (by comm enting out ) appendin g the word  "button"  to a butto n
  27   //                 ca ption when  a screen  reader is  in use, it  created a n inapprop riate redu ndancy
  28   //             Modifi ed fIA_Dia logs to re move all B orland cod e, replaci ng it with  code to d isplay mes sage boxes
  29   //             Modifi cations so  that Pati ent Label  would be r ead by a s creen read er, not el oquent
  30  
  31   // 03/02/2 017: Patch  108 was n ever relea sed. There fore refer ences to 1 08 have be en changed
  32   //              to 12 9 as that  is the pat ch most of  the chang es will be  released  in.
  33   //              Modif ications/C hanges tha t are not  being impl emented (r eleased in  129) will
  34   //              remai n commente d as in pa tch 108.
  35  
  36   interface
  37  
  38   uses
  39  
  40     Windows,
  41     Messages ,
  42     SysUtils ,
  43     System.U ITypes,
  44     Classes,
  45     Graphics ,
  46     Controls ,
  47     Forms,
  48     StdCtrls ,
  49     Menus,
  50     ExtCtrls ,
  51     RzCommon ,
  52     RzLabel,
  53     ShellAPI ,
  54     jpeg,
  55     RzShellD ialogs;
  56  
  57  
  58   type
  59     TfrmMHA_ Main = cla ss(TForm)
  60       MainMe nu1: TMain Menu;
  61       mnuFil e: TMenuIt em;
  62       N1: TM enuItem;
  63       mnuExi t: TMenuIt em;
  64       mnuToo ls: TMenuI tem;
  65       mnuHel p: TMenuIt em;
  66       mnuOpt ions: TMen uItem;
  67       mnuSel ectPatient : TMenuIte m;
  68       pnlIma ge: TPanel ;
  69       pnlHea der: TPane l;
  70       mnuAbo ut: TMenuI tem;
  71       imgASI : TImage;
  72       imgGAF : TImage;
  73       imgRes ults: TIma ge;
  74       imgTes ts: TImage ;
  75       lblRes ults: TRzL abel;
  76       lblGAF : TRzLabel ;
  77       lblASI : TRzLabel ;
  78       mnuMet ric: TMenu Item;
  79       N2: TM enuItem;
  80       N3: TM enuItem;
  81       mnuUpl oadResults : TMenuIte m;
  82       N4: TM enuItem;
  83       mnuOnl ineSupport : TMenuIte m;
  84       imgLog o: TImage;
  85       lblIns tAdmin: TR zLabel;
  86       lblGAF Due: TLabe l;
  87       pnlScr eenReader:  TPanel;
  88       btnIns tAdmin: TB utton;
  89       btnRes ults: TBut ton;
  90       btnASI : TButton;
  91       btnGAF : TButton;
  92       dlgDir : TRzSelec tFolderDia log;
  93       lblPat ientScrnRd er: TStati cText;
  94       lblPat ient: TLab el;
  95  
  96       proced ure FormCr eate(Sende r: TObject );
  97       proced ure FormSh ow(Sender:  TObject);
  98       proced ure FormCl ose(Sender : TObject;  var Actio n: TCloseA ction);
  99       proced ure Config ureForm;
  100  
  101       proced ure mnuExi tClick(Sen der: TObje ct);
  102       proced ure mnuOpt ionsClick( Sender: TO bject);
  103       proced ure mnuSel ectPatient Click(Send er: TObjec t);
  104       proced ure mnuASI Click(Send er: TObjec t);
  105       proced ure mnuGAF Click(Send er: TObjec t);
  106       proced ure mnuAbo utClick(Se nder: TObj ect);
  107       proced ure mnuRes ultsClick( Sender: TO bject);
  108       proced ure mnuTes tsClick(Se nder: TObj ect);
  109       proced ure lblASI MouseEnter (Sender: T Object);
  110       proced ure lblGAF MouseEnter (Sender: T Object);
  111       proced ure lblTes tsMouseEnt er(Sender:  TObject);
  112       proced ure lblRes ultsMouseE nter(Sende r: TObject );
  113       proced ure Waitin gDisplay;
  114       proced ure mnuUpl oadResults Click(Send er: TObjec t);
  115       proced ure mnuMet ricClick(S ender: TOb ject);
  116  
  117       proced ure Defaul tHandler(v ar Message ); overrid e;
  118       proced ure lblTes tsMouseLea ve(Sender:  TObject);
  119       proced ure lblRes ultsMouseL eave(Sende r: TObject );
  120       proced ure lblASI MouseLeave (Sender: T Object);
  121       proced ure lblGAF MouseLeave (Sender: T Object);
  122       proced ure ShowSi ngleInstru mentMenu;
  123       //proc edure Show SingleInst rument;
  124       proced ure mnuOnl ineSupport Click(Send er: TObjec t);
  125       proced ure SetupS creenReade r(Sender:  TObject);
  126       proced ure btnIns tAdminClic k(Sender:  TObject);
  127       proced ure btnRes ultsClick( Sender: TO bject);
  128       proced ure btnASI Click(Send er: TObjec t);
  129       proced ure btnGAF Click(Send er: TObjec t);
  130       proced ure FormKe yDown(Send er: TObjec t; var Key : Word;
  131         Shif t: TShiftS tate);
  132       proced ure FormAc tivate(Sen der: TObje ct);
  133       proced ure FormDe stroy(Send er: TObjec t);
  134  
  135     private
  136  
  137       { BEGI N CPRS Too ls menu}
  138       FVista Msg: Word;
  139       { END  CPRS Tools  menu}
  140       functi on GetDPI:  Integer;
  141       proced ure LoadPa tientSelec tionForm;
  142       proced ure LoadIn strumentSe lectForm;
  143       proced ure ShowTe stsSelect;
  144       //ver  70 patch 1 08, remove d referenc e
  145       //proc edure Show GAF;
  146       proced ure ShowAS I;
  147       proced ure ShowRe sults;
  148       proced ure Prompt PatientSel ection(AMe ssage: str ing);
  149       proced ure SetASI ;
  150       proced ure SetGAF ;
  151       proced ure SetRes ults;
  152       proced ure SetTes ts;
  153       proced ure ShowOr HideImage;
  154       functi on EnterDa taForDeadP atient: BO OLEAN;
  155       proced ure IsScre enReaderIn Use;
  156       { Priv ate declar ations }
  157     public
  158       { Publ ic declara tions }
  159     end;
  160  
  161   var
  162     frmMHA_M ain                   : TfrmMHA_ Main;
  163  
  164   implementa tion
  165  
  166   uses
  167     // XE3 m igration l lh;  chang ed logic o f splash s creen, mov ed to proj ect file
  168     //fMHA_S plash, //  Creates &  displays s plash scre en. Do not  add this  unit to th e
  169                   // pr oject.
  170     // XE3 m igration l lh; added  new Splash Screen to  uses claus e
  171     fMHA_Spl ashScreen,
  172  
  173     uIA_Cons t,
  174     uMHA_Con st,
  175     uIA_Util s,
  176     uMHA_Reg istry,
  177     uIA_Pati ent,
  178     uIA_Pati ent_OPS,
  179     uIA_This User,
  180     uIA_GUIC ontrol,
  181     fIA_dial ogs,
  182     Dialogs,
  183     uMHA_Loc alFiles,
  184     fMHA_GAF ,
  185     uMHA_GAF _OPS,
  186     fMHA_Adm in,
  187     uMHA_Pro ctor,
  188     fMHA_Sin gleInstrum entMenu,
  189     fMHA_Sel ectPatient ,
  190     fMHA_Opt ions,
  191     fMHA_Ins trumentSel ect,
  192     fMHA_Ins trumentRes ults,
  193     fMHA_ASI _Main,
  194     fMHA_Abo ut,
  195     uMHA_DM,
  196     fMHA_ASI _Entry,
  197     fMHA_Adm inisterAll Items,
  198     fMHA_Adm inisterOne Item,
  199     fMHA_Upl oadResults ,
  200     fMHA_ASI _Entry_508 ,
  201     fMHA_Opt ions_508;
  202  
  203   {$R *.DFM}
  204  
  205   var
  206     lvMenuMa rker                  : Integer;
  207     lvDateSe parator,
  208       lvTime Separator             : Char;
  209     lvLongTi meFormat,
  210       lvShor tDateForma t          : string;
  211     lvInProc ess                   : Boolean;
  212  
  213     { BEGIN  CPRS Tools  menu}
  214  
  215   procedure  TfrmMHA_Ma in.Default Handler(va r Message) ;
  216   // FOR Con versations  with CPRS
  217   // adds ch eck to the  message h andling fo r this for m to get a  registere d message
  218   var
  219     buf                            : array[0. .255] of C har;
  220     CPRSMess ageText               : string;
  221     OpenForm Handle                : HWND;
  222  
  223   begin
  224  
  225     // do th e default  message ha ndling
  226     inherite d DefaultH andler(Mes sage);
  227     // if th e message  is 'VistA  Event - Cl inical' an d not post ed from se lf...
  228     // wPara m=Handle o f message  sender, lP aram=entry  in global  atom tabl e
  229  
  230     with TMe ssage(Mess age) do
  231       if (Ms g = FVista Msg) and ( Int(wParam ) <> Int(H andle)) th en
  232         begi n
  233  
  234           //  Make sure  that the  original i nstance of  CPRS is t he sender  of this
  235           //  message.  If not, th en skip th is procedu re altoget her
  236           if  gvCPRS_In stance_Han dle = 0 th en
  237              gvCPRS_Ins tance_Hand le := wPar am;
  238  
  239           if  gvCPRS_In stance_Han dle <> Int (wParam) t hen
  240              begin
  241   //ShowMess age('This  session of  MHA shoul d be close d.');
  242                exit;
  243              end;
  244  
  245           //  retrieve  the text p ointed to  by lParam  into a buf fer
  246           Gl obalGetAto mName(lPar am, buf, 2 55);
  247           CP RSMessageT ext := Str Pas(buf);
  248  
  249           //  CPRS Sele cted Patie nt event h as occurre d
  250           if  (Piece(CP RSMessageT ext, '^',  1) = 'XPT' ) and
  251              (Piece(CPR SMessageTe xt, '^', 2 ) = 'CPRS' ) then
  252              begin
  253                //  if s ame patien t selected , exit
  254                if (Pati ent.DFN =  Piece(CPRS MessageTex t, '^', 3) ) then
  255                  Exit;
  256  
  257                // CPRS  has change d patient:
  258                if (Pati ent.DFN <>  Piece(CPR SMessageTe xt, '^', 3 )) then
  259                  begin
  260                    if O penFormNam e = ofAll  then
  261                      be gin
  262                         frmMHA3_Ad ministerAl lItems.Cha ngePt;
  263                         OpenFormNa me := ofSe lect;
  264                      en d;
  265  
  266                    if O penFormNam e = ofSing le then
  267                      be gin
  268                         frmMHA3_Ad ministerSi ngleItems. ChangePt;
  269                         OpenFormNa me := ofSe lect;
  270                      en d;
  271  
  272                    if O penFormNam e = ofASI  then
  273                      be gin
  274                         frmMHA_ASI _Entry.Bri ngToFront;
  275                         frmMHA_ASI _Entry.Cha ngePt;
  276                         OpenFormNa me := ofAS IMenu;
  277                      en d;
  278  
  279                    if O penFormNam e = ofASI_ 508 then
  280                      be gin
  281                         frmMHA_ASI _Entry_508 .BringToFr ont;
  282                         frmMHA_ASI _Entry_508 .ChangePt;
  283                         OpenFormNa me := ofAS IMenu;
  284                      en d;
  285  
  286                    // N ew patient  but no wo rk is in p rogress
  287                    // D o this bef ore changi ng patient s
  288                    Open FormHandle  := FindWi ndow('Tfrm MHA_EditGA F', nil);
  289                    if n ot (OpenFo rmHandle =  0) then
  290                      Se ndMessage( OpenFormHa ndle, WM_S YSCOMMAND,  SC_CLOSE,  0);
  291  
  292                    //As sign pt se lected in  CPRS to ou r own.
  293                    Pati ent.Load(P iece(CPRSM essageText , '^', 3),
  294                      Da taModule1. RPCBroker1 );
  295  
  296                    if ( OpenFormNa me = ofSin gleMenu) t hen
  297                      fr mMHA_Singl eInstrumen tMenu.Upda teAllDispl ays;
  298  
  299                    if ( OpenFormNa me = ofRes ult) then
  300                    //fr mMHA_Instr umentResul ts.UpdateA llDisplays ;
  301                      be gin
  302                         frmMHA_Ins trumentRes ults.Close ;
  303                         ShowResult s;
  304                      en d;
  305  
  306                    if ( OpenFormNa me = ofSel ect) then
  307                      fr mMHA_Instr umentSelec t.NewPatie ntDisplay;
  308                    if ( OpenFormNa me = ofGAF ) then
  309                      fr mMHA_GAF.U pdateAllDi splays;
  310                    if ( OpenFormNa me = ofASI Menu) then
  311                      fr mMHA_ASI_M ain.Update AllDisplay s;
  312                    if ( OpenFormNa me = ofUpl oad) then
  313                      fr mMHA_Uploa dResults.D isplayCPRS PatientPro perties;
  314  
  315                    // T he caption  on the Ma in form al ways shoul d be chang ed,
  316                    // r egardless  of which f orm is act ive when a  new patie nt is sele cted
  317                    // p atch 108 c hanges for  508 compl iance llh
  318                    // n ext line w ay it was,  added if  else block
  319                    //lb lPatient.c aption :=  Patient.Ca ptionInfo;
  320                    if n ot gvUseSc reenReader  then
  321                      be gin
  322                         lblPatient .Visible : = true;
  323                         lblPatient ScrnRder.V isible :=  false;
  324                         lblPatient .caption : = Patient. CaptionInf o;
  325                         pnlHeader. TabStop :=  false;
  326                      en d
  327                    else
  328                      be gin
  329                         lblPatient .Visible : = false;
  330                         lblPatient ScrnRder.V isible :=  true ;
  331                         lblPatient ScrnRder.C aption :=  'Mental He alth Assis tant ' + P atient.Cap tionInfo ;
  332                         pnlHeader. TabStop :=  true ;
  333                         ActiveCont rol := lbl PatientScr nRder ;
  334                      en d;
  335  
  336                    //Br ingWindowT oTop(Appli cation.Han dle);
  337                  end; / / Change o f patient
  338              end;
  339  
  340           //  CPRS is c losing. Cl ose MHA as  well?
  341           if  (Piece(CP RSMessageT ext, '^',  1) = 'END' ) and
  342              (Piece(CPR SMessageTe xt, '^', 2 ) = 'CPRS' ) then
  343              begin
  344                gvCPRSSh utDown :=  True;
  345  
  346                // Allow  MHA to st ay open un til the fo rm is done .
  347                // Then  close MHA.
  348  
  349                if (Open FormName =  ofAll) or
  350                  (OpenF ormName =  ofSingle)  or
  351                  (OpenF ormName =  ofASI) or
  352                  (OpenF ormName =  ofASI_508)  then
  353                  exit;
  354  
  355                Applicat ion.Termin ate;
  356              end;
  357  
  358         end;  // with T Message(Me ssage)
  359   end;
  360   { END CPRS  Tools men u}
  361  
  362  
  363   procedure  TfrmMHA_Ma in.FormCre ate(Sender : TObject) ;
  364   var
  365     CPRSFont                       : HFONT;
  366     i                              : integer;
  367   begin
  368  
  369     // Use t he same fo nt as CPRS , if conne cted, othe rwise it u se
  370     // the l ast font ( or default  font from  Windows).
  371     gvFont : = TFont.Cr eate;
  372     gvDPI :=  GetDPI; / / This is  used in re gistry, ke ep it ahea d of reg.r ead
  373  
  374     MHA_Regi stry.ReadR egistry;
  375  
  376     // patch  105 set A UX dll fil e into var iable
  377     gvAuxFil e := gvEnv Var + YS_M HA_AUX ;
  378  
  379     gvAPICal ls := TStr ingList.Cr eate;
  380  
  381     // Look  for CPRS m ain window 's class
  382     gvCPRS_I nstance_Ha ndle := Fi ndWindow(' TfrmFrame' , nil); // CPRS
  383     if gvCPR S_Instance _Handle <>  0 then //  Window fo und
  384       begin
  385         CPRS Font := Se ndMessage( gvCPRS_Ins tance_Hand le, WM_GET FONT, 0, 0 );
  386         gvFo nt := Make FontFromHF ont(CPRSFo nt);
  387         MHA_ Registry.S aveRegistr y;
  388       end;
  389  
  390     gvID :=  '';
  391  
  392     // Since  TDate & T DateTime,  used in th is program , are set  by the use r
  393     // for t his PC, we  will set  them to ou r standard  and retur n them to  user
  394     // setti ngs at clo se.
  395     lvDateSe parator :=  FormatSet tings.Date Separator;
  396     FormatSe ttings.Dat eSeparator  := '/';
  397     lvTimeSe parator :=  FormatSet tings.Time Separator;
  398     FormatSe ttings.Tim eSeparator  := ':';
  399     lvShortD ateFormat  := FormatS ettings.Sh ortDateFor mat;
  400     FormatSe ttings.Sho rtDateForm at := 'MM/ dd/yyyy';
  401     lvLongTi meFormat : = FormatSe ttings.Lon gTimeForma t;
  402     FormatSe ttings.Lon gTimeForma t := 'hh:n n:ss AM/PM ';
  403  
  404     gvCPRSSh utDown :=  False;
  405     gvCheckR esourceFil es := True ;
  406  
  407     // Do th is once, o r when fon t changes  in Options
  408     GUI_Cont rol.Config ureGUI(gvF ont);
  409     // Do no t place "P osition" i n Configur eForm
  410     Position  := poDesi gned;
  411  
  412     IsScreen ReaderInUs e;
  413  
  414     DataBase Mode := db Nil;
  415  
  416     {- There  are three  ways MHA  can be sta rted:
  417          1.  Off-line.  No connect ion to CPR S is detec ted. User  can enter  some
  418              instrument s but resu lts are no t availabl e. When th e user rec onnects
  419              to the VA  network, t hey will b e prompted  to upload  the off-l ine
  420              administra tions.
  421          2.  CPRS Tools  menu (Sta ndard). Pa rameters a re passed  to MHA ide ntifying
  422              the server , port, us er, patien t, etc. MH A displays  its stand ard main m enu.
  423          3.  CPRS Tools  menu (Ide ntified In strument).  The main  menu
  424              is not pre sented, ra ther a sub -menu disp laying the  identifie d instrume nt
  425              previous a dministrat ions for t his patien t and opti ons for ne w administ rations
  426              and/or edi t previous  ones.
  427  
  428  
  429        The g atekeeper  is located  in DataMo dule1 whic h counts t he number  of passed
  430        param eters: 0 f or Off-lin e, 5 for s tandard, 6  for Ident ified Inst rument. -}
  431  
  432     if DataM odule1.Con nectToVist a(self) th en
  433       begin
  434         FVis taMsg := R egisterWin dowMessage ('VistA Ev ent - Clin ical'); // FOR CPRS
  435         Pati ent.Load(P iece(Param Str(3), '= ', 2), Dat aModule1.R PCBroker1) ;
  436         This User.Load( DataModule 1.RPCBroke r1.User.DU Z, DataMod ule1.RPCBr oker1);
  437         // p atch 108 l lh -- the  GAF is bei ng removed  in this p atch
  438         //GA F_OPS := T GAF_OPS.Cr eate;
  439       end;
  440  
  441     // Off-l ine Start
  442     if not ( DataBaseMo de = dbVis ta) then
  443       begin
  444         // X E3 migrati on llh, -  replaced c ode
  445         //Sp lashScreen .Release;
  446         if ( MsgDlgFrm( 'MHA is no t able to  connect to  VistA.  '
  447           +  'The only  thing you  can do off -line is a dminister  an instrum ent.  '
  448           +  'You can u pload the  results th e next tim e you are  connected  to VistA.'
  449           +  CRLF + CRL F
  450           +  '(If you c an start C PRS from t his machin e, you sho uld do so  and then '
  451           +  'start MHA  from the  CPRS tools  menu.)'
  452           +  CRLF + CRL F
  453           +  'Do you wa nt to work  off-line? ',
  454           MH A_Caption,  mtConfirm ation, [mb Yes, mbNo] , 0) = mrY es) then
  455           be gin
  456              DataBaseMo de := dbOf fLine;
  457              ThisUser.D UZ := NO_I D;
  458              ThisUser.N ame := 'Of f Line';
  459              Caption :=  Caption +  OFFLINE_C APTION;
  460              // XE3 mig ration llh  -- new sp lashscreen  stuff
  461              frmMHA_Spl ashScreen. Hide ;
  462              frmMHA_Spl ashScreen. Release;
  463              LoadPatien tSelection Form;
  464              Halt;
  465              Exit;
  466           en d
  467         else
  468           Ha lt;
  469       end; / / Off-line
  470  
  471     // Ident ified Inst rument: Su b-menu sta rt up
  472     if (Data BaseMode =  dbVista)  and (Param Count > 5)  then
  473       // s=XXXXX X URL            p= PORT  DFN= XXX  DUZ= XXXX  m=MREF CA GE
  474       begin
  475         gvNa meOfInstru ment := '' ;
  476         for  i := 6 to  ParamCount  do
  477           gv NameOfInst rument :=  gvNameOfIn strument +  ParamStr( i) + ' ';
  478         gvNa meOfInstru ment := Tr im(UpperCa se(gvNameO fInstrumen t));
  479  
  480         // X E3 migrati on llh; re placed cod e
  481         //Sp lashScreen .Release;
  482         // X E3 migrati on llh --  new splash screen stu ff
  483         frmM HA_SplashS creen.Hide  ;
  484         frmM HA_SplashS creen.Rele ase;
  485  
  486         Show SingleInst rumentMenu ;
  487  
  488         if g vID <> 'Re turn' then
  489           be gin
  490              Close;
  491              Halt;
  492              exit;
  493           en d;
  494       end;
  495  
  496     Configur eForm; //  Don't put  this in Fo rmShow as  it will be  run every time the
  497       // use r returns  to the mai n menu.
  498  
  499     mnuMetri c.Enabled  := (DataBa seMode = d bVista);
  500     mnuOnlin eSupport.E nabled :=  (DataBaseM ode = dbVi sta);
  501  
  502     ShowOrHi deImage;
  503     // XE3 m igration l lh; replac ed code
  504     //Splash Screen.Rel ease;
  505     // XE3 m igration l lh -- new  splashscre en stuff
  506     frmMHA_S plashScree n.Hide ;
  507     frmMHA_S plashScree n.Release  ;
  508  
  509     if (Data BaseMode =  dbVista)  then
  510       begin
  511         mnuU ploadResul ts.Enabled  := LocalF iles.OffLi neAdminist rationFile sExist;
  512  
  513         if m nuUploadRe sults.Enab led then
  514           if  (MsgDlgFr m('Do you  want to up load to Vi stA the re sults of i nstruments  '
  515              + 'that we re adminis tered off- line?', MH A_Caption,  mtInforma tion,
  516              [mbYes, mb No], 0) =  mrYes) the n
  517              mnuUploadR esultsClic k(Self);
  518       end; / /if DataBa seMode = d bVista
  519  
  520     //ver 70  patch 108 , remove G AF from Op tion menu,  need to a djust item index by 1
  521     if (gvSt art = 4 {5 }) and gvU seScreenRe ader then
  522       gvStar t := 0;
  523  
  524     case gvS tart of
  525       1: Sho wTestsSele ct;
  526       2: Sho wResults;
  527       //ver  70 patch 1 08, GAF re moved from  option me nu
  528       //3: S howGAF;
  529       3 {4}:  ShowASI;
  530       4 {5}:  ShowResul ts; // The  Special R esult is p icked up l ater
  531     end;
  532  
  533   end;
  534  
  535   procedure  TfrmMHA_Ma in.FormSho w(Sender:  TObject);
  536   begin
  537  
  538     Screen.C ursor := c rDefault;
  539     OpenForm Name := of Main;
  540     lvInProc ess := Fal se;
  541  
  542   end;
  543  
  544   procedure  TfrmMHA_Ma in.FormAct ivate(Send er: TObjec t);
  545   begin
  546  
  547     Left :=  GUI_Contro l.GetLeft( Width);
  548     Top := G UI_Control .GetTop(He ight);
  549  
  550     // User  may have c hanged fon ts in prev ious menu  item
  551     if GUI_C ontrol.Nee dGUIUpdate  then
  552       Config ureForm;
  553  
  554     // Updat e "GAF nee ded" remin der
  555     // patch  108 llh - - the GAF  is being r emoved in  this patch
  556     {
  557     if DataB aseMode =  dbVista th en
  558       begin
  559         GAF_ OPS.GetPre viousGAFRa tings(Pati ent.DFN);
  560  
  561         if G AF_OPS.Rat ingIsDue t hen
  562           lb lGAFDue.Ca ption := ' GAF rating  is due'
  563         else
  564           lb lGAFDue.Ca ption := ' ';
  565       end;
  566      }
  567     SetTests ;
  568   end;
  569  
  570  
  571   procedure  TfrmMHA_Ma in.FormClo se(Sender:  TObject;
  572     var Acti on: TClose Action);
  573   begin
  574     FormatSe ttings.Dat eSeparator  := lvDate Separator;
  575     FormatSe ttings.Tim eSeparator  := lvTime Separator;
  576     FormatSe ttings.Sho rtDateForm at := lvSh ortDateFor mat;
  577     FormatSe ttings.Lon gTimeForma t := lvLon gTimeForma t;
  578  
  579     gvLeft : = Left;
  580     gvTop :=  Top;
  581     MHA_Regi stry.SaveR egistry;
  582   end;
  583  
  584   procedure  TfrmMHA_Ma in.FormDes troy(Sende r: TObject );
  585   begin
  586     if GAF_O PS <> nil  then
  587       GAF_OP S.Free;
  588  
  589     gvAPICal ls.Free;
  590     gvFont.F ree;
  591   end;
  592  
  593   procedure  TfrmMHA_Ma in.Configu reForm;
  594   var
  595     i                              : Integer;
  596   begin
  597  
  598     with GUI _Control d o
  599       begin
  600         Need GUIUpdate  := False;
  601         Scal ed := True ;
  602         Auto Scroll :=  False;
  603         // N ote: Set A utoSize to  true to h andle 120  DPI. Other wise, the  lower
  604         // p ortion is  truncated  and no GAF  text appe ars.
  605         Auto Size := Tr ue;
  606         Pixe lsPerInch  := 120;
  607  
  608         Bord erStyle :=  bsSingle;  // don't  allow resi zing on Ma in form
  609         KeyP review :=  True;
  610         Horz ScrollBar. Range := 0 ; // Ensur es that bu ttons will  move when  re-sized
  611         Vert ScrollBar. Range := 0 ;
  612         Font .Assign(gv Font);
  613  
  614         Capt ion := MHA _Caption +  ' in use  by ' + Thi sUser.Name ;
  615         pnlH eader.Heig ht := pnlH eaderHeigh t;
  616  
  617         for  i := 0 to  ComponentC ount - 1 d o
  618           be gin
  619              if (Compon ents[i] is  TLabel) t hen
  620                begin
  621                  TLabel (Component s[i]).Font .Name := g vFont.Name ;
  622                  TLabel (Component s[i]).Font .Size := l blPatientF ontSize;
  623                end;
  624  
  625              if (Compon ents[i] is  TRzLabel)  then
  626                begin
  627                  TRzLab el(Compone nts[i]).Fo nt.Name :=  gvFont.Na me;
  628                  TRzLab el(Compone nts[i]).Fo nt.Size :=  FontSizeM enuSelecti ons;
  629                  TRzLab el(Compone nts[i]).Fo nt.Style : = gvFont.S tyle;
  630                end;
  631           en d;
  632  
  633         // p atch 108 c hanges for  508 compl iance llh
  634         // n ext line w ay it was,  added if  else block
  635         // l blPatient. caption :=  Patient.C aptionInfo ;
  636         if n ot gvUseSc reenReader  then
  637           be gin
  638              lblPatient .Visible : = true;
  639              lblPatient ScrnRder.V isible :=  false;
  640              lblPatient .caption : = Patient. CaptionInf o;
  641              pnlHeader. TabStop :=  false;
  642           en d
  643         else
  644           be gin
  645              lblPatient .Visible : = false;
  646              lblPatient ScrnRder.V isible :=  true ;
  647              lblPatient ScrnRder.C aption :=  'Mental He alth Assis tant ' + P atient.Cap tionInfo ;
  648              pnlHeader. TabStop :=  true ;
  649           en d;
  650  
  651         Left  := GetLef t(Width);
  652         Top  := GetTop( Height);
  653         // p atch 108 l lh -- the  GAF is bei ng removed  in this p atch
  654         {
  655         lblG AFDue.widt h := lblGA F.width;
  656         lblG AFDue.Left  := lblGAF .left;
  657         lblG AFDue.Font .Name := ' MS Sans Se rif';
  658         lblG AFDue.Font .Size := 9 ;
  659         lblG AFDue.Font .Style :=  [fsBold];
  660         lblG AFDue.Top  := frmMHA_ Main.Heigh t - pnlHea der.Height  -
  661           (3  * lblGAFD UE.Height) ;
  662         }
  663       end;
  664  
  665     if gvUse ScreenRead er then
  666       SetupS creenReade r(nil); //  visual st uff
  667   end;
  668  
  669  
  670   function T frmMHA_Mai n.GetDPI:  integer;
  671   // Usual s etting is  96, but so me use 120 .
  672   var
  673     DC                             : hDC;
  674   begin
  675     DC := Ge tDC(Handle );
  676     Result : = GetDevic eCaps(DC,  LOGPIXELSX );
  677     ReleaseD C(Handle,  DC);
  678   end;
  679  
  680   procedure  TfrmMHA_Ma in.IsScree nReaderInU se;
  681   var
  682     ListStat eOn                   : longbool ;
  683     Success                        : longbool ;
  684   begin
  685  
  686     // Deter mine if a  screen rea der is cur rently bei ng used.
  687     Success  := SystemP arametersI nfo(SPI_GE TSCREENREA DER, 0, @L istStateOn , 0);
  688  
  689     if Succe ss and Lis tStateOn t hen
  690       begin
  691         gvUs eScreenRea der := Tru e;
  692         gvUs eDesignFon t := false ;
  693         gvFo nt.Name :=  'MS Sans  Serif';
  694         gvFo nt.Size :=  8;
  695         gvFo nt.Style : = [];
  696       end
  697     else
  698       begin
  699       // All ow user's  preference  to remain
  700         if g vUseScreen Reader = T rue then
  701           if  (MsgDlgFr m('The pre sence of a  screen re ader has n ot been '  +
  702              'detected,  yet the u ser prefer ence is to  present M HA as if a  ' +
  703              'screen re ader were  in use. '  + #13 + #1 3 +
  704              'Do you wi sh to cont inue in th e screen r eader mode ?',
  705              MHA_Captio n, mtConfi rmation,
  706              [mbYes, mb No], 0) =  mrYes) the n
  707              exit;
  708  
  709         gvUs eScreenRea der := Fal se;
  710       end;
  711  
  712     MHA_Regi stry.SaveR egistry;
  713   end;
  714  
  715   procedure  TfrmMHA_Ma in.SetupSc reenReader (Sender: T Object);
  716   // XE3 mig ration llh , commente d out, not  used
  717   //var
  718     //reply                          : TModal Result;
  719  
  720  
  721     function  FormatSSN (ASSN: str ing): stri ng;
  722     begin
  723       if (Le ngth(ASSN)  > 8)
  724         and  not (Copy( ASSN, 1, 1 ) = '*') t hen
  725         Resu lt := Copy (ASSN, 1,  3) + '-' +  Copy(ASSN , 4, 2) +  '-'
  726           +  Copy(ASSN,  6, Length (ASSN))
  727       else
  728         Resu lt := ASSN ;
  729     end;
  730  
  731   begin
  732  
  733     Caption  := 'MHA Ma in Menu. P atient is  ' + Patien t.Name +
  734       ' SSN  ' + Format SSN(Patien t.SSN);
  735     imgTests .visible : = false;
  736     imgResul ts.visible  := false;
  737     // patch  108 llh - - the GAF  is being r emoved in  this patch
  738     //imgGAF .visible : = false;
  739     imgASI.v isible :=  false;
  740     lblInstA dmin.visib le := Fals e;
  741     lblResul ts.visible  := False;
  742     // patch  108 llh - - the GAF  is being r emoved in  this patch
  743     //lblGAF .visible : = False;
  744     lblASI.v isible :=  False;
  745     pnlScree nReader.Vi sible := T rue;
  746     pnlScree nReader.al ign := alC lient;
  747     refresh;
  748  
  749     with GUI _Control d o
  750       begin
  751         btnI nstAdmin.F ont.Assign (gvFont);
  752         btnR esults.Fon t.Assign(g vFont);
  753         btnA SI.Font.As sign(gvFon t);
  754         // p atch 108 l lh -- the  GAF is bei ng removed  in this p atch
  755         //bt nGAF.Font. Assign(gvF ont);
  756         btnI nstAdmin.H eight := B uttonHeigh t;
  757         btnR esults.Hei ght := btn InstAdmin. Height;
  758         btnA SI.Height  := btnInst Admin.Heig ht;
  759         // p atch 108 l lh -- the  GAF is bei ng removed  in this p atch
  760         //bt nGAF.Heigh t := btnIn stAdmin.He ight;
  761  
  762         btnI nstAdmin.L eft := 0;
  763         btnR esults.Lef t := btnIn stAdmin.Le ft;
  764         btnA SI.Left :=  btnInstAd min.Left;
  765         // p atch 108 l lh -- the  GAF is bei ng removed  in this p atch
  766         //bt nGAF.Left  := btnInst Admin.Left ;
  767  
  768         btnI nstAdmin.W idth := Cl ientWidth;
  769         btnR esults.Wid th := btnI nstAdmin.W idth;
  770         btnA SI.Width : = btnInstA dmin.Width ;
  771         // p atch 108 l lh -- the  GAF is bei ng removed  in this p atch
  772         //bt nGAF.Width  := btnIns tAdmin.Wid th;
  773  
  774         btnI nstAdmin.T op := (pnl ScreenRead er.Height  - (4 * btn InstAdmin. Height))
  775           di v 5;
  776         btnR esults.Top  := 2 * bt nInstAdmin .Top + btn InstAdmin. Height;
  777         btnA SI.Top :=  (3 * btnIn stAdmin.To p) + (2 *  btnInstAdm in.Height) ;
  778         // p atch 108 l lh -- the  GAF is bei ng removed  in this p atch
  779         //bt nGAF.Top : = (4 * btn InstAdmin. Top) + (3  * btnInstA dmin.Heigh t);
  780       end;
  781  
  782     // patch  108 llh - - the GAF  is being r emoved in  this patch
  783     //btnGAF .Visible : = (DataBas eMode = db Vista);
  784     btnASI.V isible :=  (DataBaseM ode = dbVi sta);
  785     btnResul ts.Visible  := (DataB aseMode =  dbVista);
  786  
  787   (*
  788     // Ensur e that con figuration  file is p resent.
  789     if not F ileExists( gvJAWS_Dir ) then
  790       begin
  791         if F ileExists( 'YS_MHA.JC F') then
  792           be gin
  793              CopyFile(P Char('YS_M HA.JCF'),  PChar(gvJA WS_Dir), F alse);
  794  
  795              if GetLast Error <> 0  then // z ero = No e rrors
  796                begin
  797                  reply  := MsgDlgF rm('If you  have JAWS  (a screen  reader pr ogram) ' +
  798                    'ins talled on  this PC, t he JAWS co nfiguratio n file, YS _MHA.JCF,  ' +
  799                    'is  not proper ly install ed. ' + #1 3 + 'To fi nd the pro per direct ory ' +
  800                    'use  the OK bu tton, othe rwise use  the Cancel  button.',
  801                    MHA_ Caption, m tInformati on, [mbOK,  mbCancel] , 0);
  802  
  803                  if rep ly = mrCan cel then
  804                    Exit ;
  805  
  806                  dlgDir  := TRzSel ectFolderD ialog.Crea te(self);
  807                  dlgDir .Title :=  'Select di rectory wh ere JAWS c onfigurati on files a re located . ' +
  808                    'Thi s program  will copy  its config uration fi le to that  location. ';
  809                  // dlg Dir.BaseFo lder uses  'C:\Docume nts and Se ttings\All  Users\app lication d ata\freedo m scientif ic\jaws';
  810                  dlgDir .BaseFolde r.PathName  := 'C:\Do cuments an d Settings \All Users \applicati on data\fr eedom scie ntific\jaw s';
  811                  if dlg Dir.Execut e then
  812                    begi n
  813                      gv JAWS_Dir : = dlgDir.S electedPat hName + 'Y S_MHA.JCF' ;
  814                      Co pyFile(PCh ar('YS_MHA .JCF'), PC har(gvJAWS _Dir), Fal se);
  815                    end;
  816                  dlgDir .Free;
  817  
  818                end;
  819           en d;
  820       end;*)
  821   end;
  822  
  823   procedure  TfrmMHA_Ma in.ShowSin gleInstrum entMenu;
  824   begin
  825     gvLeft : = Left;
  826     gvTop :=  Top;
  827     gvHeight  := Height ;
  828     gvWidth  := Width;
  829     MHA_Regi stry.SaveR egistry;
  830  
  831     Hide; //  Main form
  832  
  833     Screen.C ursor := c rHourglass ;
  834  
  835     OpenForm Name := of SingleMenu ;
  836  
  837     if Upper Case(Param Str(6)) =  'ASI' then
  838       begin
  839         Open FormName : = ofASIMen u;
  840         try
  841           fr mMHA_ASI_M ain := Tfr mMHA_ASI_M ain.Create (nil);
  842           fr mMHA_ASI_M ain.ShowMo dal;
  843         fina lly
  844           fr mMHA_ASI_M ain.Free;
  845         end;
  846         exit ;
  847       end;
  848  
  849     //ver 70  patch 108  llh - rem ove abilit y to run a  GAF
  850     {
  851     if Upper Case(Param Str(6)) =  'GAF' then
  852       begin
  853         Open FormName : = ofGAF;
  854         try
  855           fr mMHA_GAF : = TfrmMHA_ GAF.Create (nil);
  856           fr mMHA_GAF.S howModal;
  857         fina lly
  858           fr mMHA_GAF.F ree;
  859         end;
  860         exit ;
  861       end;
  862     }
  863     try
  864       frmMHA _SingleIns trumentMen u := TfrmM HA_SingleI nstrumentM enu.Create (nil);
  865       frmMHA _SingleIns trumentMen u.ShowModa l;
  866     finally
  867       frmMHA _SingleIns trumentMen u.Free;
  868     end;
  869  
  870   end;
  871  
  872  
  873   procedure  TfrmMHA_Ma in.mnuExit Click(Send er: TObjec t);
  874   begin
  875     Close;
  876   end;
  877  
  878  
  879   procedure  TfrmMHA_Ma in.Waiting Display;
  880   begin
  881     // Save  current lo cation whe n this for m is re-ac tivated.
  882     gvTop :=  Top;
  883     gvLeft : = Left;
  884     gvWidth  := Width;
  885     gvHeight  := Height ;
  886     MHA_Regi stry.SaveR egistry;
  887     Screen.c ursor := c rHourGlass ;
  888   end;
  889  
  890  
  891   procedure  TfrmMHA_Ma in.LoadPat ientSelect ionForm;
  892   // Working  off-line:  Select pa tient, the n the inst rument(s),
  893   // adminis ter the in strument(s ), save da ta to loca l files (t o be
  894   // up-load ed later,  when conne cted to Vi sta).
  895   begin
  896     WaitingD isplay;
  897  
  898     try
  899       frmMHA _SelectPat ient := Tf rmMHA_Sele ctPatient. Create(nil );
  900       frmMHA _SelectPat ient.ShowM odal;
  901     finally
  902       frmMHA _SelectPat ient.Free;
  903     end;
  904   end;
  905  
  906  
  907   procedure  TfrmMHA_Ma in.LoadIns trumentSel ectForm;
  908   begin
  909     OpenForm Name := of Select;
  910  
  911     try
  912       frmMHA _Instrumen tSelect :=  TfrmMHA_I nstrumentS elect.Crea te(nil);
  913       frmMHA _Instrumen tSelect.Sh owModal;
  914     finally
  915       frmMHA _Instrumen tSelect.Fr ee;
  916     end; //t ry
  917  
  918     SetTests ;
  919   end;
  920  
  921   procedure  TfrmMHA_Ma in.ShowTes tsSelect;
  922   begin
  923     if lvInP rocess the n
  924       Exit;
  925  
  926     lvInProc ess := Tru e;
  927  
  928     //if no  patient se lected, se lect one
  929     if not P atient.IsS elected th en
  930       Prompt PatientSel ection('No  instrumen ts can be  administer ed ');
  931  
  932     //if the re still i sn't one s elected, e xit
  933     if not P atient.IsS elected th en
  934       Exit;
  935  
  936     if not E nterDataFo rDeadPatie nt then
  937       Exit;
  938  
  939     if not g vUseScreen Reader the n
  940       begin
  941         lblA SI.Visible  := False;
  942         // p atch 108 l lh -- the  GAF is bei ng removed  in this p atch
  943         //lb lGAF.Visib le := Fals e;
  944         lblR esults.Vis ible := Fa lse;
  945         // p atch 108 5 08 changes  llh
  946         pnlH eader.TabS top := fal se;
  947       end;
  948  
  949     WaitingD isplay;
  950     LoadInst rumentSele ctForm;
  951     lvInProc ess := Fal se;
  952  
  953     if not g vUseScreen Reader the n
  954       begin
  955         lblI nstAdmin.V isible :=  True;
  956         // p atch 108 l lh -- the  GAF is bei ng removed  in this p atch
  957         //lb lGAF.Visib le := True ;
  958         lblA SI.Visible  := True;
  959         //pa tch 108 50 8 changes  llh
  960         pnlH eader.TabS top := fal se;
  961       end
  962       // pat ch 108 508  changes
  963     else
  964       begin
  965         pnlH eader.TabS top := tru e ;
  966         Acti veControl  := lblPati entScrnRde r;
  967       end;
  968   end;
  969  
  970   procedure  TfrmMHA_Ma in.mnuOpti onsClick(S ender: TOb ject);
  971   begin
  972     if gvUse ScreenRead er then
  973       begin
  974         try
  975           fr mMHA_Optio ns_508 :=  TfrmMHA_Op tions_508. Create(nil );
  976         fina lly
  977           fr mMHA_Optio ns_508.Fre e;
  978         end;
  979  
  980       end
  981     else
  982       begin
  983         Wait ingDisplay ;
  984  
  985         gvSh owOptionTa bs := '02' ;
  986  
  987         try
  988           fr mMHA_Optio ns := Tfrm MHA_Option s.Create(n il);
  989         fina lly
  990           fr mMHA_Optio ns.Free;
  991         end;
  992       end;
  993  
  994     if GUI_C ontrol.Nee dGUIUpdate  then
  995       Config ureForm;
  996  
  997     if gvUse ScreenRead er then
  998       begin
  999         Setu pScreenRea der(Sender );
  1000         Acti veControl  := btnInst Admin;
  1001       end
  1002     else
  1003       begin
  1004         Show OrHideImag e;
  1005         SetT ests;
  1006       end;
  1007  
  1008     Screen.C ursor := c rDefault;
  1009  
  1010   end;
  1011  
  1012  
  1013   procedure  TfrmMHA_Ma in.mnuSele ctPatientC lick(Sende r: TObject );
  1014   var
  1015     Save_Cur sor                   : TCursor;
  1016     OldDFN                         : string;
  1017  
  1018   begin
  1019     OldDFN : = Patient. DFN;
  1020     OpenForm Name := of Main;
  1021  
  1022     Save_Cur sor := Scr een.Cursor ;
  1023     Screen.C ursor := c rHourglass ; { Show h ourglass c ursor }
  1024     try
  1025       Patien t_OPS.Sele ctUsingCPR S;
  1026     finally
  1027       Screen .Cursor :=  Save_Curs or; { Alwa ys restore  to normal  }
  1028     end;
  1029  
  1030     ShowOrHi deImage;
  1031   end;
  1032  
  1033   //- patch  108 ver 70  llh, - re moved GAF  frm MHA; o riginally  missed
  1034   {procedure  TfrmMHA_M ain.ShowGA F;
  1035   begin
  1036  
  1037     // patch  108 llh - - the GAF  is being r emoved in  this patch
  1038     exit;
  1039  
  1040     if lvInP rocess the n
  1041       Exit;
  1042  
  1043     lvInProc ess := Tru e;
  1044  
  1045     if not g vUseScreen Reader the n
  1046       begin
  1047         lblI nstAdmin.V isible :=  False;
  1048         lblA SI.Visible  := False;
  1049         lblR esults.Vis ible := Fa lse;
  1050       end;
  1051  
  1052     //if no  patient se lected, se lect one
  1053     if not P atient.IsS elected th en
  1054       Prompt PatientSel ection('GA F ratings  cannot be  made or sh own ');
  1055  
  1056     //if the re still i sn't one s elected, e xit
  1057     if not P atient.IsS elected th en
  1058       Exit;
  1059  
  1060     WaitingD isplay;
  1061     OpenForm Name := of GAF;
  1062  
  1063     try
  1064       frmMHA _GAF := Tf rmMHA_GAF. Create(nil );
  1065       frmMHA _GAF.ShowM odal;
  1066     finally
  1067       frmMHA _GAF.Free;
  1068     end;
  1069  
  1070     lvInProc ess := Fal se;
  1071  
  1072     if not g vUseScreen Reader the n
  1073       begin
  1074         lblI nstAdmin.V isible :=  True;
  1075         lblG AF.Visible  := True;
  1076         lblA SI.Visible  := True;
  1077       end;
  1078   end;
  1079   }
  1080  
  1081   procedure  TfrmMHA_Ma in.ShowASI ;
  1082   begin
  1083  
  1084     if lvInP rocess the n
  1085       Exit;
  1086  
  1087     lvInProc ess := Tru e;
  1088  
  1089     if not g vUseScreen Reader the n
  1090       begin
  1091         lblI nstAdmin.V isible :=  False;
  1092         // p atch 108 l lh -- the  GAF is bei ng removed  in this p atch
  1093         //lb lGAF.Visib le := Fals e;
  1094         lblR esults.Vis ible := Fa lse;
  1095       end;
  1096  
  1097     // if no  patient s elected, s elect one
  1098     if not P atient.IsS elected th en
  1099       Prompt PatientSel ection('AS I results  cannot be  entered or  shown ');
  1100  
  1101     // if th ere still  isn't one  selected,  exit
  1102     if not P atient.IsS elected th en
  1103       Exit;
  1104  
  1105     WaitingD isplay;
  1106     OpenForm Name := of ASIMenu;
  1107  
  1108     try
  1109       frmMHA _ASI_Main  := TfrmMHA _ASI_Main. Create(nil );
  1110       frmMHA _ASI_Main. ShowModal;
  1111     finally
  1112       frmMHA _ASI_Main. Free;
  1113     end;
  1114  
  1115     if not g vUseScreen Reader the n
  1116       begin
  1117         lblI nstAdmin.V isible :=  True;
  1118         // p atch 108 l lh -- the  GAF is bei ng removed  in this p atch
  1119         //lb lGAF.Visib le := True ;
  1120         lblR esults.Vis ible := Tr ue;
  1121         //pa tch 108 50 8 changes  llh
  1122         pnlH eader.TabS top := fal se;
  1123       end
  1124       // pat ch 108 508  changes
  1125     else
  1126       begin
  1127         pnlH eader.TabS top := tru e ;
  1128         Acti veControl  := lblPati entScrnRde r;
  1129       end;   // end 508  changes
  1130       
  1131     lvInProc ess := Fal se;
  1132   end;
  1133  
  1134   procedure  TfrmMHA_Ma in.PromptP atientSele ction(AMes sage: stri ng);
  1135   begin
  1136     mnuSelec tPatientCl ick(Self);
  1137  
  1138     // if th ere still  isn't a pa tient sele cted, show  message
  1139     if not P atient.IsS elected th en
  1140       MsgDlg Frm(AMessa ge + 'beca use no pat ient is se lected.',  MHA_Captio n,
  1141         mtIn formation,  [mbOK], 0 );
  1142   end;
  1143  
  1144   procedure  TfrmMHA_Ma in.ShowRes ults;
  1145   begin
  1146     if lvInP rocess the n
  1147       Exit;
  1148  
  1149     lvInProc ess := Tru e;
  1150  
  1151     if not g vUseScreen Reader the n
  1152       begin
  1153         lblI nstAdmin.V isible :=  False;
  1154         // p atch 108 l lh -- the  GAF is bei ng removed  in this p atch
  1155         //lb lGAF.Visib le := Fals e;
  1156         lblA SI.Visible  := False;
  1157         //pa tch 108 50 8 changes  llh
  1158         pnlH eader.TabS top := fal se;
  1159        end;
  1160        
  1161     // if no  patient s elected, s elect one
  1162     if not P atient.IsS elected th en
  1163       Prompt PatientSel ection('No  results c an be show n ');
  1164  
  1165     // if th ere still  isn't one  selected,  exit
  1166     if not P atient.IsS elected th en
  1167       Exit;
  1168  
  1169     OpenForm Name := of Result;
  1170     Applicat ion.Proces sMessages;
  1171     WaitingD isplay;
  1172  
  1173     try
  1174       frmMHA _Instrumen tResults : = TfrmMHA_ Instrument Results.Cr eate(nil);
  1175       frmMHA _Instrumen tResults.S howModal;
  1176     finally
  1177       frmMHA _Instrumen tResults.F ree;
  1178     end; //t ry
  1179  
  1180     lvInProc ess := Fal se;
  1181  
  1182     if not g vUseScreen Reader the n
  1183       begin
  1184         lblI nstAdmin.V isible :=  True;
  1185         // p atch 108 l lh -- the  GAF is bei ng removed  in this p atch
  1186         //lb lGAF.Visib le := True ;
  1187         lblA SI.Visible  := True;
  1188         //pa tch 108 50 8 changes  llh
  1189         pnlH eader.TabS top := fal se;
  1190       end
  1191       // pat ch 108 508  changes
  1192     else
  1193       begin
  1194         pnlH eader.TabS top := tru e ;
  1195         Acti veControl  := lblPati entScrnRde r;
  1196       end;
  1197  
  1198     // If Sp ecial Resu lts Wizard  has chang ed Special  Result Ta b, then
  1199     // re-op en Results
  1200     if gvSho wOptionTab s = 'SR' t hen
  1201       begin
  1202         gvSh owOptionTa bs := '';
  1203         Show Results;
  1204       end;
  1205  
  1206   end;
  1207  
  1208   procedure  TfrmMHA_Ma in.SetASI;
  1209   begin
  1210     Screen.C ursor := c rDefault;
  1211     lvMenuMa rker := 2;
  1212     if gvUse ScreenRead er then
  1213       Exit;
  1214  
  1215     if gvSho wImage the n
  1216       lblASI .Font.Colo r := clGre en
  1217     else
  1218       lblASI .Font.Colo r := clBla ck;
  1219     // patch  108 llh - - the GAF  is being r emoved in  this patch
  1220     //lblGAF .Font.Colo r := clBla ck;
  1221     lblResul ts.Font.Co lor := clB lack;
  1222     lblInstA dmin.Font. Color := c lBlack;
  1223     // patch  108 llh - - the GAF  is being r emoved in  this patch
  1224     //imgGAF .Visible : = false;
  1225     imgResul ts.Visible  := false;
  1226     imgTests .Visible : = False;
  1227  
  1228     lblInstA dmin.Font. Style := [ ];
  1229     lblASI.F ont.Style  := [fsUnde rline];
  1230     // patch  108 llh - - the GAF  is being r emoved in  this patch
  1231     //lblGAF .Font.Styl e := [];
  1232     lblResul ts.Font.St yle := [];
  1233  
  1234     if gvSho wImage the n
  1235       imgASI .Visible : = True;
  1236   end;
  1237  
  1238   procedure  TfrmMHA_Ma in.SetGAF;
  1239   begin
  1240     Screen.C ursor := c rDefault;
  1241     lvMenuMa rker := 3;
  1242     if gvUse ScreenRead er then
  1243       Exit;
  1244  
  1245     // patch  108 llh - - the GAF  is being r emoved in  this patch
  1246     {
  1247     if gvSho wImage the n
  1248       lblGAF .Font.Colo r := clGre en
  1249     else
  1250       lblGAF .Font.Colo r := clBla ck;
  1251     }
  1252     lblASI.F ont.Color  := clBlack ;
  1253     lblResul ts.Font.Co lor := clB lack;
  1254     lblInstA dmin.Font. Color := c lBlack;
  1255     imgASI.V isible :=  False;
  1256     imgResul ts.Visible  := false;
  1257     imgTests .Visible : = false;
  1258  
  1259     lblInstA dmin.Font. Style := [ ];
  1260     lblASI.F ont.Style  := [];
  1261     // patch  108 llh - - the GAF  is being r emoved in  this patch
  1262     //lblGAF .Font.Styl e := [fsUn derline];
  1263     lblResul ts.Font.St yle := [];
  1264  
  1265     // patch  108 llh - - the GAF  is being r emoved in  this patch
  1266     //if gvS howImage t hen imgGAF .Visible : = True;
  1267   end;
  1268  
  1269   procedure  TfrmMHA_Ma in.SetResu lts;
  1270   begin
  1271     Screen.C ursor := c rDefault;
  1272     lvMenuMa rker := 1;
  1273     if gvUse ScreenRead er then
  1274       Exit;
  1275  
  1276     if gvSho wImage the n
  1277       lblRes ults.Font. Color := c lGreen
  1278     else
  1279       lblRes ults.Font. Color := c lBlack;
  1280     lblASI.F ont.Color  := clBlack ;
  1281     // patch  108 llh - - the GAF  is being r emoved in  this patch
  1282     //lblGAF .Font.Colo r := clBla ck;
  1283     lblInstA dmin.Font. Color := c lBlack;
  1284  
  1285     lblInstA dmin.Font. Style := [ ];
  1286     lblASI.F ont.Style  := [];
  1287     // patch  108 llh - - the GAF  is being r emoved in  this patch
  1288     //lblGAF .Font.Styl e := [];
  1289     lblResul ts.Font.St yle := [fs Underline] ;
  1290  
  1291     imgASI.V isible :=  false;
  1292     // patch  108 llh - - the GAF  is being r emoved in  this patch
  1293     //imgGAF .Visible : = False;
  1294     imgTests .Visible : = False;
  1295     if gvSho wImage the n
  1296       imgRes ults.Visib le := True ;
  1297     lvMenuMa rker := 1;
  1298   end;
  1299  
  1300   procedure  TfrmMHA_Ma in.SetTest s;
  1301   begin
  1302     Screen.C ursor := c rDefault;
  1303     lvMenuMa rker := 0;
  1304  
  1305     if gvUse ScreenRead er then
  1306       begin
  1307         // p atch 108 t o make 508  compliant  llh  comm ented out  next line,  added AC  := pnlHead er...
  1308         //Ac tiveContro l := btnIn stAdmin;
  1309         pnlH eader.TabS top := tru e ;
  1310         Acti veControl  := lblPati entScrnRde r;
  1311         Exit ;
  1312       end;
  1313  
  1314     lblInstA dmin.Visib le := True ;
  1315     lblASI.F ont.Color  := clBlack ;
  1316     // patch  108 llh - - the GAF  is being r emoved in  this patch
  1317     //lblGAF .Font.Colo r := clBla ck;
  1318     lblResul ts.Font.Co lor := clB lack;
  1319  
  1320     if gvSho wImage the n
  1321       lblIns tAdmin.Fon t.Color :=  clGreen
  1322     else
  1323       lblIns tAdmin.Fon t.Color :=  clBlack;
  1324  
  1325     lblInstA dmin.Font. Style := [ fsUnderlin e];
  1326     lblASI.F ont.Style  := [];
  1327     // patch  108 llh - - the GAF  is being r emoved in  this patch
  1328     //lblGAF .Font.Styl e := [];
  1329     lblResul ts.Font.St yle := [];
  1330  
  1331     // patch  108 llh - - the GAF  is being r emoved in  this patch
  1332     //lblGAF .Visible : = (DataBas eMode = db Vista);
  1333     lblASI.V isible :=  (DataBaseM ode = dbVi sta);
  1334     lblResul ts.Visible  := (DataB aseMode =  dbVista);
  1335  
  1336     if gvSho wImage the n
  1337       imgTes ts.Visible  := True;
  1338  
  1339     imgASI.V isible :=  false;
  1340     // patch  108 llh - - the GAF  is being r emoved in  this patch
  1341     //imgGAF .Visible : = false;
  1342     imgResul ts.Visible  := False;
  1343   end;
  1344  
  1345   procedure  TfrmMHA_Ma in.ShowOrH ideImage;
  1346   begin
  1347     if gvUse ScreenRead er then
  1348       Exit
  1349     else
  1350       pnlScr eenReader. Visible :=  False;
  1351  
  1352     if gvSho wImage the n
  1353       begin
  1354         imgT ests.visib le := true ;
  1355         imgR esults.vis ible := tr ue;
  1356         imgG AF.visible  := true;
  1357         imgA SI.visible  := true;
  1358         lblI nstAdmin.F ont.Color  := clBlack ;
  1359         lblR esults.Fon t.Color :=  clBlack;
  1360         // p atch 108 l lh -- the  GAF is bei ng removed  in this p atch
  1361         //lb lGAF.Font. Color := c lBlack;
  1362         lblA SI.Font.Co lor := clB lack;
  1363         lblI nstAdmin.T extStyle : = tsShadow ;
  1364         lblR esults.Tex tStyle :=  tsShadow;
  1365         // p atch 108 l lh -- the  GAF is bei ng removed  in this p atch
  1366         //lb lGAF.TextS tyle := ts Shadow;
  1367         lblA SI.TextSty le := tsSh adow;
  1368       end
  1369     else
  1370       begin
  1371         imgT ests.visib le := fals e;
  1372         imgR esults.vis ible := fa lse;
  1373         // p atch 108 l lh -- the  GAF is bei ng removed  in this p atch
  1374         //im gGAF.visib le := fals e;
  1375         imgA SI.visible  := false;
  1376         lblI nstAdmin.F ont.Color  := clBlack ;
  1377         lblR esults.Fon t.Color :=  clBlack;
  1378         // p atch 108 l lh -- the  GAF is bei ng removed  in this p atch
  1379         //lb lGAF.Font. Color := c lBlack;
  1380         lblA SI.Font.Co lor := clB lack;
  1381         lblI nstAdmin.T extStyle : = tsNormal ;
  1382         lblR esults.Tex tStyle :=  tsNormal;
  1383         // p atch 108 l lh -- the  GAF is bei ng removed  in this p atch
  1384         //lb lGAF.TextS tyle := ts Normal;
  1385         lblA SI.TextSty le := tsNo rmal;
  1386       end;
  1387   end;
  1388  
  1389   procedure  TfrmMHA_Ma in.lblASIM ouseEnter( Sender: TO bject);
  1390   begin
  1391     SetASI;
  1392     lblASI.F ont.Style  := [fsUnde rline];
  1393   end;
  1394  
  1395  
  1396   procedure  TfrmMHA_Ma in.lblGAFM ouseEnter( Sender: TO bject);
  1397   begin
  1398     SetGAF;
  1399     lblGAF.F ont.Style  := [fsUnde rline];
  1400   end;
  1401  
  1402   procedure  TfrmMHA_Ma in.lblTest sMouseEnte r(Sender:  TObject);
  1403   begin
  1404     SetTests ;
  1405     lblInstA dmin.Font. Style := [ fsUnderlin e];
  1406   end;
  1407  
  1408   procedure  TfrmMHA_Ma in.lblResu ltsMouseEn ter(Sender : TObject) ;
  1409   begin
  1410     SetResul ts;
  1411     lblResul ts.Font.St yle := [fs Underline] ;
  1412   end;
  1413  
  1414   procedure  TfrmMHA_Ma in.mnuResu ltsClick(S ender: TOb ject);
  1415   begin
  1416     ShowResu lts;
  1417   end;
  1418  
  1419   procedure  TfrmMHA_Ma in.mnuTest sClick(Sen der: TObje ct);
  1420   begin
  1421     ShowTest sSelect;
  1422   end;
  1423  
  1424   procedure  TfrmMHA_Ma in.mnuASIC lick(Sende r: TObject );
  1425   begin
  1426     ShowASI;
  1427   end;
  1428  
  1429   procedure  TfrmMHA_Ma in.mnuGAFC lick(Sende r: TObject );
  1430   begin
  1431     // patch  108 llh - - the GAF  is being r emoved in  this patch
  1432     //ShowGA F;
  1433   end;
  1434  
  1435   procedure  TfrmMHA_Ma in.mnuAbou tClick(Sen der: TObje ct);
  1436   begin
  1437     WaitingD isplay;
  1438  
  1439     frmMHA_A bout := Tf rmMHA_Abou t.Create(n il);
  1440     try
  1441       frmMHA _About.Sho wModal;
  1442     finally
  1443       frmMHA _About.Fre e;
  1444     end; //t ry
  1445  
  1446     SetTests ;
  1447  
  1448   end;
  1449  
  1450   procedure  TfrmMHA_Ma in.mnuUplo adResultsC lick(Sende r: TObject );
  1451   begin
  1452     OpenForm Name := of Upload;
  1453     WaitingD isplay;
  1454  
  1455     try
  1456       frmMHA _UploadRes ults := Tf rmMHA_Uplo adResults. Create(nil );
  1457       frmMHA _UploadRes ults.ShowM odal;
  1458     finally
  1459       frmMHA _UploadRes ults.Free;
  1460     end;
  1461  
  1462     // In ca se all off  line file s are uplo aded (and  deleted) o n Form.Sho w
  1463     mnuUploa dResults.E nabled :=
  1464       LocalF iles.OffLi neAdminist rationFile sExist;
  1465  
  1466     Show;
  1467     SetTests ;
  1468     OpenForm Name := of Main;
  1469  
  1470   end;
  1471  
  1472   procedure  TfrmMHA_Ma in.mnuMetr icClick(Se nder: TObj ect);
  1473   begin
  1474     VisitURL (MetricURL );
  1475   end;
  1476  
  1477   function T frmMHA_Mai n.EnterDat aForDeadPa tient: BOO LEAN;
  1478   begin
  1479     Result : = True;
  1480  
  1481     if Patie nt.IsDead  then
  1482       Result  := (MsgDl gFrm(Patie nt.Name +  ' died on  ' + Patien t.DOD +
  1483         '.   Are you su re '
  1484         + 'y ou want to  enter new  instrumen t data for  this pati ent?', MHA _Caption,
  1485         mtCo nfirmation , [mbYes,  mbNo], 0)  = mrYes);
  1486   end;
  1487  
  1488   procedure  TfrmMHA_Ma in.lblTest sMouseLeav e(Sender:  TObject);
  1489   begin
  1490     lblInstA dmin.Font. Style := [ ];
  1491   end;
  1492  
  1493   procedure  TfrmMHA_Ma in.lblResu ltsMouseLe ave(Sender : TObject) ;
  1494   begin
  1495     lblResul ts.Font.St yle := [];
  1496   end;
  1497  
  1498   procedure  TfrmMHA_Ma in.lblASIM ouseLeave( Sender: TO bject);
  1499   begin
  1500     lblASI.F ont.Style  := [];
  1501   end;
  1502  
  1503   procedure  TfrmMHA_Ma in.lblGAFM ouseLeave( Sender: TO bject);
  1504   begin
  1505     lblGAF.F ont.Style  := [];
  1506   end;
  1507  
  1508   procedure  TfrmMHA_Ma in.mnuOnli neSupportC lick(Sende r: TObject );
  1509   begin
  1510     VisitURL (MHA_ONLIN E_SUPPORT_ URL);
  1511   end;
  1512  
  1513   procedure  TfrmMHA_Ma in.btnInst AdminClick (Sender: T Object);
  1514   begin
  1515     ShowTest sSelect;
  1516   end;
  1517  
  1518   procedure  TfrmMHA_Ma in.btnResu ltsClick(S ender: TOb ject);
  1519   begin
  1520     ShowResu lts;
  1521   end;
  1522  
  1523   procedure  TfrmMHA_Ma in.btnASIC lick(Sende r: TObject );
  1524   begin
  1525     ShowASI;
  1526   end;
  1527  
  1528   procedure  TfrmMHA_Ma in.btnGAFC lick(Sende r: TObject );
  1529   begin
  1530     // patch  108 llh -  removed a bility to  enter GAF' s, not sur e what els e needs to  be done
  1531     //                   also made  the label s and butt on on the  main menu  not visibl e.
  1532     //ShowGA F;
  1533   end;
  1534  
  1535   procedure  TfrmMHA_Ma in.FormKey Down(Sende r: TObject ; var Key:  Word;
  1536     Shift: T ShiftState );
  1537   var
  1538     TempInt                        : Integer;
  1539   begin
  1540  
  1541     if (Shif t = [ssALT ]) and (Ke y = vk_F4)  then
  1542       Close;
  1543  
  1544     if gvUse ScreenRead er then
  1545       Exit;
  1546  
  1547     TempInt  := lvMenuM arker;
  1548  
  1549     if (Key  = vk_Retur n) and not  lvInProce ss then
  1550       begin
  1551         case  lvMenuMar ker of
  1552           0:  ShowTests Select;
  1553           1:  ShowResul ts;
  1554           2:  ShowASI;
  1555           // ver 70 pat ch 108, re move GAF f rom Option  menu
  1556           // 3: ShowGAF ;
  1557         end;
  1558         Exit ;
  1559       end;
  1560  
  1561     if Key i n [73, 105 ] then {I,  i}
  1562       begin
  1563         Show TestsSelec t;
  1564         Exit ;
  1565       end;
  1566     if Key i n [82, 114 ] then {R,  r}
  1567       begin
  1568         Show Results;
  1569         Exit ;
  1570       end;
  1571     if Key i n [71, 103 ] then {G,  g}
  1572       begin
  1573         //ve r 70 patch  108, remo ve GAF fro m Option m enu
  1574         //Sh owGAF;
  1575         Exit ;
  1576       end;
  1577     if Key i n [65, 97]  then {A,  a}
  1578       begin
  1579         Show ASI;
  1580         Exit ;
  1581       end;
  1582  
  1583     if ((Key  = vk_Down ) or (Key  = vk_Right ) or (Key  = vk_Tab))  then
  1584       Inc(lv MenuMarker );
  1585  
  1586     if ((Key  = vk_Up)  or (Key =  vk_Left) o r
  1587       ((Key  = vk_Tab)  and (shift  = [ssShif t]))) then
  1588       Dec(lv MenuMarker );
  1589  
  1590     if TempI nt <> lvMe nuMarker t hen
  1591       begin
  1592         if l vMenuMarke r > 3 then
  1593           lv MenuMarker  := 0;
  1594         if l vMenuMarke r < 0 then
  1595           lv MenuMarker  := 3;
  1596  
  1597         case  lvMenuMar ker of
  1598           0:  SetTests;
  1599           1:  SetResult s;
  1600           2:  SetASI;
  1601           3:  SetGAF;
  1602         end;
  1603       end;
  1604  
  1605     lvInProc ess := Fal se;
  1606   end;
  1607  
  1608  
  1609   end.
  1610