6. EPMO Open Source Coordination Office Redaction File Detail Report

Produced by Araxis Merge on 2/17/2017 12:43:22 PM Central Standard 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.

6.1 Files compared

# Location File Last Modified
1 CPRS_V32_T20_cif.zip\OR_30_405V20_SRC.zip\CPRS-chart\Cover Sheet mCoverSheetDisplayPanel_CPRS.pas Thu Dec 15 14:28:30 2016 UTC
2 CPRS_V32_T20_cif.zip\OR_30_405V20_SRC.zip\CPRS-chart\Cover Sheet mCoverSheetDisplayPanel_CPRS.pas Fri Feb 17 17:19:00 2017 UTC

6.2 Comparison summary

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

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

6.4 Active regular expressions

No regular expressions were active.

6.5 Comparison detail

  1   unit mCove rSheetDisp layPanel_C PRS;
  2   {
  3     ======== ========== ========== ========== ========== ========== ========== ========== ==
  4     *
  5     *        Applicatio n:  CPRS -  CoverShee t
  6       *         Developer:       PII                   
  7     *        Site:          Salt L ake City I SC
  8     *        Date:          2015-1 2-04
  9     *
  10     *        Descriptio n:  Inheri ted from T fraCoverSh eetDisplay Panel. Thi s display
  11     *                       panel  provides t he minimum  functiona lity for d isplaying
  12     *                       CPRS d ata in the  CoverShee t.
  13     *
  14     *        Notes:         This f rame is an  ancestor  object and  heavily i nherited f rom.
  15     *                       ABSOLU TELY NO CH ANGES SHOU LD BE MADE  WITHOUT F IRST
  16     *                       CONFER RING WITH  THE CPRS D EVELOPMENT  TEAM ABOU T POSSIBLE
  17     *                       RAMIFI CATIONS WI TH DESCEND ANT FRAMES .
  18     *
  19     ======== ========== ========== ========== ========== ========== ========== ========== ==
  20   }
  21  
  22   interface
  23  
  24   uses
  25     Winapi.W indows,
  26     Winapi.M essages,
  27     System.S ysUtils,
  28     System.V ariants,
  29     System.C lasses,
  30     System.U ITypes,
  31     Vcl.Grap hics,
  32     Vcl.Cont rols,
  33     Vcl.Form s,
  34     Vcl.Dial ogs,
  35     Vcl.Menu s,
  36     Vcl.ImgL ist,
  37     Vcl.StdC trls,
  38     Vcl.Butt ons,
  39     Vcl.ExtC trls,
  40     Vcl.ComC trls,
  41     mCoverSh eetDisplay Panel,
  42     iCoverSh eetIntf,
  43     iGridPan elIntf,
  44     oDelimit edString,
  45     mGridPan elFrame;
  46  
  47   type
  48     TfraCove rSheetDisp layPanel_C PRS = clas s(TfraCove rSheetDisp layPanel,  ICoverShee tDisplayPa nel)
  49       tmr: T Timer;
  50       lvData : TListVie w;
  51       proced ure lvData Enter(Send er: TObjec t);
  52       proced ure lvData Exit(Sende r: TObject );
  53       proced ure lvData MouseDown( Sender: TO bject; But ton: TMous eButton; S hift: TShi ftState; X , Y: integ er);
  54       proced ure lvData SelectItem (Sender: T Object; It em: TListI tem; Selec ted: boole an);
  55       proced ure tmrTim er(Sender:  TObject);
  56     private
  57       { Priv ate declar ations }
  58     protecte d
  59       fBackg roundLoadi ng: boolea n;
  60       fBackg roundLoadT ry: intege r;
  61       fFinis hed: boole an;
  62       fColum ns: TStrin gList;
  63       fLastI temIndex:  integer;
  64       fAllow DetailDisp lay: boole an;
  65  
  66       { Over ridden eve nts - Tfra GridPanelF rame }
  67       proced ure OnSetF ontSize(Se nder: TObj ect; aNewS ize: integ er); overr ide;
  68       proced ure OnPopu pMenu(Send er: TObjec t); overri de;
  69       proced ure OnPopu pMenuInit( Sender: TO bject); ov erride;
  70       proced ure OnRefr eshDisplay (Sender: T Object); o verride;
  71  
  72       { Over ridden eve nts - Tfra CoverSheet DisplayPan el }
  73       proced ure OnBegi nUpdate(Se nder: TObj ect); over ride;
  74       proced ure OnClea rPtData(Se nder: TObj ect); over ride;
  75       proced ure OnEndU pdate(Send er: TObjec t); overri de;
  76  
  77       { Over ridden met hods - Tfr aCoverShee tDisplayPa nel }
  78       functi on getIsFi nishedLoad ing: boole an; overri de;
  79  
  80       { Intr oduced eve nts }
  81       proced ure OnAddI tems(aList : TStrings ); virtual ;
  82       proced ure OnGetD etail(aRec : TDelimit edString;  aResult: T Strings);  virtual;
  83       proced ure OnShow Detail(aTe xt: TStrin gs; aTitle : string =  ''; aPrin table: boo lean = fal se); virtu al;
  84  
  85       { Intr oduced met hods }
  86       functi on AddColu mn(aIndex:  integer;  aCaption:  string): i nteger; vi rtual; fin al;
  87       functi on ClearLi stView(aLi stView: TL istView):  boolean; v irtual;
  88       functi on Collaps eColumns:  integer; v irtual; fi nal;
  89       functi on ExpandC olumns: in teger; vir tual; fina l;
  90       functi on ListVie wItemIEN:  integer; v irtual;
  91       functi on ListVie wItemRec:  TDelimited String; vi rtual;
  92       functi on CPRSPar ams: ICove rSheetPara m_CPRS; vi rtual; fin al;
  93  
  94       proced ure SetLis tViewColum n(aIndex:  integer; a Caption: s tring; aAu toSize: bo olean; aWi dth: integ er); virtu al;
  95     public
  96       constr uctor Crea te(aOwner:  TComponen t); overri de;
  97       destru ctor Destr oy; overri de;
  98     end;
  99  
  100   var
  101     fraCover SheetDispl ayPanel_CP RS: TfraCo verSheetDi splayPanel _CPRS;
  102  
  103   implementa tion
  104  
  105   {$R *.dfm}
  106  
  107   { fraCover SheetDispl ayPanel_CP RS }
  108  
  109   uses
  110     uCore,
  111     uConst,
  112     fRptBox,
  113     DateUtil s,
  114     ORNet;
  115  
  116   const
  117     UPDATING _FOREGROUN D = 'Updat ing ...';
  118     UPDATING _BACKGROUN D = 'Loadi ng in Back ground ..' ;
  119     UPDATING _FAILURE =  'Update f ailed.';
  120     UPDATING _ATTEMPTS  = 10; // M ax try to  get data f rom backgr ound job
  121     UPDATING _WAIT_TIME  = 3000; / / millisec onds
  122  
  123   constructo r TfraCove rSheetDisp layPanel_C PRS.Create (aOwner: T Component) ;
  124   begin
  125     inherite d Create(a Owner);
  126     with lvD ata do
  127       begin
  128         Show ColumnHead ers := fal se;
  129         View Style := v sReport;
  130         read only := Tr ue;
  131         RowS elect := T rue;
  132         Colu mns.Add.Au toSize :=  True;
  133       end;
  134  
  135     fColumns  := TStrin gList.Crea te;
  136     fLastIte mIndex :=  -1;
  137     fAllowDe tailDispla y := True;
  138   end;
  139  
  140   destructor  TfraCover SheetDispl ayPanel_CP RS.Destroy ;
  141   begin
  142     ClearLis tView(lvDa ta);
  143     FreeAndN il(fColumn s);
  144     inherite d;
  145   end;
  146  
  147   function T fraCoverSh eetDisplay Panel_CPRS .ClearList View(aList View: TLis tView): bo olean;
  148   begin
  149     aListVie w.Items.Be ginUpdate;
  150     try
  151       while  aListView. Items.Coun t > 0 do
  152         begi n
  153           if  aListView .Items[0]. Data <> ni l then
  154              try
  155                TObject( aListView. Items[0].D ata).Free;
  156              finally
  157                aListVie w.Items[0] .Data := n il;
  158              end;
  159           aL istView.It ems.Delete (0);
  160         end;
  161       aListV iew.Items. EndUpdate;
  162       fLastI temIndex : = -1;
  163       Result  := True;
  164     except
  165       Result  := false;
  166     end;
  167   end;
  168  
  169   procedure  TfraCoverS heetDispla yPanel_CPR S.OnClearP tData(Send er: TObjec t);
  170   begin
  171     ClearLis tView(lvDa ta);
  172   end;
  173  
  174   function T fraCoverSh eetDisplay Panel_CPRS .CollapseC olumns: in teger;
  175   begin
  176     try
  177       lvData .Columns.B eginUpdate ;
  178       lvData .Columns.C lear;
  179       if fCo lumns.Coun t = 0 then
  180         with  lvData.Co lumns.Add  do
  181           be gin
  182              Caption :=  '';
  183              AutoSize : = True;
  184              Width := l vData.Clie ntWidth;
  185              lvData.Sho wColumnHea ders := fa lse;
  186           en d
  187       else
  188         with  lvData.Co lumns.Add  do
  189           be gin
  190              Caption :=  fColumns[ 0];
  191              AutoSize : = True;
  192              Width := l vData.Clie ntWidth;
  193              lvData.Sho wColumnHea ders := Tr ue;
  194           en d;
  195  
  196     finally
  197       lvData .Columns.E ndUpdate;
  198     end;
  199  
  200     Result : = lvData.C olumns.Cou nt;
  201   end;
  202  
  203   function T fraCoverSh eetDisplay Panel_CPRS .CPRSParam s: ICoverS heetParam_ CPRS;
  204   begin
  205     // Suppo rts(fParam , ICoverSh eetParam_C PRS, Resul t);
  206     getParam .QueryInte rface(ICov erSheetPar am_CPRS, R esult);
  207   end;
  208  
  209   function T fraCoverSh eetDisplay Panel_CPRS .AddColumn (aIndex: i nteger; aC aption: st ring): int eger;
  210   begin
  211     while fC olumns.Cou nt < (aInd ex + 1) do
  212       fColum ns.Add('') ;
  213     fColumns [aIndex] : = aCaption ;
  214     Result : = fColumns .Count;
  215   end;
  216  
  217   procedure  TfraCoverS heetDispla yPanel_CPR S.OnAddIte ms(aList:  TStrings);
  218   var
  219     aRec: TD elimitedSt ring;
  220     aStr: st ring;
  221   begin
  222     if aList .Count = 0  then
  223       aList. Add('^No d ata found. ^');
  224  
  225     for aStr  in aList  do
  226       with l vData.Item s.Add do
  227         begi n
  228           aR ec := TDel imitedStri ng.Create( aStr);
  229           Ca ption := a Rec.GetPie ce(2);
  230           Da ta := aRec ;
  231         end;
  232   end;
  233  
  234   procedure  TfraCoverS heetDispla yPanel_CPR S.OnBeginU pdate(Send er: TObjec t);
  235   begin
  236     ClearLis tView(lvDa ta);
  237     Collapse Columns;
  238  
  239     if CPRSP arams.High lightText  then
  240       begin
  241         lvDa ta.Font.Co lor := clH ighlight;
  242         lvDa ta.Font.St yle := [fs Bold];
  243       end;
  244  
  245     with lvD ata.Items. Add do
  246       if CPR SParams.Lo adInBackgr ound then
  247         Capt ion := UPD ATING_BACK GROUND
  248       else
  249         Capt ion := UPD ATING_FORE GROUND;
  250  
  251     lvData.R epaint;
  252     fFinishe d := false ;
  253   end;
  254  
  255   procedure  TfraCoverS heetDispla yPanel_CPR S.OnEndUpd ate(Sender : TObject) ;
  256   begin
  257     fFinishe d := True;
  258   end;
  259  
  260   function T fraCoverSh eetDisplay Panel_CPRS .ExpandCol umns: inte ger;
  261   var
  262     aStr: st ring;
  263   begin
  264     try
  265       lvData .Columns.B eginUpdate ;
  266       lvData .Columns.C lear;
  267       if fCo lumns.Coun t = 0 then
  268         with  lvData.Co lumns.Add  do
  269           be gin
  270              Caption :=  '';
  271              AutoSize : = True;
  272              Width := l vData.Clie ntWidth;
  273              lvData.Sho wColumnHea ders := fa lse;
  274           en d
  275       else
  276         for  aStr in fC olumns do
  277           wi th lvData. Columns.Ad d do
  278              begin
  279                Caption  := aStr;
  280                AutoSize  := True;
  281                Width :=  lvData.Cl ientWidth  div fColum ns.Count;
  282                lvData.S howColumnH eaders :=  True;
  283              end;
  284  
  285     finally
  286       lvData .Columns.E ndUpdate;
  287     end;
  288     Result : = lvData.C olumns.Cou nt;
  289   end;
  290  
  291   function T fraCoverSh eetDisplay Panel_CPRS .getIsFini shedLoadin g: boolean ;
  292   begin
  293     Result : = fFinishe d and (not  tmr.Enabl ed)
  294   end;
  295  
  296   procedure  TfraCoverS heetDispla yPanel_CPR S.OnGetDet ail(aRec:  TDelimited String; aR esult: TSt rings);
  297   begin
  298     try
  299       CallVi stA(CPRSPa rams.Detai lRPC, [Pat ient.DFN,  aRec.GetPi ece(1)], a Result);
  300     except
  301       on E:  Exception  do
  302         Show Message('D efault Det ail Failed . ' + E.Me ssage);
  303     end;
  304   end;
  305  
  306   function T fraCoverSh eetDisplay Panel_CPRS .ListViewI temIEN: in teger;
  307   begin
  308     if lvDat a.Selected  <> nil th en
  309       if lvD ata.Select ed.Data <>  nil then
  310         Resu lt := TDel imitedStri ng(lvData. Selected.D ata).GetPi eceAsInteg er(1)
  311       else
  312         Resu lt := -1
  313     else
  314       Result  := -1;
  315   end;
  316  
  317   function T fraCoverSh eetDisplay Panel_CPRS .ListViewI temRec: TD elimitedSt ring;
  318   begin
  319     if lvDat a.Selected  <> nil th en
  320       if lvD ata.Select ed.Data <>  nil then
  321         Resu lt := TDel imitedStri ng(lvData. Selected.D ata)
  322       else
  323         Resu lt := nil
  324     else
  325       Result  := nil;
  326   end;
  327  
  328   procedure  TfraCoverS heetDispla yPanel_CPR S.lvDataEn ter(Sender : TObject) ;
  329   begin
  330     if (fLas tItemIndex  > -1) and  (lvData.I tems.Count  > fLastIt emIndex) t hen
  331       begin
  332         lvDa ta.Items[f LastItemIn dex].Selec ted := Tru e;
  333         lvDa ta.Items[f LastItemIn dex].Focus ed := True ;
  334       end
  335     else if  lvData.Ite ms.Count >  0 then
  336       begin
  337         lvDa ta.Items[0 ].Selected  := True;
  338         lvDa ta.Items[0 ].Focused  := True;
  339       end;
  340   end;
  341  
  342   procedure  TfraCoverS heetDispla yPanel_CPR S.lvDataEx it(Sender:  TObject);
  343   begin
  344     lvData.S elected :=  nil;
  345   end;
  346  
  347   procedure  TfraCoverS heetDispla yPanel_CPR S.lvDataMo useDown(Se nder: TObj ect; Butto n: TMouseB utton; Shi ft: TShift State; X,  Y: integer );
  348   var
  349     aDetail:  TStringLi st;
  350     aItem: T ListItem;
  351   begin
  352     if fAllo wDetailDis play then
  353       begin
  354         aIte m := lvDat a.GetItemA t(X, Y);
  355         if a Item <> ni l then
  356           be gin
  357              fLastItemI ndex := aI tem.Index;
  358              if (Button  = mbLeft)  and (aIte m.Data <>  nil) then
  359                if TDeli mitedStrin g(aItem.Da ta).GetPie ce(1) <> ' ' then
  360                  try
  361                    aDet ail := TSt ringList.C reate;
  362                    OnGe tDetail(TD elimitedSt ring(aItem .Data), aD etail);
  363                    OnSh owDetail(a Detail);
  364                  finall y
  365                    Free AndNil(aDe tail);
  366                  end;
  367              { Make it  look like  we never l ost focus  :-) }
  368              aItem.Sele cted := Tr ue;
  369              aItem.Focu sed := Tru e;
  370              lvData.Set Focus;
  371           en d
  372         else
  373           lv DataEnter( Sender);
  374       end;
  375   end;
  376  
  377   procedure  TfraCoverS heetDispla yPanel_CPR S.lvDataSe lectItem(S ender: TOb ject; Item : TListIte m; Selecte d: boolean );
  378   begin
  379     if Selec ted then
  380       fLastI temIndex : = Item.Ind ex;
  381   end;
  382  
  383   procedure  TfraCoverS heetDispla yPanel_CPR S.OnPopupM enu(Sender : TObject) ;
  384   begin
  385     inherite d;
  386     pmnRefre sh.Enabled  := (Patie nt.DFN <>  '');
  387   end;
  388  
  389   procedure  TfraCoverS heetDispla yPanel_CPR S.OnPopupM enuInit(Se nder: TObj ect);
  390   begin
  391     inherite d;
  392     pmnRefre sh.Visible  := True;
  393     pmnRefre sh.Enabled  := True;
  394   end;
  395  
  396   procedure  TfraCoverS heetDispla yPanel_CPR S.OnRefres hDisplay(S ender: TOb ject);
  397   var
  398     aRet: TS tringList;
  399   begin
  400     inherite d;
  401  
  402     ClearLis tView(lvDa ta);
  403  
  404     if Patie nt.DFN = ' ' then
  405       begin
  406         lvDa ta.Items.A dd.Caption  := 'No Pa tient Sele cted.';
  407         lvDa ta.Repaint ;
  408         Exit ;
  409       end;
  410  
  411     if CPRSP arams.Load InBackgrou nd then
  412       begin
  413         fBac kgroundLoa dTry := 0;
  414         fBac kgroundLoa ding := Tr ue;
  415         tmrT imer(nil);  // Start  up the tim er!
  416         CPRS Params.Loa dInBackgro und := fal se; // Onl y loads ba ckground w hen the co versheet s ays so.
  417         Exit ;
  418       end;
  419  
  420     try
  421       try
  422         OnBe ginUpdate( Sender);
  423  
  424         aRet  := TStrin gList.Crea te;
  425  
  426         { to do - move  these call s into a G etList met hod that c an then be  overridde n by the i nheritors  }
  427         // G etList(aRe t); Every  inheritor  will have  the params  and acces s to Patie nt.DFN
  428         if C PRSParams. Param1 <>  '' then
  429           Ca llVistA(CP RSParams.M ainRPC, [P atient.DFN , CPRSPara ms.Param1] , aRet)
  430         else
  431           Ca llVistA(CP RSParams.M ainRPC, [P atient.DFN ], aRet);
  432         Clea rListView( lvData); / / Must be  recleared  to flush a nything fr om the OnB eginUpdate  messages.
  433         OnAd dItems(aRe t);
  434       finall y
  435         OnEn dUpdate(Se nder);
  436         Free AndNil(aRe t);
  437       end;
  438     except
  439       on E:  Exception  do
  440         begi n
  441           {  TODO 5 -oD anP -cThin gs Yet Und one : Chan ge this so  that it s hows there  was an er ror and th en make th e error av ailable wh en the use r clicks o n the mess age. }
  442           lv Data.Items .Clear;
  443           wi th lvData. Items.Add  do
  444              Caption :=  E.Message ;
  445           lv Data.Enabl ed := fals e;
  446         end;
  447     end;
  448   end;
  449  
  450   procedure  TfraCoverS heetDispla yPanel_CPR S.OnSetFon tSize(Send er: TObjec t; aNewSiz e: integer );
  451   begin
  452     inherite d;
  453     lvData.F ont.Size : = aNewSize ;
  454   end;
  455  
  456   procedure  TfraCoverS heetDispla yPanel_CPR S.SetListV iewColumn( aIndex: in teger; aCa ption: str ing; aAuto Size: bool ean; aWidt h: integer );
  457   begin
  458     while lv Data.Colum ns.Count <  (aIndex +  1) do
  459       lvData .Columns.A dd;
  460  
  461     lvData.S howColumnH eaders :=  True;
  462  
  463     with lvD ata.Column s[aIndex]  do
  464       begin
  465         Capt ion := aCa ption;
  466         Auto Size := aA utoSize;
  467         Widt h := aWidt h;
  468       end;
  469     lvData.C olumnClick  := false;  // This i s a defaul t on setup . If setti ng up a so rt, enable  it.
  470   end;
  471  
  472   procedure  TfraCoverS heetDispla yPanel_CPR S.OnShowDe tail(aText : TStrings ; aTitle:  string = ' '; aPrinta ble: boole an = false );
  473   begin
  474     if aTitl e = '' the n
  475       aTitle  := getTit le + ' Ite m Detail:  ' + lvData .Selected. Caption;
  476     ReportBo x(aText, a Title, aPr intable);
  477   end;
  478  
  479   procedure  TfraCoverS heetDispla yPanel_CPR S.tmrTimer (Sender: T Object);
  480   var
  481     aLst: TS tringList;
  482     aParam:  ICoverShee tParam_CPR S;
  483     i: integ er;
  484   begin
  485     tmr.Inte rval := UP DATING_WAI T_TIME;
  486     tmr.Enab led := fBa ckgroundLo ading;
  487  
  488     ClearLis tView(lvDa ta);
  489  
  490     if not t mr.Enabled  then
  491       begin
  492         lvDa ta.Items.A dd.Caption  := 'Exit,  not enabl ed';
  493         Exit ;
  494       end;
  495  
  496     // if no t Supports (fParam, I CoverSheet Param_CPRS , aParam)  then
  497     if getPa ram.QueryI nterface(I CoverSheet Param_CPRS , aParam)  <> 0 then
  498       begin
  499         lvDa ta.Items.A dd.Caption  := 'Inval id param s et for dis play.';
  500         tmr. Enabled :=  false;
  501         Exit ;
  502       end
  503     else if  aParam.Pol lingID = ' ' then
  504       begin
  505         lvDa ta.Items.A dd.Caption  := 'Inval id Polling ID in para m set.';
  506         tmr. Enabled :=  false;
  507         Exit ;
  508       end;
  509  
  510     // Do th e call her e and dete rmine if w e can load  anything
  511     try
  512       aLst : = TStringL ist.Create ;
  513       CallVi stA('ORWCV  POLL', [P atient.DFN , CoverShe et.IPAddre ss, CoverS heet.Uniqu eID, aPara m.PollingI D], aLst);
  514       if aLs t.Count >  0 then
  515         begi n
  516           fo r i := aLs t.Count -  1 downto 0  do
  517              begin
  518                if Copy( aLst[i], 1 , 1) = '~'  then
  519                  aLst.D elete(i)
  520                else if  Copy(aLst[ i], 1, 1)  = 'i' then
  521                  aLst[i ] := Copy( aLst[i], 2 , Length(a Lst[i]));
  522              end;
  523  
  524           Cl earListVie w(lvData);
  525  
  526           On AddItems(a Lst);
  527           tm r.Enabled  := false;
  528           Ex it;
  529         end;
  530     finally
  531       FreeAn dNil(aLst) ;
  532     end;
  533  
  534     inc(fBac kgroundLoa dTry);
  535     fBackgro undLoading  := (fBack groundLoad Try <= UPD ATING_ATTE MPTS);
  536  
  537     with lvD ata.Items  do
  538       begin
  539         if f Background Loading th en
  540           Ad d.Caption  := Format( UPDATING_B ACKGROUND  + '%s', [C opy('..... .....', 1,  fBackgrou ndLoadTry) ])
  541         else
  542           be gin
  543              { TODO 5 - oDanP -cTh ings Yet U ndone : Ch ange this  so that it  shows the re was an  error and  then make  the error  available  when the u ser clicks  on the me ssage. }
  544              tmr.Enable d := false ;
  545              Add.Captio n := UPDAT ING_FAILUR E;
  546           en d;
  547       end;
  548  
  549     lvData.R epaint;
  550   end;
  551  
  552   end.

Araxis Merge (but not the data content of this report) is Copyright © 1993-2016 Araxis Ltd (www.araxis.com). All rights reserved.