10. EPMO Open Source Coordination Office Redaction File Detail Report

Produced by Araxis Merge on 3/31/2017 10:45:37 AM 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 CPRS v31A.zip\CPRS v31A\VITL5_P34_src.zip\CCR-COMPONENTS fROR_PCall.pas Tue Dec 13 18:24:14 2016 UTC
2 CPRS v31A.zip\CPRS v31A\VITL5_P34_src.zip\CCR-COMPONENTS fROR_PCall.pas Fri Mar 31 14:54:28 2017 UTC

10.2 Comparison summary

Description Between
Files 1 and 2
Text Blocks Lines
Unchanged 2 1070
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 fROR_ PCall;
  2   {
  3   ========== ========== ========== ========== ========== ========== ========== ==========
  4   *
  5   *       Pa ckage:         ROR -  Clinical C ase Regist ries
  6   *       Da te Created :   $Revis ion: 1 $   $Modtime:  12/20/07 1 2:43p $
  7   *       Si te:            Hines  OIFO
  8   *       De velopers:       PII                          
  9   *
  10   *       De scription:     RPC ca ll and RPC  Error Win dow
  11   *
  12   *       No tes:
  13   *
  14   ========== ========== ========== ========== ========== ========== ========== ==========
  15   *       $A rchive: /V itals/5.0  (Version 5 .0)/5.0.23  (Patch 23 )/VITALS_5 _0_23_8/CC R-COMPONEN TS/fROR_PC all.pas $
  16   *
  17   * $History : fROR_PCa ll.pas $
  18    * 
  19    * ******* **********   Version  1  ******* **********
  20    * User: V haishandri a Date: 8/ 12/09    T ime: 8:28a
  21    * Created  in $/Vita ls/5.0 (Ve rsion 5.0) /5.0.23 (P atch 23)/V ITALS_5_0_ 23_8/CCR-C OMPONENTS
  22    * 
  23    * ******* **********   Version  1  ******* **********
  24    * User: V haishandri a Date: 3/ 09/09    T ime: 3:37p
  25    * Created  in $/Vita ls/5.0 (Ve rsion 5.0) /5.0.23 (P atch 23)/V ITALS_5_0_ 23_6/CCR-C OMPONENTS
  26    * 
  27    * ******* **********   Version  1  ******* **********
  28    * User: V haishandri a Date: 1/ 13/09    T ime: 1:25p
  29    * Created  in $/Vita ls/5.0 (Ve rsion 5.0) /5.0.23 (P atch 23)/V ITALS_5_0_ 23_4/CCR-C OMPONENTS
  30    * 
  31    * ******* **********   Version  1  ******* **********
  32    * User: V haishandri a Date: 5/ 11/07    T ime: 2:54p
  33    * Created  in $/Vita ls GUI/CCR -COMPONENT S
  34    * CCR Com ponents. V ersion use d in Vital s GUI 5.0. 18
  35    * 
  36    * ******* **********   Version  1  ******* **********
  37    * User: V haishandri a Date: 5/ 11/07    T ime: 2:34p
  38    * Created  in $/Vita ls/CCR-COM PONENTS
  39    * 
  40    * ******* **********   Version  17  ****** ********** *
  41    * User: V haishgavri s Date: 8/ 08/05    T ime: 3:55p
  42    * Updated  in $/CCR  v1.0/Curre nt/Compone nts
  43    * 
  44    * ******* **********   Version  16  ****** ********** *
  45    * User: V haishgavri s Date: 1/ 18/05    T ime: 3:40p
  46    * Updated  in $/CCR  v1.0/Curre nt/Compone nts
  47    * 
  48    * ******* **********   Version  15  ****** ********** *
  49    * User: V haishgavri s Date: 1/ 10/05    T ime: 3:49p
  50    * Updated  in $/CCR  v1.0/Curre nt/Compone nts
  51    * 
  52    * ******* **********   Version  13  ****** ********** *
  53    * User: V haishgavri s Date: 10 /15/04   T ime: 10:15 a
  54    * Updated  in $/CCR  v1.0/Curre nt
  55    *
  56    * ******* **********   Version  12  ****** ********** *
  57    * User: V haishgavri s Date: 10 /15/04   T ime: 10:11 a
  58    * Updated  in $/CCR  v1.0/Curre nt/Compone nts
  59    *
  60   *
  61   ========== ========== ========== ========== ========== ========== ========== ==========
  62   }
  63   interface
  64  
  65   uses
  66     SysUtils , Classes,  Forms, Di alogs, TRP CB, StdCtr ls, Contro ls, CCOWRP CBroker;
  67  
  68   type
  69     TRPCMode  = set of  (
  70  
  71       rpcSil ent,           // Do  not show a ny error m essages
  72                             // (on ly return  the error  codes)
  73  
  74       rpcNoR esChk          // Do  not check  the Result s array fo r the erro rs
  75                             // ret urned by t he remote  procedure.  This flag  must be
  76                             // use d for the  remote pro cedures th at do not  conform
  77                             // to  the error  reporting  format sup ported by  the
  78                             // Che ckRPCError  function.
  79  
  80     );
  81  
  82     //------ ---------- ---------- ----- TRPC ErrorForm  ---------- ---------- ----------
  83  
  84     TRPCErro rForm = cl ass(TForm)
  85       Msg: T Memo;
  86       btnOk:  TButton;
  87       proced ure btnOkC lick(Sende r: TObject );
  88     private
  89       { Priv ate declar ations }
  90     public
  91       { Publ ic declara tions }
  92     end;
  93  
  94     //------ ---------- ---------- ----- IRPC Interface  ---------- ---------- ----------
  95  
  96     IRPCInte rface = in terface(II nterface)
  97       ['{FAD 698BB-63E9 -408C-BFF7 -8E4A8451B 63B}']
  98       functi on CallPro c(const Re moteProced ure: Strin g;
  99         cons t Paramete rs: array  of String;  MultList:  TStringLi st = nil;
  100         cons t RPCMode:  TRPCMode  = []; RetL ist: TStri ngs = nil) : Boolean;
  101       functi on CheckEr ror(const  RPCName: S tring; Ret List: TStr ings = nil ;
  102                const RP CMode: TRP CMode = [] ): Integer ;
  103     end;
  104  
  105     //------ ---------- ---------- ------ TCC RLogMode - ---------- ---------- ----------
  106  
  107     TCCRLogM ode = clas s(TPersist ent)
  108     private
  109       fEnabl ed:      B oolean;
  110       fLimit Params:  W ord;
  111       fLimit Results: W ord;
  112       fParam eters:   B oolean;
  113       fResul ts:      B oolean;
  114  
  115     public
  116       constr uctor Crea te;
  117       
  118       proced ure Assign (aSource:  TPersisten t); overri de;
  119  
  120     publishe d
  121       proper ty Enabled : Boolean  read fEnab led write  fEnabled;
  122       proper ty LimitPa rams: Word  read fLim itParams w rite fLimi tParams de fault 0;
  123       proper ty LimitRe sults: Wor d read fLi mitResults  write fLi mitResults  default 0 ;
  124       proper ty Paramet ers: Boole an read fP arameters  write fPar ameters de fault True ;
  125       proper ty Results : Boolean  read fResu lts write  fResults d efault Tru e;
  126  
  127     end;
  128  
  129     //------ ---------- ---------- ----- TCCR RPCBroker  ---------- ---------- ----------
  130  
  131     TCCRRPCB roker = cl ass(TCCOWR PCBroker,  IRPCInterf ace)
  132     private
  133       fLog:      TCCRLo gMode;
  134       fLogDa ta: TStrin gList;
  135  
  136       proced ure setLog (const aVa lue: TCCRL ogMode);
  137  
  138     public
  139       constr uctor Crea te(anOwner : TCompone nt); overr ide;
  140       destru ctor  Dest roy; overr ide;
  141  
  142       proced ure AddLog String(con st aValue:  String);  overload;
  143       proced ure AddLog String(con st aFormat : String;  const ArgL ist: array  of const) ; overload ;
  144       functi on  CallPr oc(const a RemoteProc edure: Str ing;
  145         cons t Paramete rs: array  of String;  MultList:  TStringLi st = nil;
  146         cons t RPCMode:  TRPCMode  = []; RetL ist: TStri ngs = nil) : Boolean;  virtual;
  147       functi on  CheckE rror(const  RPCName:  String; Re tList: TSt rings = ni l;
  148                const RP CMode: TRP CMode = [] ): Integer ;
  149  
  150       proper ty LogData : TStringL ist read f LogData;
  151  
  152     publishe d
  153       proper ty Log: TC CRLogMode  read fLog  write setL og;
  154  
  155     end;
  156  
  157   function   CallRemote Proc( Brok er: TRPCBr oker; Remo teProcedur e: String;
  158                Paramete rs: array  of String;  MultList:  TStringLi st = nil;
  159                RPCMode:  TRPCMode  = []; RetL ist: TStri ngs = nil  ): Boolean ;
  160  
  161   function   CheckRPCEr ror( RPCNa me: String ; Results:  TStrings;
  162                RPCMode:  TRPCMode  = [] ): In teger;
  163  
  164   implementa tion
  165   {$R *.DFM}
  166  
  167   uses
  168     Math, uR OR_Utiliti es;
  169  
  170   function C allRemoteP roc(Broker : TRPCBrok er; Remote Procedure:  String;
  171               Parameter s: array o f String;  MultList:  TStringLis t = nil;
  172               RPCMode:  TRPCMode =  []; RetLi st: TStrin gs = nil):  Boolean;
  173   var
  174     i, j: In teger;
  175   begin
  176     Broker.R emoteProce dure := Re moteProced ure;
  177     i := 0;
  178     while i  <= High(Pa rameters)  do
  179       begin
  180         if ( Copy(Param eters[i],  1, 1) = '@ ') and (Pa rameters[i ] <> '@')  then
  181           be gin
  182              Broker.Par am[i].Valu e := Copy( Parameters [i], 2, Le ngth(Param eters[i])) ;
  183              Broker.Par am[i].PTyp e := Refer ence;
  184           en d
  185         else
  186           be gin
  187              Broker.Par am[i].Valu e := Param eters[i];
  188              Broker.Par am[i].PTyp e := Liter al;
  189           en d;
  190         Inc( i);
  191       end;
  192  
  193     if MultL ist <> nil  then
  194       if Mul tList.Coun t > 0 then
  195         begi n
  196           fo r j := 1 t o MultList .Count do
  197              Broker.Par am[i].Mult [IntToStr( j)] := Mul tList[j-1] ;
  198           Br oker.Param [i].PType  := List;
  199         end;
  200  
  201     try
  202       Result  := True;
  203       if Ret List <> ni l then
  204         begi n
  205           Re tList.Clea r;
  206           Br oker.lstCa ll(RetList );
  207         end
  208       else
  209         begi n
  210           Br oker.Call;
  211           Re tList := B roker.Resu lts;
  212         end;
  213  
  214       if Not  (rpcNoRes Chk in RPC Mode) then
  215         if C heckRPCErr or(RemoteP rocedure,  RetList, R PCMode) <>  0 then
  216           Re sult := Fa lse;
  217  
  218     except
  219       on e:  EBrokerErr or do
  220       begin
  221         if N ot (rpcSil ent in RPC Mode) then
  222           Me ssageDialo g('RPC Err or',
  223              'Error enc ountered r etrieving  VistA data .' + #13 +
  224              'Server: '  + Broker. Server + # 13 +
  225              'Listener  port: ' +  IntToStr(B roker.List enerPort)  + #13 +
  226              'Remote pr ocedure: '  + Broker. RemoteProc edure + #1 3 +
  227              'Error is:  ' + #13 +
  228              e.Message,  mtError,  [mbOK], mr OK, e.Help Context);
  229         with  Broker do
  230         begi n
  231           Re sults.Clea r;
  232           Re sults.Add( '-1000^1') ;
  233           Re sults.Add( '-1000^' +  e.Message );
  234         end;
  235         Resu lt := Fals e;
  236       end;
  237     else
  238       raise;
  239     end;
  240   end;
  241  
  242   function C heckRPCErr or(RPCName : String;  Results: T Strings;
  243               RPCMode:  TRPCMode =  [] ): Int eger;
  244   var
  245     i, n: In teger;
  246     buf, rc:  String;
  247     form: TR PCErrorFor m;
  248   begin
  249     if Resul ts.Count =  0 then
  250       begin
  251         Resu lt := mrOK ;
  252         buf  := 'The '' ' + RPCNam e + ''' re mote proce dure retur ned nothin g!';
  253         if N ot (rpcSil ent in RPC Mode) then
  254           Me ssageDialo g('RPC Err or', buf,  mtError, [ mbOK], mrO K, 0);
  255         Resu lts.Add('- 1001^1');
  256         Resu lts.Add('- 1001^' + b uf);
  257         Exit ;
  258       end;
  259  
  260     Result : = 0;
  261     rc := Pi ece(Result s[0], '^') ;
  262  
  263     if StrTo IntDef(rc,  0) < 0 th en
  264       begin
  265         Resu lt := mrOK ;
  266         if N ot (rpcSil ent in RPC Mode) then
  267           be gin
  268              form := TR PCErrorFor m.Create(A pplication );
  269              n := StrTo IntDef(Pie ce(Results [0], '^',  2), 0);
  270              with form. Msg.Lines  do
  271                begin
  272                  buf :=  'The erro r code '''  + rc + '' ' was retu rned by th e '''
  273                    + RP CName + '' ' remote p rocedure!' ;
  274                  if n >  0 then
  275                    begi n
  276                      bu f := buf +  ' The pro blem had b een caused  by the fo llowing ';
  277                      if  n > 1 the n
  278                         buf := buf  + 'errors  (in rever se chronol ogical ord er):'
  279                      el se
  280                         buf := buf  + 'error:  ';
  281                      Ad d(buf);
  282                      n  := Results .Count - 1 ;
  283                      fo r i:=1 to  n do
  284                         begin
  285                           buf := R esults[i];
  286                           if Piece (buf, '^')  <> '' the n
  287                             begin
  288                               Add( '');  Add( ' ' + Piec e(buf,'^', 2));
  289                               Add( ' Error Co de: ' + Pi ece(buf,'^ ',1) + ';'  + #9 +
  290                                 'P lace: ' +  StringRepl ace(Piece( buf,'^',3) ,'~','^',[ ]));
  291                             end
  292                           else
  293                             Add('  ' + Piece( buf,'^',2, 999));
  294                         end;
  295                    end
  296                  else
  297                    Add( buf);
  298                end;
  299              Result :=  form.ShowM odal;
  300              form.Free;
  301           en d;
  302       end;
  303   end;
  304  
  305   ////////// ////////// ////////// /// TCCRLo gMode \\\\ \\\\\\\\\\ \\\\\\\\\\ \\\\\\\\\\
  306  
  307   constructo r TCCRLogM ode.Create ;
  308   begin
  309     inherite d;
  310     fEnabled       := F alse;
  311     fLimitPa rams  := 0 ;
  312     fLimitRe sults := 0 ;
  313     fParamet ers   := T rue;
  314     fResults       := T rue;
  315   end;
  316  
  317   procedure  TCCRLogMod e.Assign(a Source: TP ersistent) ;
  318   begin
  319     if aSour ce is TCCR LogMode th en
  320       with T CCRLogMode (aSource)  do
  321         begi n
  322           Se lf.fEnable d      :=  fEnabled;    
  323           Se lf.fLimitP arams  :=  fLimitPara ms;
  324           Se lf.fLimitR esults :=  fLimitResu lts;
  325           Se lf.fParame ters   :=  fParameter s;
  326           Se lf.fResult s      :=  fResults;
  327         end
  328     else
  329       inheri ted;
  330   end;
  331  
  332   ////////// ////////// ////////// // TCCRRPC Broker \\\ \\\\\\\\\\ \\\\\\\\\\ \\\\\\\\\\
  333  
  334   constructo r TCCRRPCB roker.Crea te(anOwner : TCompone nt);
  335   begin
  336     inherite d;
  337     fLog      := TCCRLo gMode.Crea te;
  338     fLogData  := TStrin gList.Crea te;
  339   end;
  340  
  341   destructor  TCCRRPCBr oker.Destr oy;
  342   begin
  343     FreeAndN il(fLogDat a);
  344     FreeAndN il(fLog);
  345     inherite d;
  346   end;
  347  
  348   procedure  TCCRRPCBro ker.AddLog String(con st aValue:  String);
  349   begin
  350     LogData. Add(aValue );
  351   end;
  352  
  353   procedure  TCCRRPCBro ker.AddLog String(con st aFormat : String;  const ArgL ist: array  of const) ;
  354   begin
  355     AddLogSt ring(Forma t(aFormat,  ArgList)) ;
  356   end;
  357  
  358   function T CCRRPCBrok er.CallPro c(const aR emoteProce dure: Stri ng;
  359     const Pa rameters:  array of S tring; Mul tList: TSt ringList =  nil;
  360     const RP CMode: TRP CMode = [] ; RetList:  TStrings  = nil): Bo olean;
  361   var
  362     i, j, n:  Integer;
  363   begin
  364     RemotePr ocedure :=  aRemotePr ocedure;
  365     n := Hig h(Paramete rs);
  366  
  367     if Log.E nabled the n
  368       begin
  369         AddL ogString(' ');
  370         AddL ogString(' RPC: %s',  [aRemotePr ocedure]);
  371         if L og.Paramet ers then
  372           fo r j:=0 to  n do
  373              AddLogStri ng('     P [%02d]: '' %s''', [j, Parameters [j]]);
  374       end;
  375  
  376     i := 0;
  377     while i  <= n do
  378       begin
  379         if ( Copy(Param eters[i],  1, 1) = '@ ') and (Pa rameters[i ] <> '@')  then
  380           be gin
  381              Param[i].V alue := Co py(Paramet ers[i], 2,  Length(Pa rameters[i ]));
  382              Param[i].P Type := Re ference;
  383           en d
  384         else
  385           be gin
  386              Param[i].V alue := Pa rameters[i ];
  387              Param[i].P Type := Li teral;
  388           en d;
  389         Inc( i);
  390       end;
  391  
  392     if MultL ist <> nil  then
  393       if Mul tList.Coun t > 0 then
  394         begi n
  395           if  Log.Enabl ed and Log .Parameter s then
  396              begin
  397                if Log.L imitParams  > 0 then
  398                  n := M in(MultLis t.Count, L og.LimitPa rams) - 1
  399                else
  400                  n := M ultList.Co unt - 1;
  401                for j:=0  to n do
  402                  AddLog String('      M[%02d] : ''%s''',  [j,MultLi st[j]]);
  403                if n < ( MultList.C ount-1) th en
  404                  AddLog String('      ...');
  405              end;
  406           fo r j:=1 to  MultList.C ount do
  407              Param[i].M ult[IntToS tr(j)] :=  MultList[j -1];
  408           Pa ram[i].PTy pe := List ;
  409         end;
  410  
  411     try
  412       Result  := True;
  413       if Ret List <> ni l then
  414         begi n
  415           Re tList.Clea r;
  416           ls tCall(RetL ist);
  417         end
  418       else
  419         begi n
  420           Ca ll;
  421           Re tList := R esults;
  422         end;
  423  
  424       if Not  (rpcNoRes Chk in RPC Mode) then
  425         if C heckRPCErr or(aRemote Procedure,  RetList,  RPCMode) < > 0 then
  426           Re sult := Fa lse;
  427  
  428     except
  429       on e:  EBrokerErr or do
  430       begin
  431         if N ot (rpcSil ent in RPC Mode) then
  432           Me ssageDialo g('RPC Err or',
  433              'Error enc ountered r etrieving  VistA data .' + #13 +
  434              'Server: '  + Server  + #13 +
  435              'Listener  port: ' +  IntToStr(L istenerPor t) + #13 +
  436              'Remote pr ocedure: '  + aRemote Procedure  + #13 +
  437              'Error is:  ' + #13 +
  438              e.Message,  mtError,  [mbOK], mr OK, e.Help Context);
  439         Resu lts.Clear;
  440         Resu lts.Add('- 1000^1');
  441         Resu lts.Add('- 1000^' + e .Message);
  442         Resu lt := Fals e;
  443       end;
  444     else
  445       raise;
  446     end;
  447  
  448     if Log.E nabled and  Log.Resul ts then
  449       begin
  450         if L og.LimitRe sults > 0  then
  451           n  := Min(Ret List.Count , Log.Limi tResults)  - 1
  452         else
  453           n  := RetList .Count - 1 ;
  454         for  j:=0 to n  do
  455           Ad dLogString ('     R[% 02d]: ''%s ''', [j,Re tList[j]]) ;
  456         if n  < (RetLis t.Count-1)  then
  457           Ad dLogString ('     ... ');
  458       end;
  459   end;
  460  
  461   function T CCRRPCBrok er.CheckEr ror(const  RPCName: S tring; Ret List: TStr ings;
  462     const RP CMode: TRP CMode): In teger;
  463   var
  464     i, n: In teger;
  465     buf, rc:  String;
  466     form: TR PCErrorFor m;
  467   begin
  468     if not A ssigned(Re tList) the n
  469       RetLis t := Resul ts;
  470       
  471     if RetLi st.Count =  0 then
  472       begin
  473         Resu lt := mrOK ;
  474         buf  := 'The '' ' + RPCNam e + ''' re mote proce dure retur ned nothin g!';
  475         if N ot (rpcSil ent in RPC Mode) then
  476           Me ssageDialo g('RPC Err or', buf,  mtError, [ mbOK], mrO K, 0);
  477         RetL ist.Add('- 1001^1');
  478         RetL ist.Add('- 1001^' + b uf);
  479         Exit ;
  480       end;
  481  
  482     Result : = 0;
  483     rc := Pi ece(RetLis t[0], '^') ;
  484  
  485     if StrTo IntDef(rc,  0) < 0 th en
  486       begin
  487         Resu lt := mrOK ;
  488         if N ot (rpcSil ent in RPC Mode) then
  489           be gin
  490              form := TR PCErrorFor m.Create(A pplication );
  491              try
  492                n := Str ToIntDef(P iece(RetLi st[0], '^' , 2), 0);
  493                with for m.Msg.Line s do
  494                  begin
  495                    buf  := 'The er ror code ' '' + rc +  ''' was re turned by  the '''
  496                      +  RPCName +  ''' remote  procedure !';
  497                    if n  > 0 then
  498                      be gin
  499                         buf := buf  + ' The p roblem had  been caus ed by the  following  ';
  500                         if n > 1 t hen
  501                           buf := b uf + 'erro rs (in rev erse chron ological o rder):'
  502                         else
  503                           buf := b uf + 'erro r: ';
  504                         Add(buf);
  505                         for i := 1  to n do
  506                           begin
  507                             buf :=  RetList[i ];
  508                             Add('' );  Add('  ' + Piece( buf,'^',2) );
  509                             Add('  Error Code : ' + Piec e(buf,'^', 1) + ';' +  #9 +
  510                               'Pla ce: ' + St ringReplac e(Piece(bu f,'^',3),' ~','^',[]) );
  511                           end;
  512                      en d
  513                    else
  514                      Ad d(buf);
  515                  end;
  516                Result : = form.Sho wModal;
  517              finally
  518                form.Fre e;
  519              end;
  520           en d;
  521       end;
  522   end;
  523  
  524   procedure  TCCRRPCBro ker.setLog (const aVa lue: TCCRL ogMode);
  525   begin
  526     fLog.Ass ign(aValue );
  527   end;
  528  
  529   ////////// ////////// ////////// // TRPCErr orForm \\\ \\\\\\\\\\ \\\\\\\\\\ \\\\\\\\\\
  530  
  531   procedure  TRPCErrorF orm.btnOkC lick(Sende r: TObject );
  532   begin
  533     ModalRes ult := mrO k;
  534   end;
  535  
  536   end.