50. EPMO Open Source Coordination Office Redaction File Detail Report

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

50.1 Files compared

# Location File Last Modified
1 v31B.zip\v31B\377\OR_30_377V235_SRC\Womens Health oWVController.pas Wed May 17 14:56:14 2017 UTC
2 v31B.zip\v31B\377\OR_30_377V235_SRC\Womens Health oWVController.pas Thu Jul 13 14:46:57 2017 UTC

50.2 Comparison summary

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

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

50.4 Active regular expressions

No regular expressions were active.

50.5 Comparison detail

  1   unit oWVCo ntroller;
  2   {
  3     ======== ========== ========== ========== ========== ========== ========== ========== ==
  4     *
  5     *        Applicatio n:  TDrugs  Patch OR* 3*377 and  WV*1*24
  6       *         Developer:       PII                   
  7     *        Site:          Salt L ake City I SC
  8     *
  9     *        Descriptio n:  Primar y controll er accesse d via the  WVControll er
  10     *                       method  in iWVInt erface.pas  as IWVCon troller.
  11     *
  12     *        Notes:         Implem entation u ses clause  contains  non-standa rd link to
  13     *                       CPRS f ile ORNet. pas for us e with CPR S.
  14     *
  15     ======== ========== ========== ========== ========== ========== ========== ========== ==
  16   }
  17  
  18   interface
  19  
  20   uses
  21     Dialogs,
  22     System.C lasses,
  23     System.G enerics.Co llections,
  24     System.S ysUtils,
  25     System.U ITypes,
  26     iWVInter face,
  27     oWVWebSi te;
  28  
  29   type
  30     TWVContr oller = cl ass(TInter facedObjec t, IWVCont roller)
  31     private
  32       { Priv ate decler ations }
  33       fEDDMe thod: stri ng;
  34       fIniti alized: bo olean;
  35       fLastE rror: stri ng;
  36       fWebSi teListName : string;
  37       fWebSi tes: TObje ctList<TWV WebSite>;
  38  
  39       functi on getEDDM ethod: str ing;
  40       functi on getWebS ite(aIndex : integer) : IWVWebSi te;
  41       functi on getWebS iteCount:  integer;
  42       functi on getWebS iteListNam e: string;
  43     protecte d
  44       { Prot ected decl arations }
  45       functi on GetLast Error: str ing;
  46  
  47       functi on EditPre gLacData(a DFN: strin g): boolea n;
  48       functi on GetReco rdIDType(a RecordID:  string; va r aType: s tring): bo olean;
  49       functi on GetWebS iteURL(aWe bSiteName:  string):  string;
  50       functi on InitCon troller(aF orceInit:  boolean =  False): bo olean; vir tual;
  51       functi on IsValid WVPatient( aDFN: stri ng): boole an;
  52       functi on MarkAsE nteredInEr ror(aItemI D: string) : boolean;
  53       functi on OpenExt ernalWebsi te(aWebsit e: IWVWebS ite): bool ean;
  54       functi on SavePre gnancyAndL actationDa ta(aList:  TStrings):  boolean;
  55     public
  56       constr uctor Crea te;
  57       destru ctor Destr oy; overri de;
  58     end;
  59  
  60   implementa tion
  61  
  62   uses
  63     fWVPregL acStatusUp date, // U pdate Form
  64     fWVEIERe asonsDlg,  // Reason  Selection  Dialog
  65     oDelimit edString,
  66     ORNet, / / Access t o CallVist A() method  in CPRS s o RPC's ar e logged -  Would lik e to route  this thro ugh an eve nt.
  67     WinAPI.W indows, //  Call to S hellExecut e for the  WebSites
  68     ShellAPI ; // Call  to ShellEx ecute for  the WebSit es
  69  
  70   const
  71     { VistA  RPC's }
  72     RPC_CONS AVE = 'WVR PCOR CONSA VE';
  73     RPC_COVE R = 'WVRPC OR COVER';
  74     RPC_EIE  = 'WVRPCOR  EIE';
  75     RPC_SAVE DATA = 'WV RPCOR SAVE DATA';
  76     RPC_REAS ONS = 'WVR PCOR REASO NS';
  77     RPC_WEBS ITES = 'WV RPCOR SITE S';
  78  
  79     { TWVCon troller }
  80  
  81   constructo r TWVContr oller.Crea te;
  82   begin
  83     inherite d Create;
  84     fInitial ized := Fa lse;
  85     fLastErr or := '';
  86  
  87     fWebSite s := TObje ctList<TWV WebSite>.C reate;
  88     fWebSite s.OwnsObje cts := Tru e;
  89   end;
  90  
  91   destructor  TWVContro ller.Destr oy;
  92   begin
  93     inherite d;
  94     FreeAndN il(fWebSit es);
  95   end;
  96  
  97   function T WVControll er.EditPre gLacData(a DFN: strin g): boolea n;
  98   var
  99     aList: T StringList ;
  100   begin
  101     aList :=  TStringLi st.Create;
  102     Result : = False;
  103     try
  104       CallVi stA(RPC_CO NSAVE, [aD FN], aList );
  105       if aLi st.Count >  1 then
  106         fEDD Method :=  Copy(aList [1], Pos(' ^', aList[ 1]) + 1, L ength(aLis t[1]))
  107       else
  108         fEDD Method :=  '';
  109  
  110       if Cop y(aList[0] , 1, 2) =  '1^' then  // Get con firmation  to result  or exit.
  111         if M essageDlg( Copy(aList [0], 3, Le ngth(aList [0])), mtC onfirmatio n, [mbYes,  mbNo], 0)  <> mrYes  then
  112           be gin
  113              Result :=  True;
  114              Exit;
  115           en d;
  116  
  117       if Cop y(aList[0] , 1, 3) =  '-1^' then  // Error  from serve r, abort.
  118         begi n
  119           fL astError : = aList[0] ;
  120           Re sult := Fa lse;
  121           Ex it;
  122         end;
  123  
  124       with N ewPLUpdate Form(aDFN)  do
  125         try
  126           pn lEDDMethod .Caption : = getEDDMe thod;
  127           pn lEDDMethod .ShowCapti on := Fals e;
  128  
  129           lb lEDDMethod .Caption : = getEDDMe thod;
  130           lb lEDDMethod .Hint := g etEDDMetho d;
  131  
  132           if  Execute t hen
  133              begin
  134                if GetDa ta(aList)  then
  135                  Result  := SavePr egnancyAnd LactationD ata(aList)
  136                else
  137                  begin
  138                    fLas tError :=  Copy(aList [0], 3, Le ngth(aList [0]));
  139                    Resu lt := Fals e;
  140                  end
  141              end
  142           el se
  143              Result :=  True;
  144         fina lly
  145           Fr ee;
  146         end;
  147     except
  148       on E:  Exception  do
  149         fLas tError :=  E.Message;
  150     end;
  151     FreeAndN il(aList);
  152   end;
  153  
  154   function T WVControll er.GetLast Error: str ing;
  155   begin
  156     Result : = fLastErr or;
  157   end;
  158  
  159   function T WVControll er.GetReco rdIDType(a RecordID:  string; va r aType: s tring): bo olean;
  160   begin
  161     try
  162       case S trToInt(Co py(aRecord ID, 1, Pos (';', aRec ordID) - 1 )) of
  163         4:
  164           be gin
  165              aType := ' Pregnancy  Status';
  166              Result :=  True;
  167           en d;
  168         5:
  169           be gin
  170              aType := ' Lactation  Status';
  171              Result :=  True;
  172           en d;
  173       else
  174         begi n
  175           aT ype := 'Un known Reco rd ID Type  ' + aReco rdID;
  176           Re sult := Fa lse;
  177         end;
  178       end;
  179     except
  180       on E:  Exception  do
  181         begi n
  182           aT ype := 'Er ror gettin g Record I D Type ' +  E.Message ;
  183           Re sult := Fa lse;
  184         end;
  185     end;
  186   end;
  187  
  188   function T WVControll er.getEDDM ethod: str ing;
  189   begin
  190     // Note:  This meth od is blan k until a  call to TW VControlle r.EditPreg LacData is  made
  191     // This  is by desi gn and if  the value  is needed  sooner the n a pre-em ptive call  is needed .
  192     if fEDDM ethod <> ' ' then
  193       Result  := fEDDMe thod
  194     else
  195       Result  := 'EDD i nput metho d unknown. ';
  196   end;
  197  
  198   function T WVControll er.getWebS ite(aIndex : integer) : IWVWebSi te;
  199   begin
  200     InitCont roller;
  201     try
  202       fWebSi tes.Items[ aIndex].Ge tInterface (IWVWebSit e, Result) ;
  203     except
  204       Result  := nil;
  205     end;
  206   end;
  207  
  208   function T WVControll er.GetWebS iteURL(aWe bSiteName:  string):  string;
  209   var
  210     aWebsite : TWVWebSi te;
  211   begin
  212     for aWeb site in fW ebSites do
  213       if Com pareStr(aW ebsite.Get Name, aWeb SiteName)  = 0 then
  214         begi n
  215           Re sult := aW ebsite.Get URL;
  216           Br eak;
  217         end;
  218   end;
  219  
  220   function T WVControll er.getWebS iteCount:  integer;
  221   begin
  222     InitCont roller;
  223     Result : = fWebSite s.Count;
  224   end;
  225  
  226   function T WVControll er.getWebS iteListNam e: string;
  227   begin
  228     InitCont roller;
  229     Result : = fWebSite ListName;
  230   end;
  231  
  232   function T WVControll er.InitCon troller(aF orceInit:  boolean =  False): bo olean;
  233   var
  234     aReturn:  TStringLi st;
  235     i: integ er;
  236   begin
  237     if not f Initialize d then
  238       begin
  239         aRet urn := TSt ringList.C reate;
  240         try
  241           Ca llVistA(RP C_WEBSITES , [], aRet urn);
  242           if  aReturn.C ount < 1 t hen
  243              fWebSiteLi stName :=  'Error loa ding Web S ites!'
  244           el se
  245              begin
  246                fWebSite ListName : = aReturn[ 0];
  247                for i :=  1 to aRet urn.Count  - 1 do
  248                  fWebSi tes.Add(TW VWebSite.C reate(aRet urn[i]));
  249              end;
  250           fI nitialized  := True;
  251         fina lly
  252           Fr eeAndNil(a Return);
  253         end;
  254       end;
  255     Result : = fInitial ized;
  256   end;
  257  
  258   function T WVControll er.IsValid WVPatient( aDFN: stri ng): boole an;
  259   var
  260     aList: T StringList ;
  261   begin
  262     aList :=  TStringLi st.Create;
  263     try
  264       CallVi stA(RPC_CO VER, [aDFN ], aList);
  265       Result  := aList[ 0] <> '0';
  266     except
  267       Result  := False;
  268     end;
  269     FreeAndN il(aList);
  270   end;
  271  
  272   function T WVControll er.MarkAsE nteredInEr ror(aItemI D: string) : boolean;
  273   var
  274     aList: T StringList ;
  275   begin
  276     fLastErr or := '';
  277     aList :=  TStringLi st.Create;
  278     with New WVEIEReaso nsDlg do
  279       try
  280         Call VistA(RPC_ REASONS, [ ], aList);
  281         AddR eason(aLis t);
  282         if E xecute the n
  283           tr y
  284              GetReasons (aList);
  285              CallVistA( RPC_EIE, [ aItemID, a List], aLi st);
  286              with NewDe limitedStr ing(aList[ 0]) do
  287                try
  288                  Result  := GetPie ceAsIntege r(1) = 1;
  289                  if not  Result th en
  290                    fLas tError :=  GetPiece(2 );
  291                finally
  292                  Free;
  293                end;
  294           ex cept
  295              on E: Exce ption do
  296                begin
  297                  fLastE rror := E. Message;
  298                  Result  := False;
  299                end;
  300           en d
  301         else
  302           Re sult := Tr ue;
  303       finall y
  304         Free ;
  305       end;
  306     FreeAndN il(aList);
  307   end;
  308  
  309   function T WVControll er.OpenExt ernalWebsi te(aWebsit e: IWVWebS ite): bool ean;
  310   begin
  311     try
  312       ShellE xecute(0,  'open', PW ideChar(aW ebsite.URL ), nil, ni l, SW_SHOW NORMAL);
  313       Result  := True;
  314     except
  315       on E:  Exception  do
  316         begi n
  317           fL astError : = E.Messag e;
  318           Re sult := Fa lse;
  319         end;
  320     end;
  321   end;
  322  
  323   function T WVControll er.SavePre gnancyAndL actationDa ta(aList:  TStrings):  boolean;
  324   begin
  325     try
  326       CallVi stA(RPC_SA VEDATA, [a List], aLi st);
  327       with N ewDelimite dString(aL ist[0]) do
  328         try
  329           Re sult := (G etPieceAsI nteger(1)  = 1);
  330           if  not Resul t then
  331              fLastError  := GetPie ce(2);
  332         fina lly
  333           Fr ee;
  334         end;
  335     except
  336       on E:  Exception  do
  337         begi n
  338           fL astError : = E.Messag e;
  339           Re sult := Fa lse;
  340         end;
  341     end;
  342   end;
  343  
  344   end.

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