62. EPMO Open Source Coordination Office Redaction File Detail Report

Produced by Araxis Merge on 9/24/2019 1:37:50 PM Eastern 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.

62.1 Files compared

# Location File Last Modified
1 PCL-5_v1_build_8.zip\v1_build 8\Unredacted\spp_mha_web-development.zip\spp_mha_web-development\Delphi\MHA_WEB\MockInstrumentSelect fMockInstrumentSelect.pas Wed Jul 31 17:35:31 2019 UTC
2 PCL-5_v1_build_8.zip\v1_build 8\Unredacted\spp_mha_web-development.zip\spp_mha_web-development\Delphi\MHA_WEB\MockInstrumentSelect fMockInstrumentSelect.pas Mon Sep 23 22:15:21 2019 UTC

62.2 Comparison summary

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

62.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

62.4 Active regular expressions

No regular expressions were active.

62.5 Comparison detail

  1   {
  2     This for m is used  to test ho w assignme nts might  be managed  from the  Delphi MHA  executabl e.
  3     It mimic s fMHA_Ins trumentSel ect.
  4  
  5     Command  Line Optio ns are:
  6  
  7       S[ERVE R]         VistA Serv er name or  IP addres s
  8       P[ORT]            VistA RPC  Listener P ort
  9       C[LIEN T]         DFN of Sel ected Pati ent
  10       W[EBAP P]         Path to we b app if s erving fil es locally
  11       H[TTPP ort]       Localhost  port to re ceive REST ful calls
  12       D[EBUG ]          Show Debug  Button in  Browser W indow
  13  
  14       Exampl e Paramete rs in Shor tcut ---
  15         S= URL          P= PORT  C=100014  W="..\Reac t\build" D EBUG
  16   }
  17  
  18   unit fMock Instrument Select;
  19  
  20   interface
  21  
  22   uses
  23     Winapi.W indows, Wi napi.Messa ges, Syste m.SysUtils , System.V ariants, S ystem.Clas ses, Syste m.StrUtils ,
  24     Vcl.Grap hics, Vcl. Controls,  Vcl.Forms,  Vcl.Dialo gs, Vcl.Co mCtrls, Vc l.StdCtrls , Vcl.Menu s, Vcl.Ext Ctrls,
  25     Vcl.Butt ons, Vcl.C heckLst, S ystem.Imag eList, Vcl .ImgList,  System.UIT ypes, Regi stry, TRPC B, fWebBro wser,
  26     fSetNumb er, uMHAAs signment,  uInstrumen tAvailable , uWebLoad er, ORCtrl s;
  27  
  28   type
  29     TfrmMock Instrument Select = c lass(TForm )
  30       imageL ist: TImag eList;
  31       pnlHea der: TPane l;
  32       imgBac k: TImage;
  33       lblTit le: TLabel ;
  34       lblPtN ame: TLabe l;
  35       lblPtS SN: TLabel ;
  36       mnuMai n: TMainMe nu;
  37       mnuFil e: TMenuIt em;
  38       mnuSel ectPatient : TMenuIte m;
  39       mnuPri ntBlank: T MenuItem;
  40       N1: TM enuItem;
  41       mnuExi t: TMenuIt em;
  42       mnuToo ls: TMenuI tem;
  43       mnuMet ricReviews : TMenuIte m;
  44       N2: TM enuItem;
  45       mnuBat teryWizard : TMenuIte m;
  46       mnuOpt ions: TMen uItem;
  47       mnuHel p: TMenuIt em;
  48       mnuIns trumentDes cription:  TMenuItem;
  49       N3: TM enuItem;
  50       mnuOnl ineSupport : TMenuIte m;
  51       N4: TM enuItem;
  52       mnuAbo ut: TMenuI tem;
  53       grpOrd eredBy: TG roupBox;
  54       cboOrd eredBy: TO RComboBox;
  55       grpInt erviewer:  TGroupBox;
  56       cboInt erviewer:  TORComboBo x;
  57       grpAdm inDate: TG roupBox;
  58       dtmAdm in: TDateT imePicker;
  59       grpLoc ation: TGr oupBox;
  60       cboLoc ation: TOR ComboBox;
  61       grpCon sult: TGro upBox;
  62       cboCon sult: TORC omboBox;
  63       grpIns tructions:  TGroupBox ;
  64       lblMsg : TLabel;
  65       grpAva ilable: TG roupBox;
  66       lblSho w: TLabel;
  67       cboAva ilFilter:  TComboBox;
  68       lvwAva il: TListV iew;
  69       grpAct ive: TGrou pBox;
  70       lvwAss ignments:  TListView;
  71       grpCho sen: TGrou pBox;
  72       lvwCho sen: TList View;
  73       btnRem ove: TBitB tn;
  74       btnUp:  TBitBtn;
  75       btnDow n: TBitBtn ;
  76       pnlEnt ry: TPanel ;
  77       lblDis play: TLab el;
  78       radOne AtTime: TR adioButton ;
  79       radAll Questions:  TRadioBut ton;
  80       btnPat ient: TBut ton;
  81       btnSta ff: TButto n;
  82       mnuRef resh: TMen uItem;
  83       N5: TM enuItem;
  84       proced ure FormCr eate(Sende r: TObject );
  85       proced ure FormCl ose(Sender : TObject;  var Actio n: TCloseA ction);
  86       proced ure mnuAbo utClick(Se nder: TObj ect);
  87       proced ure mnuExi tClick(Sen der: TObje ct);
  88       proced ure Person Change(Sen der: TObje ct);
  89       proced ure Person NeedData(S ender: TOb ject; cons t StartFro m: string;  Direction , InsertAt : Integer) ;
  90       proced ure cboLoc ationNeedD ata(Sender : TObject;  const Sta rtFrom: st ring; Dire ction, Ins ertAt: Int eger);
  91       proced ure lvwAva ilCustomDr awItem(Sen der: TCust omListView ; Item: TL istItem; S tate: TCus tomDrawSta te;
  92         var  DefaultDra w: Boolean );
  93       proced ure lvwAva ilResize(S ender: TOb ject);
  94       proced ure lvwAss ignmentsCu stomDrawIt em(Sender:  TCustomLi stView; It em: TListI tem; State : TCustomD rawState;
  95         var  DefaultDra w: Boolean );
  96       proced ure lvwAss ignmentsCu stomDrawSu bItem(Send er: TCusto mListView;  Item: TLi stItem; Su bItem: Int eger;
  97         Stat e: TCustom DrawState;  var Defau ltDraw: Bo olean);
  98       proced ure lvwAss ignmentsRe size(Sende r: TObject );
  99       proced ure ListVi ewChange(S ender: TOb ject; Item : TListIte m; Change:  TItemChan ge);
  100       proced ure lvwCho senEnter(S ender: TOb ject);
  101       proced ure lvwAss ignmentsEn ter(Sender : TObject) ;
  102       proced ure lvwCho senChange( Sender: TO bject; Ite m: TListIt em; Change : TItemCha nge);
  103       proced ure btnRem oveClick(S ender: TOb ject);
  104       proced ure btnUpC lick(Sende r: TObject );
  105       proced ure btnDow nClick(Sen der: TObje ct);
  106       proced ure btnPat ientClick( Sender: TO bject);
  107       proced ure btnSta ffClick(Se nder: TObj ect);
  108       proced ure FormSh ow(Sender:  TObject);
  109       proced ure mnuRef reshClick( Sender: TO bject);
  110     private
  111       { Priv ate declar ations }
  112       FBroke r: TRPCBro ker;
  113       FDFN:  string;
  114       FUserI EN: Int64;
  115       FUserN ame: strin g;
  116       FStati on: string ;
  117       FAvail ableList:  TAvailable List;
  118       FWebAp pPath: str ing;
  119       proced ure Connec tToVista(c onst aOpti on: string );
  120       proced ure Reload Available;
  121       functi on Instrum entIsChose n(const aN ame: strin g): Boolea n;
  122       proced ure AddToC hosen(anIt em: TAvail ableItem);
  123       proced ure Remove FromChosen (anItem: T AvailableI tem);
  124       proced ure Unchec kSourceIfN eeded(anIt em: TAvail ableItem);
  125       proced ure setBut tonStatus;
  126       proced ure MoveCh osenItem(o ffset: Int eger);
  127       proced ure CloseB rowser(Sen der: TObje ct);
  128       functi on ValidAs signment:  Boolean;
  129       functi on SaveAss ignment(co nst anEntr yMode: str ing): stri ng;
  130       functi on Extract Param(cons t paramNam e: string) : string;
  131       proced ure LoadBo unds(var t heLeft, th eTop, theW idth, theH eight: Int eger);
  132       functi on ReadReg istry(keyN ame: strin g): string ;
  133       proced ure WriteR egistry(co nst keyNam e, value:  string);
  134       proced ure SaveBo unds(theLe ft, theTop , theWidth , theHeigh t: Integer );
  135       proced ure SetBro wserMode;
  136       proced ure LoadWe bApp;
  137     public
  138       { Publ ic declara tions }
  139     end;
  140  
  141   var
  142     frmMockI nstrumentS elect: Tfr mMockInstr umentSelec t;
  143  
  144   implementa tion
  145  
  146   {$R *.dfm}
  147  
  148   uses ORFn,  rInstrume ntSelect;
  149  
  150   const
  151     APP_PATH  = 'VistA\ YS_MHA\v3\ webapp\';
  152     APP_VERS ION =  'st atic\js\ma in.a5cd3f2 e.js';
  153     //APP_PA TH_DEV = ' ..\React\b uild\';
  154     //APP_PA TH_DEV = ' "C:\data\R TC_Sandbox \YS_130\MH LTH_YS_Sou rce\JavaSc ript\Java\ mha-web\sr c\main\web app\React\ build\"';
  155  
  156     TXT_STAF F = 'STAFF ';    // D isplayed a s "PIN" fo r incomple te staff-e ntered ins truments
  157     IT_ASSIG NMENT = 'A ';    // I tem Types
  158     IT_INCOM PLETE = 'I ';
  159     IT_BATTE RY    = 'B ';
  160     IT_REGUL AR    = 'R ';
  161     KEY_BROW SER_FORM =  'BrowserF orm';
  162  
  163   // Initial ize and Sh utdown for  Form ---- ---------- ---------- ---------- -
  164  
  165   procedure  TfrmMockIn strumentSe lect.FormC reate(Send er: TObjec t);
  166   var
  167     x: strin g;
  168   begin
  169     SetBrows erMode;
  170     FWebAppP ath := Ext ractParam( 'WEBAPP');
  171     lblMsg.C aption :=  FWebAppPat h;
  172     if FBrok er = nil t hen Connec tToVista(' YTQREST MH A');
  173  
  174     // load  webapp fro m resource s if WEBAP P param no t passed i n
  175     if Lengt h(FWebAppP ath) = 0 t hen LoadWe bApp;
  176  
  177     // load  the patien t identifi ers for df n passed i n via para metere c={ dfn}
  178     FDFN :=  ExtractPar am('C');
  179     x := Get PatientInf o(FDFN, FB roker);
  180     lblPtNam e.Caption  := Piece(x , '^', 1);
  181     lblPtSSN .Caption : = 'SSN: '  + Piece(x,  '^', 2);
  182  
  183     // set o rderedBy,  interviewe r to curre nt user &  location t o last use d
  184     SetCurre ntUser(FUs erIEN, FUs erName, FS tation, FB roker);
  185     Self.Cap tion := 'M ental Heal th Assista nt in use  by ' + FUs erName;
  186     cboOrder edBy.InitL ongList(FU serName);
  187     cboOrder edBy.Selec tByIEN(FUs erIEN);
  188     cboInter viewer.Ini tLongList( FUserName) ;
  189     cboInter viewer.Sel ectByIEN(F UserIEN);
  190     x := Rea dRegistry( 'LastLocat ion');
  191     cboLocat ion.InitLo ngList(Pie ce(x, '^',  2));
  192     if Lengt h(x)>0 the n cboLocat ion.Select ByID(Piece (x, '^', 1 ));
  193  
  194     // load  consults,  if any and  set date  to current  time
  195     dtmAdmin .DateTime  := Now;
  196  
  197     // load  batteries,  instrumen ts, incomp lete admin s, and ass ignments
  198     FAvailab leList :=  TAvailable List.Creat e;
  199     ReloadAv ailable;
  200   end;
  201  
  202  
  203   procedure  TfrmMockIn strumentSe lect.FormS how(Sender : TObject) ;
  204   begin
  205     // SSOi  Broker doe s somethin g with mod al windows  that caus es the mai n
  206     // form  to end up  behind oth er windows , so bring  to the fo reground.
  207     if Appli cation.Mod alLevel =  0 then Set Foreground Window(Sel f.Handle);
  208   end;
  209  
  210   procedure  TfrmMockIn strumentSe lect.FormC lose(Sende r: TObject ; var Acti on: TClose Action);
  211   begin
  212     FAvailab leList.Fre e;
  213     if FBrok er <> nil  then FBrok er.Free;
  214   end;
  215  
  216   procedure  TfrmMockIn strumentSe lect.mnuEx itClick(Se nder: TObj ect);
  217   begin
  218     Close;
  219   end;
  220  
  221   procedure  TfrmMockIn strumentSe lect.mnuRe freshClick (Sender: T Object);
  222   begin
  223     ReloadAv ailable;
  224   end;
  225  
  226   procedure  TfrmMockIn strumentSe lect.mnuAb outClick(S ender: TOb ject);
  227   begin
  228   end;
  229  
  230   // Set up  the RPC Br oker for m ock enviro nment ---- ---------- ---------- -
  231  
  232   procedure  TfrmMockIn strumentSe lect.Conne ctToVista( const aOpt ion: strin g);
  233   var
  234     aPort: I nteger;
  235     aServer:  string;
  236     success:  Boolean;
  237   begin
  238     // param s may be:  S[ERVER]=h ostname P[ ORT]=port  DEBUG
  239     aServer  := Extract Param('SER VER');
  240     aPort :=  StrToIntD ef(Extract Param('POR T'), 0);
  241     if (aSer ver = '')  or (aPort  < 1) then  raise Exce ption.Crea te('Missin g Server o r Port');
  242  
  243     // insta ntiate a b roker
  244     FBroker  := TRPCBro ker.Create (Applicati on);
  245     FBroker. KernelLogI n := True;
  246     FBroker. LogIn.Mode  := TLogin Mode.lmApp Handle;
  247     FBroker. Server :=  aServer;
  248     FBroker. ListenerPo rt := aPor t;
  249     FBroker. ClearParam eters := T rue;
  250     FBroker. ClearResul ts := True ;
  251     FBroker. DebugMode  := False;
  252  
  253     // login  and set c ontext
  254     try
  255       FBroke r.Connecte d := True;
  256     except
  257       On EBr okerError  do
  258       begin
  259         Show Message('C onnection  to server  could not  be establi shed.');
  260         Exit ;
  261       end;
  262     end;
  263     try
  264       succes s := FBrok er.CreateC ontext(aOp tion);
  265     except
  266       On EBr okerError  do
  267       begin
  268         Show Message('E rror creat ing contex t.');
  269         Exit ;
  270       end;
  271     end;
  272   end;
  273  
  274  
  275   // Left Pa nel Events  (OrderedB y, Intervi ewer, Date , Consult)  --------- -
  276  
  277   procedure  TfrmMockIn strumentSe lect.Perso nChange(Se nder: TObj ect);
  278   begin
  279     ReloadAv ailable;
  280   end;
  281  
  282   procedure  TfrmMockIn strumentSe lect.Perso nNeedData( Sender: TO bject; con st StartFr om: string ; Directio n,
  283     InsertAt : Integer) ;
  284   begin
  285     (Sender  as TORComb oBox).ForD ataUse(Sub setOfPerso ns(StartFr om, Direct ion, FBrok er));
  286   end;
  287  
  288   procedure  TfrmMockIn strumentSe lect.cboLo cationNeed Data(Sende r: TObject ; const St artFrom: s tring; Dir ection,
  289     InsertAt : Integer) ;
  290   begin
  291     (Sender  as TORComb oBox).ForD ataUse(Sub setOfLocat ions(Start From, Dire ction, FBr oker));
  292   end;
  293  
  294  
  295   // TListVi ew Drawing  Events == ========== ========== ========== ========== =
  296  
  297   // *** IMP ORTANT Not e:  Delphi  10.2.3 ha s a bug in  TListView  *DrawItem  events
  298   //                        The bu g is causi ng style c hanges to  be ignored
  299   //                        See ht tps://qual ity.embarc adero.com/ browse/RSP -20912
  300   //                        Temp S olution:   monkey-pat ch using V cl.ComCtrl s.dcu from  Delphi 10 .2
  301  
  302  
  303   // Drawing  lvwAvail  (should pr obably go  back to a  TreeView)  ---------- -
  304  
  305   procedure  TfrmMockIn strumentSe lect.lvwAv ailCustomD rawItem(Se nder: TCus tomListVie w; Item: T ListItem;
  306     State: T CustomDraw State; var  DefaultDr aw: Boolea n);
  307   begin
  308     // make  the Batter y names bo ld
  309     if (Item .ImageInde x = 4) the n
  310     begin
  311       Sender .Canvas.Fo nt.Style : = [fsBold] ;
  312     end;
  313   end;
  314  
  315   procedure  TfrmMockIn strumentSe lect.lvwAv ailResize( Sender: TO bject);
  316   begin
  317     // don't  show the  horizontal  scroll ba r on the b ottom
  318     ShowScro llBar(lvwA ssignments .Handle, S B_HORZ, fa lse);
  319   end;
  320  
  321   // Drawing  lvwAssign ments ---- ---------- ---------- ---------- ---------- -
  322  
  323   procedure  TfrmMockIn strumentSe lect.lvwAs signmentsC ustomDrawI tem(Sender : TCustomL istView; I tem: TList Item;
  324     State: T CustomDraw State; var  DefaultDr aw: Boolea n);
  325   begin
  326     // Item  is the PIN  for patie nt-entered  or the wo rd "STAFF"  for staff  entered
  327     // show  incomplete  instrumen ts in maro on
  328     Sender.C anvas.Font .Style :=  [fsBold];
  329     if Item. Caption =  TXT_STAFF
  330       then S ender.Canv as.Font.Co lor := clM aroon
  331       else S ender.Canv as.Font.Co lor := clC aptionText ;
  332   end;
  333  
  334   procedure  TfrmMockIn strumentSe lect.lvwAs signmentsC ustomDrawS ubItem(Sen der: TCust omListView ; Item: TL istItem;
  335     SubItem:  Integer;  State: TCu stomDrawSt ate; var D efaultDraw : Boolean) ;
  336   begin
  337     // SubIt em is the  displayTex t of the i ncomplete  instrument  or list o f test
  338     // conta ined in th e assignme nt
  339     Sender.C anvas.Font .Style :=  [];
  340     // stays  bold for  some reaso n unless w e set the  color
  341     if Item. Caption =  TXT_STAFF
  342       then S ender.Canv as.Font.Co lor := clM aroon
  343       else S ender.Canv as.Font.Co lor := clC aptionText ;
  344   end;
  345  
  346   procedure  TfrmMockIn strumentSe lect.lvwAs signmentsR esize(Send er: TObjec t);
  347   begin
  348     // First  column sh ould be pr oper width  for a 5-d igit PIN
  349     lvwAssig nments.Col umns[0].Wi dth := 64;
  350     lvwAssig nments.Col umns[1].Wi dth := lvw Assignment s.Width -  64;
  351     // Hide  the horizo ntal scrol lbar
  352     ShowScro llBar(lvwA ssignments .Handle, S B_HORZ, fa lse);
  353   end;
  354  
  355   // Loading  lvwAvail  and lvwAss ignments = ========== ========== ========== =
  356  
  357   procedure  TfrmMockIn strumentSe lect.Reloa dAvailable ;
  358   var
  359     i: Integ er;
  360     aListIte m: TListIt em;
  361     availIte m: TAvaila bleItem;
  362   begin
  363     // this  load batte ries, inst ruments, i ncomplete  instrument s and assi gnments
  364     FAvailab leList.Loa dList(FDFN , cboOrder edBy.ItemI EN, FBroke r);
  365  
  366     // (lvwA vail shoul d probably  be a Tree View inste ad of List View)
  367     // batte ries & ins truments t o into lvw Avail (or  a TreeView )
  368     // incom plete inst ruments an d assignme nts go int o lvwAssig nments
  369     lvwAvail .Clear;
  370     lvwAssig nments.Cle ar;
  371     for i :=  0 to FAva ilableList .Count - 1  do
  372     begin
  373       availI tem := FAv ailableLis t[i];
  374       if (av ailItem.It emType = I T_INCOMPLE TE) then              // incompl etes
  375       begin
  376         aLis tItem := l vwAssignme nts.Items. Add;
  377         aLis tItem.Capt ion := TXT _STAFF;
  378         aLis tItem.SubI tems.Add(a vailItem.D isplayText );
  379         aLis tItem.Data  := FAvail ableList[i ];
  380       end el se
  381       if (av ailItem.It emType = I T_ASSIGNME NT) then              // assignm ents
  382       begin
  383         aLis tItem := l vwAssignme nts.Items. Add;
  384         aLis tItem.Capt ion := ava ilItem.Ide ntifier;
  385         aLis tItem.SubI tems.Add(a vailItem.D isplayText );
  386         aLis tItem.Data  := FAvail ableList[i ];
  387       end el se                                                     // batteri es, regula r
  388       begin
  389         aLis tItem := l vwAvail.It ems.Add;
  390         aLis tItem.Capt ion := ava ilItem.Dis playText;
  391         aLis tItem.Data  := FAvail ableList[i ];
  392         if a vailItem.I temType =  IT_REGULAR  then aLis tItem.Imag eIndex :=  0;
  393         if a vailItem.I temType =  IT_BATTERY  then aLis tItem.Imag eIndex :=  4;
  394       end;
  395     end;
  396   end;
  397  
  398   // Managin g choosing  of instru ment(s) fo r entry == ========== ========== =====
  399  
  400   // Change  event for  both lvwAv ail and lv wAssignmen ts
  401   procedure  TfrmMockIn strumentSe lect.ListV iewChange( Sender: TO bject; Ite m: TListIt em; Change : TItemCha nge);
  402   begin
  403     if (Chan ge <> ctSt ate) then  Exit;
  404     if Lengt h(Item.Cap tion) = 0  then Exit;   // happe ns on init ial load
  405  
  406     if Item. Checked th en
  407     begin
  408       AddToC hosen(Item .Data);
  409     end else
  410     begin
  411       Remove FromChosen (Item.Data );
  412     end;
  413   end;
  414  
  415   // return  true if th e instrume nt is alre ady in lvw Chosen
  416   function T frmMockIns trumentSel ect.Instru mentIsChos en(const a Name: stri ng): Boole an;
  417   var
  418     i: Integ er;
  419   begin
  420     Result : = false;
  421     for i :=  0 to lvwC hosen.Item s.Count -  1 do
  422     begin
  423       if lvw Chosen.Ite ms[i].Capt ion = aNam e then Res ult := Tru e;
  424     end;
  425   end;
  426  
  427   // add ins trument na me and ass ociated TA vailableIt em object  to lvwChos en
  428   procedure  TfrmMockIn strumentSe lect.AddTo Chosen(anI tem: TAvai lableItem) ;
  429   var
  430     i: Integ er;
  431     aListIte m: TListIt em;
  432   begin
  433     for i :=  0 to anIt em.Instrum ents.Count  - 1 do
  434     begin
  435       if not  Instrumen tIsChosen( anItem.Ins truments[i ]) then
  436       begin
  437         aLis tItem := l vwChosen.I tems.Add;
  438         aLis tItem.Capt ion := anI tem.Instru ments[i];
  439         aLis tItem.Data  := anItem ;
  440       end;
  441     end;
  442     setButto nStatus;
  443   end;
  444  
  445   // remove  any items  in lvwChos en with th e same obj ect as the  unchecked  item
  446   procedure  TfrmMockIn strumentSe lect.Remov eFromChose n(anItem:  TAvailable Item);
  447   var
  448     i: Integ er;
  449   begin
  450     for i :=  lvwChosen .Items.Cou nt - 1 dow nto 0 do
  451     begin
  452       if lvw Chosen.Ite ms[i].Data  = anItem  then lvwCh osen.Items .Delete(i) ;
  453     end;
  454     setButto nStatus;
  455   end;
  456  
  457   // handle  the remove , up, down  buttons = ========== ========== ========== =
  458  
  459   { prevent  items from  being sel ected in b oth lvwAss ignments a nd lvwChos en
  460     at the s ame time s ince the b tnRemove c an act on  either. }
  461  
  462   // enterin g lvwAssig nments, so  make sure  nothing i n lvwChose n is selec ted
  463   procedure  TfrmMockIn strumentSe lect.lvwAs signmentsE nter(Sende r: TObject );
  464   begin
  465     lvwChose n.ItemInde x := -1;
  466   end;
  467  
  468   // enterin g lvwChose n, so make  sure noth ing in lvw Assignment  is select ed
  469   procedure  TfrmMockIn strumentSe lect.lvwCh osenEnter( Sender: TO bject);
  470   begin
  471     lvwAssig nments.Ite mIndex :=  -1;
  472   end;
  473  
  474   // enable/ disable bu ttons base d on what  is selecte d in lvwCh osen, lvwA ssignments
  475   procedure  TfrmMockIn strumentSe lect.setBu ttonStatus ;
  476   begin
  477     btnPatie nt.Enabled  := (lvwCh osen.Items .Count > 0 );
  478     btnStaff .Enabled : = (lvwChos en.Items.C ount > 0);
  479     btnRemov e.Enabled  := (lvwCho sen.ItemIn dex > -1)  or (lvwAss ignments.I temIndex >  -1);
  480     btnUp.En abled := ( lvwChosen. ItemIndex  > -1);
  481     btnDown. Enabled :=  (lvwChose n.ItemInde x > -1);
  482   end;
  483  
  484   procedure  TfrmMockIn strumentSe lect.lvwCh osenChange (Sender: T Object; It em: TListI tem; Chang e: TItemCh ange);
  485   begin
  486     setButto nStatus;
  487   end;
  488  
  489   // Remove  item from  lvwChosen  or lvwAssi gnments -- ---------- ---------- -
  490  
  491   // only on e of the t wo lists ( lvwChosen  or lvwAssi gnments) s hould have  and activ e selectio n
  492   procedure  TfrmMockIn strumentSe lect.btnRe moveClick( Sender: TO bject);
  493   var
  494     i: Integ er;
  495     anItem:  TAvailable Item;
  496     errMsg:  string;
  497   begin
  498     // remov e selected  item from  lvwChosen
  499     if lvwCh osen.ItemI ndex > -1  then
  500     begin
  501       anItem  := TAvail ableItem(l vwChosen.I tems[lvwCh osen.ItemI ndex].Data );
  502       lvwCho sen.Items. Delete(lvw Chosen.Ite mIndex);
  503       Unchec kSourceIfN eeded(anIt em);
  504     end;
  505     // delet e an assig nment or i ncomplete  instrument  from the  server
  506     if lvwAs signments. ItemIndex  > -1 then
  507     begin
  508       anItem  := TAvail ableItem(l vwAssignme nts.Items[ lvwAssignm ents.ItemI ndex].Data );
  509       errMsg  := Delete Assignment (anItem.It emType, an Item.Ident ifier, FBr oker);
  510       if Len gth(errMsg ) > 0 then   // unabl e to delet e, so exit
  511       begin
  512         Mess ageDlg(err Msg, mtErr or, [mbOK] , 0);
  513         Exit ;
  514       end;
  515       lvwAss ignments.I tems.Delet e(lvwAssig nments.Ite mIndex);
  516       for i  := lvwChos en.Items.C ount - 1 d ownto 0 do
  517       begin
  518         if l vwChosen.I tems[i].Da ta = anIte m then lvw Chosen.Ite ms.Delete( i);
  519       end;
  520     end;
  521     setButto nStatus;
  522   end;
  523  
  524   // deselec t from lvw Avail or l vwAssignme nts based  if no long er in chos en list
  525   procedure  TfrmMockIn strumentSe lect.Unche ckSourceIf Needed(anI tem: TAvai lableItem) ;
  526   var
  527     i: Integ er;
  528     aListVie w: TListVi ew;
  529   begin
  530     for i :=  0 to lvwC hosen.Item s.Count -  1 do
  531     begin
  532       if lvw Chosen.Ite ms[i].Data  = anItem  then Exit;   // an ob ject still  chosen, s o exit
  533     end;
  534     // since  there are  no more c hosen test s for this  item, des elect it i n source l istview
  535     if (anIt em.ItemTyp e = IT_ASS IGNMENT) o r (anItem. ItemType =  IT_INCOMP LETE)
  536       then a ListView : = lvwAssig nments
  537       else a ListView : = lvwAvail ;
  538     for i :=  0 to aLis tView.Item s.Count -  1  do
  539     begin
  540       if aLi stView.Ite ms[i].Data  = anItem  then aList View.Items [i].Checke d := false ;
  541     end;
  542   end;
  543  
  544   // handle  moving ite ms in lvwC hosen up o r down the  list ---- ---------- -
  545  
  546   procedure  TfrmMockIn strumentSe lect.btnUp Click(Send er: TObjec t);
  547   begin
  548     MoveChos enItem(-1) ;
  549   end;
  550  
  551   procedure  TfrmMockIn strumentSe lect.btnDo wnClick(Se nder: TObj ect);
  552   begin
  553     MoveChos enItem(2);   // 2 to  jump it be low its im mediate ne ighbor
  554   end;
  555  
  556   procedure  TfrmMockIn strumentSe lect.MoveC hosenItem( offset: In teger);
  557   var
  558     currentI ndex, newP osition: I nteger;
  559     aListIte m: TListIt em;
  560   begin
  561     currentI ndex := lv wChosen.Se lected.Ind ex;
  562     if curre ntIndex <  0 then Exi t;
  563     newPosit ion := cur rentIndex  + offset;
  564     if (newP osition <  0) or (new Position >  lvwChosen .Items.Cou nt) then E xit;
  565  
  566     if (offs et < 0) th en current Index := c urrentInde x + 1;
  567     aListIte m := lvwCh osen.Items .Insert(ne wPosition) ;
  568     aListIte m.Assign(l vwChosen.I tems[curre ntIndex]);
  569     lvwChose n.Items.De lete(curre ntIndex);
  570     lvwChose n.Selected  := aListI tem;
  571     lvwChose n.ItemFocu sed := aLi stItem;
  572   end;
  573  
  574   // handle  staff-entr y and pati ent-entry  buttons == ========== ========== =
  575  
  576   // create  patient-en try assign ment, show  the PIN,  and refres h the scre en
  577   procedure  TfrmMockIn strumentSe lect.btnPa tientClick (Sender: T Object);
  578   var
  579     pin: str ing;
  580   begin
  581     if not V alidAssign ment then  Exit;
  582  
  583     pin := S aveAssignm ent('patie nt');
  584     frmSetNu mber.SetNu mber(pin);
  585     frmSetNu mber.ShowM odal;
  586     ReloadAv ailable;
  587   end;
  588  
  589   // create  assignment  and activ ate web-ba sed instru ment entry
  590   procedure  TfrmMockIn strumentSe lect.btnSt affClick(S ender: TOb ject);
  591   var
  592     pin: str ing;
  593     brLeft,  brTop, brW idth, brHe ight: Inte ger;
  594   begin
  595     if not V alidAssign ment then  Exit;
  596  
  597     pin := S aveAssignm ent('staff ');
  598     LoadBoun ds(brLeft,  brTop,brW idth, brHe ight);
  599     frmWebBr owser.OnBr owserActio n := Close Browser;
  600     frmWebBr owser.SetB ounds(brLe ft, brTop,  brWidth,  brHeight);
  601     //Self.H ide;
  602     frmWebBr owser.AppP ath := FWe bAppPath;
  603     frmWebBr owser.AppP age := 'in dex.html?a ssignment= ' + pin; / / + '&divi sion=' + F Station;
  604     frmWebBr owser.Run( 'YS_MHA_In strumentAd min_1', 'Y TQREST MHA ', FBroker );
  605   end;
  606  
  607   procedure  TfrmMockIn strumentSe lect.Close Browser(Se nder: TObj ect);
  608   begin
  609     SaveBoun ds(frmWebB rowser.Lef t, frmWebB rowser.Top , frmWebBr owser.Widt h, frmWebB rowser.Hei ght);
  610     ReloadAv ailable;
  611     //Self.S how;
  612   end;
  613  
  614  
  615   // check f or missing  required  fields bef ore creati ng assignm ent
  616   function T frmMockIns trumentSel ect.ValidA ssignment:  Boolean;
  617   var
  618     msg: str ing;
  619   begin
  620     msg := ' ';
  621     if cboOr deredBy.It emIEN < 1  then msg : = msg + '  Ordered By ';
  622     if cboIn terviewer. ItemIEN <  1 then msg  := msg +  ' Intervie wer';
  623     if cboLo cation.Ite mIEN < 1 t hen msg :=  msg + ' L ocation';
  624     if Lengt h(msg) > 0  then
  625     begin
  626       msg :=  'Missing  Required F ields: ' +  msg;
  627       Messag eDlg(msg,  mtError, [ mbOK], 0);
  628     end;
  629     Result : = Length(m sg) = 0;
  630   end;
  631  
  632   // create  assignment  object an d POST it  to VistA
  633   function T frmMockIns trumentSel ect.SaveAs signment(c onst anEnt ryMode: st ring): str ing;
  634   var
  635     assignme nt: TMHAAs signment;
  636     replacin g: string;
  637     anItem:  TAvailable Item;
  638     i: Integ er;
  639   begin
  640     assignme nt := TMHA Assignment .Create;
  641     assignme nt.Broker  := FBroker ;
  642     assignme nt.DFN :=  FDFN;
  643     assignme nt.Ordered By := cboO rderedBy.I temIEN;
  644     assignme nt.Intervi ewer := cb oInterview er.ItemIEN ;
  645     assignme nt.Locatio n := cboLo cation.Ite mIEN;
  646     assignme nt.AdminDa te := '3'  + FormatDa teTime('yy mmdd.hhmms s', dtmAdm in.DateTim e);
  647     if cboCo nsult.Item IEN > 0 th en assignm ent.Consul t := cboCo nsult.Item IEN;
  648     assignme nt.EntryMo de := anEn tryMode;
  649     if radAl lQuestions .Checked =  True
  650       then a ssignment. QuestionMo de := 'all '
  651       else a ssignment. QuestionMo de := 'one ';
  652     for i :=  0 to lvwC hosen.Item s.Count -  1 do
  653     begin
  654       anItem  := TAvail ableItem(l vwChosen.I tems[i].Da ta);
  655       if (an Item.ItemT ype = IT_A SSIGNMENT)
  656         then  replacing  := anItem .Identifie r
  657         else  replacing  := '';
  658       if (an Item.ItemT ype = IT_I NCOMPLETE)
  659         then  assignmen t.AddIncom pleteAdmin (anItem.In struments[ 0], anItem .Identifie r)
  660         else  assignmen t.AddNewIn strument(l vwChosen.I tems[i].Ca ption, rep lacing);
  661     end;
  662     lvwChose n.Items.Cl ear;
  663     Result : = assignme nt.PostAss ignment;
  664     assignme nt.Free;
  665   end;
  666  
  667   // miscell aneous uti lities === ========== ========== ========== ========== =
  668  
  669   // parse c ommand-lin e paramete r (may use  first let ter or ful l name)
  670   // uses Co mpareText  so that th e paramete rs are not  case sens itive
  671   function T frmMockIns trumentSel ect.Extrac tParam(con st paramNa me: string ): string;
  672   var
  673     x, y: st ring;
  674     i: Integ er;
  675   begin
  676     Result : = '';
  677     for i :=  1 to Para mCount do
  678     begin
  679       x := L eftStr(Par amStr(i),  Pos('=', P aramStr(i) )-1);
  680       y := C opy(ParamS tr(i), Pos ('=', Para mStr(i))+1 , Length(P aramStr(i) ));
  681       if (Co mpareText( paramName[ 1], x)=0)  or (Compar eText(para mName, x)= 0) then Re sult := y;
  682     end;
  683   end;
  684  
  685   procedure  TfrmMockIn strumentSe lect.SaveB ounds(theL eft, theTo p, theWidt h, theHeig ht: Intege r);
  686   var
  687     thisMoni tor: TMoni tor;
  688     monitorN um: Intege r;
  689     savedPos ition: str ing;
  690   begin
  691     thisMoni tor := Scr een.Monito rFromWindo w(Self.Han dle);
  692     monitorN um := this Monitor.Mo nitorNum;
  693     savedPos ition := I ntToStr(th eLeft) + ' ;' + IntTo Str(theTop ) + ';' +
  694                       I ntToStr(th eWidth) +  ';' + IntT oStr(theHe ight);
  695     WriteReg istry(KEY_ BROWSER_FO RM + IntTo Str(monito rNum), sav edPosition );
  696   end;
  697  
  698   procedure  TfrmMockIn strumentSe lect.LoadB ounds(var  theLeft, t heTop, the Width, the Height: In teger);
  699   var
  700     thisMoni tor: TMoni tor;
  701     monitorN um: Intege r;
  702     savedPos ition: str ing;
  703   begin
  704     thisMoni tor := Scr een.Monito rFromWindo w(Self.Han dle);
  705     monitorN um := this Monitor.Mo nitorNum;
  706     // load  any previo us positio n informat ion from t he registr y for this  monitor
  707     savedPos ition := R eadRegistr y(KEY_BROW SER_FORM +  IntToStr( monitorNum ));
  708     theLeft  := StrToIn tDef(Piece (savedPosi tion, ';', 1), Self.L eft);
  709     theTop : = StrToInt Def(Piece( savedPosit ion, ';',  2), Self.T op);
  710     theWidth  := StrToI ntDef(Piec e(savedPos ition, ';' , 3), 1024 );
  711     theHeigh t := StrTo IntDef(Pie ce(savedPo sition, '; ', 4), 768 );
  712     // fit t he form in side the b ounds of t he monitor
  713     if (theT op + theHe ight > thi sMonitor.H eight) the n
  714     begin
  715       theTop  := thisMo nitor.Heig ht - theHe ight;
  716       if (th eTop < 0)  then
  717       begin
  718         theT op := 0;
  719         theH eight := t hisMonitor .Height;
  720       end;
  721     end;
  722     if (theL eft + theW idth > thi sMonitor.W idth) then
  723     begin
  724       theLef t := thisM onitor.Wid th - theWi dth;
  725       if (th eLeft < 0)  then
  726       begin
  727         theL eft := 0;
  728         theW idth := th isMonitor. Width;
  729       end;
  730     end;
  731   end;
  732  
  733   // read fr om the reg istry whic h has thin gs like La stLocation  & ShowAll OrOneItem
  734   function T frmMockIns trumentSel ect.ReadRe gistry(key Name: stri ng): strin g;
  735   var
  736     reg: TRe gistry;
  737   begin
  738     Result : = '';
  739     reg := T Registry.C reate;
  740     reg.Root Key := HKE Y_CURRENT_ USER; // b etter for  Thin clien t applicat ions
  741     if (reg. KeyExists( 'SOFTWARE\ VISTA\YS\M HA3\')) th en
  742     begin
  743       if reg .OpenKey(' SOFTWARE\V ISTA\YS\MH A3\', True ) then Res ult := reg .ReadStrin g(keyName) ;
  744       reg.Cl oseKey;
  745     end;
  746     reg.Free ;
  747   end;
  748  
  749   procedure  TfrmMockIn strumentSe lect.Write Registry(c onst keyNa me, value:  string);
  750   var
  751     reg: TRe gistry;
  752   begin
  753     reg := T Registry.C reate;
  754     reg.Root Key := HKE Y_CURRENT_ USER; // b etter for  Thin clien t applicat ions
  755     if reg.O penKey('SO FTWARE\VIS TA\YS\MHA3 \', True)  then reg.W riteString (keyName,  value);
  756     reg.Clos eKey;
  757     reg.Free ;
  758   end;
  759  
  760   procedure  TfrmMockIn strumentSe lect.SetBr owserMode;
  761   const
  762     // see h ttps://web log.west-w ind.com/po sts/2011/M ay/21/Web- Browser-Co ntrol-Spec ifying-the -IE-Versio n
  763     //BROWSE R_KEY = 'S oftware\Mi crosoft\In ternet Exp lorer\Main \FeatureCo ntrol\FEAT URE_BROWSE R_EMULATIO N';  // Wi n64 Apps
  764     BROWSER_ KEY = 'SOF TWARE\WOW6 432Node\Mi crosoft\In ternet Exp lorer\Main \FeatureCo ntrol\FEAT URE_BROWSE R_EMULATIO N';
  765     IE11 = 1 1001;   //  for IE11
  766   var
  767     reg: TRe gistry;
  768     appName:  string;
  769   begin
  770     appName  := Extract FileName(A pplication .ExeName);
  771     reg := T Registry.C reate;
  772     try
  773       reg.Ro otKey := H KEY_CURREN T_USER;
  774       if reg .OpenKey(B ROWSER_KEY , True) th en reg.Wri teInteger( appName, I E11);
  775       reg.Cl oseKey;
  776     finally
  777       reg.Fr ee;
  778     end;
  779   end;
  780  
  781   procedure  TfrmMockIn strumentSe lect.LoadW ebApp;
  782   var
  783     webLoade r: TWebLoa der;
  784     pageList : TStringL ist;
  785   begin
  786     webLoade r := TWebL oader.Crea te;
  787     FWebAppP ath := web Loader.Ful lPath;
  788     if Lengt h(FWebAppP ath) = 0 t hen
  789     begin
  790       ShowMe ssage('Una ble to loa d web appl ication fi les.');
  791       Exit;
  792     end;
  793  
  794     if not w ebLoader.W ebAppCurre nt(APP_VER SION) then
  795     begin
  796       pageLi st := TStr ingList.Cr eate;
  797       pageLi st.Add('1= asset-mani fest.json' );
  798       pageLi st.Add('2= favicon.ic o');
  799       pageLi st.Add('3= index.html ');
  800       pageLi st.Add('4= manifest.j son');
  801       pageLi st.Add('5= service-wo rker.js');
  802       pageLi st.Add('10 =images\ic ons8-sort- left-fille d-50.png') ;
  803       pageLi st.Add('11 =images\ic ons8-sort- right-fill ed-50.png' );
  804       pageLi st.Add('12 =images\Su bmited.png ');
  805       pageLi st.Add('13 =images\VA _Logo.png' );
  806       pageLi st.Add('21 =static\cs s\main.686 34ea7.css' );
  807       pageLi st.Add('22 =static\cs s\main.686 34ea7.css. map');
  808       pageLi st.Add('31 =static\js \main.a5cd 3f2e.js');
  809       pageLi st.Add('32 =static\js \main.a5cd 3f2e.js.ma p');
  810       pageLi st.Add('40 =static\me dia\VA_Log o.2411c778 .png');
  811       pageLi st.Add('41 =static\me dia\glyphi cons-halfl ings-regul ar.1ef6c11 3.eot');
  812       pageLi st.Add('42 =static\me dia\glyphi cons-halfl ings-regul ar.5c63672 b.woff');
  813       pageLi st.Add('43 =static\me dia\glyphi cons-halfl ings-regul ar.276004c 6.svg');
  814       pageLi st.Add('44 =static\me dia\glyphi cons-halfl ings-regul ar.a9e38d9 c.woff2');
  815       pageLi st.Add('45 =static\me dia\glyphi cons-halfl ings-regul ar.c7cbacd 5.ttf');
  816       pageLi st.Add('46 =static\me dia\lock.5 57fc931.sv g');
  817       pageLi st.Add('47 =static\me dia\user.4 43c3353.sv g');
  818       pageLi st.Add('51 =static_cs s\print.cs s');
  819       webLoa der.SetupW ebAppFromR esource(pa geList);
  820       pageLi st.Free;
  821     end;
  822  
  823   end;
  824  
  825   end.