21. EPMO Open Source Coordination Office Redaction File Detail Report

Produced by Araxis Merge on 3/31/2017 10:45:42 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.

21.1 Files compared

# Location File Last Modified
1 CPRS v31A.zip\CPRS v31A\VITL5_P34_src.zip\Source\ROR fROR_PCall.pas Tue Dec 13 18:26:06 2016 UTC
2 CPRS v31A.zip\CPRS v31A\VITL5_P34_src.zip\Source\ROR fROR_PCall.pas Fri Mar 31 15:01:05 2017 UTC

21.2 Comparison summary

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

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

21.4 Active regular expressions

No regular expressions were active.

21.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:  8/05/08 5: 15p $
  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/So urce/ROR/f ROR_PCall. pas $
  16   *
  17   * $History : fROR_PCa ll.pas $
  18    * 
  19    * ******* **********   Version  1  ******* **********
  20    * User: V haishandri a Date: 8/ 12/09    T ime: 8:29a
  21    * Created  in $/Vita ls/5.0 (Ve rsion 5.0) /5.0.23 (P atch 23)/V ITALS_5_0_ 23_8/Sourc e/ROR
  22    * 
  23    * ******* **********   Version  1  ******* **********
  24    * User: V haishandri a Date: 3/ 09/09    T ime: 3:38p
  25    * Created  in $/Vita ls/5.0 (Ve rsion 5.0) /5.0.23 (P atch 23)/V ITALS_5_0_ 23_6/Sourc e/ROR
  26    * 
  27    * ******* **********   Version  1  ******* **********
  28    * User: V haishandri a Date: 1/ 13/09    T ime: 1:26p
  29    * Created  in $/Vita ls/5.0 (Ve rsion 5.0) /5.0.23 (P atch 23)/V ITALS_5_0_ 23_4/Sourc e/ROR
  30    * 
  31    * ******* **********   Version  1  ******* **********
  32    * User: V haishandri a Date: 5/ 14/07    T ime: 10:29 a
  33    * Created  in $/Vita ls GUI 200 7/Vitals-5 -0-18/ROR
  34    * 
  35    * ******* **********   Version  1  ******* **********
  36    * User: V haishandri a Date: 5/ 16/06    T ime: 5:43p
  37    * Created  in $/Vita ls/VITALS- 5-0-18/ROR
  38    * GUI v.  5.0.18 upd ates the d efault vit al type IE Ns with th e local
  39    * values.
  40    * 
  41    * ******* **********   Version  1  ******* **********
  42    * User: V haishandri a Date: 5/ 16/06    T ime: 5:32p
  43    * Created  in $/Vita ls/Vitals- 5-0-18/VIT ALS-5-0-18 /ROR
  44    * 
  45    * ******* **********   Version  1  ******* **********
  46    * User: V haishandri a Date: 5/ 24/05    T ime: 3:32p
  47    * Created  in $/Vita ls/Vitals  GUI  v 5.0 .2.1 -5.0. 3.1 - Patc h GMVR-5-7  (CASMed,  No CCOW) -  Delphi 6/ ROR
  48    * 
  49    * ******* **********   Version  3  ******* **********
  50    * User: V haishandri a Date: 11 /12/04   T ime: 5:41p
  51    * Updated  in $/CP M odernizati on/ROR
  52    * 
  53    * ******* **********   Version  2  ******* **********
  54    * User: V haishandri a Date: 10 /19/04   T ime: 5:48p
  55    * Updated  in $/CP M odernizati on/ROR
  56    * 
  57    * ******* **********   Version  1  ******* **********
  58    * User: V haishandri a Date: 9/ 02/04    T ime: 1:17p
  59    * Created  in $/CP M odernizati on/ROR
  60    * 
  61    * ******* **********   Version  7  ******* **********
  62    * User: V haishgavri s Date: 8/ 06/04    T ime: 4:09p
  63    * Updated  in $/CCR  v1.0/Curre nt
  64    *
  65    * ******* **********   Version  6  ******* **********
  66    * User: V haishgavri s Date: 8/ 02/04    T ime: 12:59 p
  67    * Updated  in $/CCR  v1.0/Curre nt
  68    *
  69    * ******* **********   Version  5  ******* **********
  70    * User: V haishgavri s Date: 3/ 26/04    T ime: 3:48p
  71    * Updated  in $/ICR  v3.0/Curre nt
  72   *
  73   ========== ========== ========== ========== ========== ========== ========== ==========
  74   }
  75   interface
  76  
  77   uses
  78     Windows,  Messages,  SysUtils,  Classes
  79     , Graphi cs
  80     , Contro ls
  81     , Forms
  82     , Dialog s
  83     , StdCtr ls
  84   //  , uROR _Utilities     - repl aced by u_ Common
  85     , TRPCB
  86     , CCOWRP CBroker
  87     , VERGEN CECONTEXTO RLib_TLB / / not sure  we need i t here...
  88     ;
  89  
  90   type
  91  
  92     TRPCMode  = set of  (
  93  
  94       rpcSil ent,           // Do  not show a ny error m essages
  95                             // (on ly return  the error  codes)
  96  
  97       rpcNoR esChk          // Do  not check  the Result s array fo r the erro rs
  98                             // ret urned by t he remote  procedure.  This flag  must be
  99                             // use d for the  remote pro cedures th at do not  conform
  100                             // to  the error  reporting  format sup ported by  the
  101                             // Che ckRPCError  function.
  102  
  103     );
  104  
  105     TRPCErro rForm = cl ass(TForm)
  106       Msg: T Memo;
  107       btnOk:  TButton;
  108       proced ure btnOkC lick(Sende r: TObject );
  109     private
  110       { Priv ate declar ations }
  111     public
  112       { Publ ic declara tions }
  113     end;
  114  
  115   function   CallRemote Proc( Brok er: TRPCBr oker; Remo teProcedur e: String;
  116                Paramete rs: array  of String;  MultList:  TStringLi st = nil;
  117                RPCMode:  TRPCMode  = []; RetL ist: TStri ngs = nil  ): Boolean ;
  118  
  119   function   CallRemote ProcLog( B roker: TRP CBroker; R emoteProce dure: Stri ng;
  120                Paramete rs: array  of String;  MultList:  TStringLi st = nil;
  121                RPCMode:  TRPCMode  = []; RetL ist: TStri ngs = nil  ): Boolean ;
  122  
  123   function   CheckRPCEr ror( RPCNa me: String ; Results:  TStrings;
  124                RPCMode:  TRPCMode  = [] ): In teger;
  125  
  126   procedure  LogString(  ll: Strin g );
  127   procedure  LogTimeStr ing( ll: S tring );
  128  
  129   //function   RPCError Code(Resul ts: TStrin gs = nil):  Integer;
  130  
  131  
  132   var
  133     Log: TSt rings;
  134     RPCBroke r: TRPCBro ker = nil;
  135     prevRPC:  String;
  136  
  137   implementa tion
  138  
  139   uses
  140     uGMV_Com mon
  141     , uGMV_E ngine
  142     ;
  143   {$R *.DFM}
  144  
  145   function C allRemoteP roc(Broker : TRPCBrok er; Remote Procedure:  String;
  146               Parameter s: array o f String;  MultList:  TStringLis t = nil;
  147               RPCMode:  TRPCMode =  []; RetLi st: TStrin gs = nil):  Boolean;
  148   var
  149     s,ss: St ring;
  150     i, j: In teger;
  151  
  152     procedur e CheckBro ker(aFlag: Boolean;aS tring:Stri ng='');
  153     begin
  154       if not  aFlag the n Exit;
  155       if not  (Broker.C learParame ters and B roker.Clea rResults)  then
  156         begi n
  157           if  Broker.Cl earParamet ers then s  := ''
  158           el se s := 'C lear Param eters = Fa lse'+ #13;
  159           if  Broker.Cl earResults  then ss : = ''
  160           el se ss := ' Clear Resu lts = Fals e';
  161  
  162           Sh owMessage( 'Vitals: B roker sett ings Error '+#13+
  163               aString+# 13+
  164               s+ss+#13+
  165              'RPC: "'+B roker.Remo teProcedur e+'"'+#13+
  166              'Prev RPC:  "'+prevRP C+'"');
  167           Br oker.Clear Parameters  := True;
  168           Br oker.Clear Results :=  True;
  169         end;
  170     end;
  171  
  172   begin
  173     Broker.R emoteProce dure := Re moteProced ure;
  174  
  175     CheckBro ker(CheckB rokerFlag, 'CallRemot eProc - In ');
  176     PrevRPC  := RemoteP rocedure;
  177  
  178     Broker.P aram.Clear ;
  179     Broker.R esults.Cle ar;
  180  
  181     i := 0;
  182     while i  <= High(Pa rameters)  do
  183       begin
  184         if ( Copy(Param eters[i],  1, 1) = '@ ') and (Pa rameters[i ] <> '@')  then
  185           be gin
  186              Broker.Par am[i].Valu e := Copy( Parameters [i], 2, Le ngth(Param eters[i])) ;
  187              Broker.Par am[i].PTyp e := Refer ence;
  188           en d
  189         else
  190           be gin
  191              Broker.Par am[i].Valu e := Param eters[i];
  192              Broker.Par am[i].PTyp e := Liter al;
  193           en d;
  194         Inc( i);
  195       end;
  196  
  197     if MultL ist <> nil  then
  198       if Mul tList.Coun t > 0 then
  199         begi n
  200           fo r j := 1 t o MultList .Count do
  201              Broker.Par am[i].Mult [IntToStr( j)] := Mul tList[j-1] ;
  202           Br oker.Param [i].PType  := List;
  203         end;
  204  
  205     try
  206       Result  := True;
  207       if Ret List <> ni l then
  208         begi n
  209           Re tList.Clea r;
  210           Br oker.lstCa ll(RetList );
  211         end
  212       else
  213         begi n
  214           Br oker.Call;
  215           Re tList := B roker.Resu lts;
  216         end;
  217  
  218     CheckBro ker(CheckB rokerFlag, 'CallRemot eProc - Ou t');
  219  
  220       if Not  (rpcNoRes Chk in RPC Mode) then
  221         if C heckRPCErr or(RemoteP rocedure,  RetList, R PCMode) <>  0 then
  222           Re sult := Fa lse;
  223  
  224     except
  225       on e:  EBrokerErr or do
  226       begin
  227         if N ot (rpcSil ent in RPC Mode) then
  228           Me ssageDialo g('RPC Err or',
  229              'Error enc ountered r etrieving  VistA data .' + #13 +
  230              'Server: '  + Broker. Server + # 13 +
  231              'Listener  port: ' +  IntToStr(B roker.List enerPort)  + #13 +
  232              'Remote pr ocedure: '  + Broker. RemoteProc edure + #1 3 +
  233              'Error is:  ' + #13 +
  234              e.Message,  mtError,  [mbOK], mr OK, e.Help Context);
  235         with  Broker do
  236         begi n
  237           Re sults.Clea r;
  238           Re sults.Add( '-1000^1') ;
  239           Re sults.Add( '-1000^' +  e.Message );
  240         end;
  241         Resu lt := Fals e;
  242       end;
  243     else
  244       raise;
  245     end;
  246   end;
  247  
  248   procedure  LogString( ll: String );
  249   begin
  250     try
  251       Log.Te xt := Log. Text + ll;
  252     except
  253     end;
  254   end;
  255  
  256   procedure  LogTimeStr ing(ll: St ring);
  257   begin
  258     LogStrin g(#13 +
  259       Format ('%s : %s' ,[FormatDa teTime('dd /mm/yyyy h h:nn:ss.zz z',Now),ll ]));
  260   end;
  261  
  262   function C allRemoteP rocLog(Bro ker: TRPCB roker; Rem oteProcedu re: String ;
  263               Parameter s: array o f String;  MultList:  TStringLis t = nil;
  264               RPCMode:  TRPCMode =  []; RetLi st: TStrin gs = nil):  Boolean;
  265   var
  266     i: integ er;
  267   begin
  268     LogTimeS tring('Sta rt -- ' +R emoteProce dure);
  269  
  270     for i :=  0 to High (Parameter s) do
  271       LogStr ing(#13+   '                                      ['+I ntTosTr(i) +'] ' +Par ameters[i] );
  272     if MultL ist <> nil  then
  273       for I  := 0 to Mu ltList.Cou nt - 1 do
  274         LogS tring(#13+   '                                      [' +IntTosTr( i)+'] ' +M ultList[i] );
  275  
  276     if CallR emoteProc( Broker, Re moteProced ure, Param eters, Mul tList, RPC Mode, RetL ist) then
  277       begin
  278         if R etList <>  nil then
  279         for  I := 0 to  RetList.Co unt - 1 do
  280           Lo gString(#1 3+  '                                       ['+IntTosT r(i)+'] '  +RetList[i ]);
  281         LogT imeString( 'Stop  --  1 ' +Remot eProcedure );
  282         Resu lt := True ;
  283       end
  284     else
  285       begin
  286         LogT imeString( 'Stop  --  0 ' +Remot eProcedure );
  287         Resu lt := Fals e;
  288       end;
  289   end;
  290  
  291   function C heckRPCErr or(RPCName : String;  Results: T Strings;
  292               RPCMode:  TRPCMode =  [] ): Int eger;
  293   var
  294     i, n: In teger;
  295     buf, rc:  String;
  296     form: TR PCErrorFor m;
  297   begin
  298     if Resul ts.Count =  0 then
  299       begin
  300         Resu lt := mrOK ;
  301         buf  := 'The '' ' + RPCNam e + ''' re mote proce dure retur ned nothin g!';
  302         if N ot (rpcSil ent in RPC Mode) then
  303           Me ssageDialo g('RPC Err or', buf,  mtError, [ mbOK], mrO K, 0);
  304         Resu lts.Add('- 1001^1');
  305         Resu lts.Add('- 1001^' + b uf);
  306         Exit ;
  307       end;
  308  
  309     Result : = 0;
  310     rc := Pi ece(Result s[0], '^') ;
  311  
  312     if StrTo IntDef(rc,  0) < 0 th en
  313       begin
  314         Resu lt := mrOK ;
  315         if N ot (rpcSil ent in RPC Mode) then
  316           be gin
  317              form := TR PCErrorFor m.Create(A pplication );
  318              n := StrTo IntDef(Pie ce(Results [0], '^',  2), 0);
  319              with form. Msg.Lines  do
  320                begin
  321                  buf :=  'The erro r code '''  + rc + '' ' was retu rned by th e '''
  322                    + RP CName + '' ' remote p rocedure!' ;
  323                  if n >  0 then
  324                    begi n
  325                      bu f := buf +  ' The pro blem had b een caused  by the fo llowing ';
  326                      if  n > 1 the n
  327                         buf := buf  + 'errors  (in rever se chronol ogical ord er):'
  328                      el se
  329                         buf := buf  + 'error:  ';
  330                      Ad d(buf);
  331                      fo r i := 1 t o n do
  332                         begin
  333                           if i >=  Results.Co unt then
  334                             break;
  335                           buf := R esults[i];
  336                           Add('');   Add(' '  + Piece(bu f,'^',2));
  337                           Add(' Er ror Code:  ' + Piece( buf,'^',1)  + ';' + # 9 +
  338                             'Place : ' + Stri ngReplace( Piece(buf, '^',3),'~' ,'^',[]));
  339                         end;
  340                    end
  341                  else
  342                    Add( buf);
  343                end;
  344              Result :=  form.ShowM odal;
  345              form.Free;
  346           en d;
  347       end;
  348  
  349   end;
  350   {
  351   function R PCErrorCod e(Results:  TStrings) : Integer;
  352   var
  353     res: TSt rings;
  354   begin
  355     if Assig ned(Result s) then
  356       res :=  Results
  357     else
  358       res :=  RPCBroker .Results;
  359     if res.C ount > 0 t hen
  360       Result  := StrToI ntDef(Piec e(Piece(re s[0], '^') , '.'), -9 99)
  361     else
  362       Result  := -999;
  363   end;
  364   }
  365   ////////// ////////// ////////// ////////// ////////// ////////// ////////// //////////
  366  
  367   procedure  TRPCErrorF orm.btnOkC lick(Sende r: TObject );
  368   begin
  369     ModalRes ult := mrO k;
  370   end;
  371  
  372   begin
  373     PrevRPC  := '';
  374   end.