16. EPMO Open Source Coordination Office Redaction File Detail Report

Produced by Araxis Merge on 4/16/2019 12:20:46 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.

16.1 Files compared

# Location File Last Modified
1 C:\AraxisMergeCompare\Pri_un\CPRS_32_P2_PCE\OR_30_405V60_SRC\10_2\PKI\Source oPKIEncryption.pas Wed Dec 12 14:05:02 2018 UTC
2 C:\AraxisMergeCompare\Pri_re\CPRS v32 P2 PCE Standardization-redacted\CPRS_32_P2_PCE\OR_30_405V60_SRC\10_2\PKI\Source oPKIEncryption.pas Tue Apr 16 14:08:30 2019 UTC

16.2 Comparison summary

Description Between
Files 1 and 2
Text Blocks Lines
Unchanged 5 946
Changed 4 8
Inserted 0 0
Removed 0 0

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

16.4 Active regular expressions

No regular expressions were active.

16.5 Comparison detail

  1   unit oPKIE ncryption;
  2  
  3   interface
  4  
  5   uses
  6     System.C lasses,
  7     System.S ysUtils,
  8     TRPCB,
  9     wcrypt2;
  10  
  11   type
  12     EPKIEncr yptionErro r = class( Exception) ;
  13  
  14     TPKIPINR esult = (p rOK, prCan cel, prLoc ked, prErr or);
  15  
  16     TPKISANL ink = (slO K, slBlank VistA, slM isMatch, s lNoCertFou nd, slVist AError, sl Error);
  17  
  18     TPKIHash Algorithm  = (ha128,  ha256, ha3 84, ha512) ;
  19  
  20     TPKIEncr yptionLogE vent = pro cedure(con st aMessag e: string)  of object ;
  21  
  22     IPKIEncr yptionEngi ne = inter face;
  23     IPKIEncr yptionData  = interfa ce;
  24     IPKIEncr yptionSign ature = in terface;
  25  
  26     IPKIEncr yptionEngi ne = inter face(IInte rface)
  27       ['{RED ACTED}']
  28       functi on getVist AUserName:  string;
  29       functi on getIsCa rdReaderRe ady: boole an;
  30       functi on getSANF romCard: s tring;
  31       functi on getSANF romVistA:  string;
  32       functi on getSANL ink: TPKIS ANLink;
  33       functi on getEngi neVersion:  string;
  34       functi on getCSPN ame: strin g;
  35       functi on getHash Algorithm:  string;
  36  
  37       proced ure setOnL ogEvent(co nst aOnLog Event: TPK IEncryptio nLogEvent) ;
  38  
  39       proced ure ClearP IN;
  40       proced ure Displa yProviders ;
  41       proced ure GetCer tificates( aList: TSt rings);
  42       proced ure HashDa ta(aPKIEnc ryptionDat a: IPKIEnc ryptionDat a);
  43       proced ure LinkSA NtoVistA;
  44       proced ure SignDa ta(aPKIEnc ryptionDat a: IPKIEnc ryptionDat a);
  45       proced ure Valida teSignatur e(aPKIEncr yptionSign ature: IPK IEncryptio nSignature );
  46       proced ure SaveSi gnature(aP KIEncrypti onData: IP KIEncrypti onData);
  47  
  48       proper ty OnLogEv ent: TPKIE ncryptionL ogEvent wr ite setOnL ogEvent;
  49  
  50       proper ty EngineV ersion: st ring read  getEngineV ersion;
  51       proper ty IsCardR eaderReady : boolean  read getIs CardReader Ready;
  52       proper ty SANFrom Card: stri ng read ge tSANFromCa rd;
  53       proper ty SANFrom VistA: str ing read g etSANFromV istA;
  54       proper ty VistAUs erName: st ring read  getVistAUs erName;
  55       proper ty SANLink : TPKISANL ink read g etSANLink;
  56       proper ty CSPName : string r ead getCSP Name;
  57       proper ty HashAlg orithm: st ring read  getHashAlg orithm;
  58     end;
  59  
  60     IPKIEncr yptionData  = interfa ce(IInterf ace)
  61       ['{RED ACTED}']
  62       functi on getBuff er: string ;
  63       functi on getHash Text: stri ng;
  64       functi on getHash Hex: strin g;
  65       functi on getHash Value: Ans iString;
  66       functi on getSign ature: str ing;
  67       functi on getSign atureID: s tring;
  68       functi on getCrlU RL: string ;
  69       functi on getDate TimeSigned : TDateTim e;
  70       functi on getFMDa teTimeSign ed: string ;
  71  
  72       proced ure setBuf fer(const  aValue: st ring);
  73  
  74       proced ure Append ToBuffer(a Strings: a rray of st ring);
  75       proced ure Clear;
  76       proced ure Valida te;
  77  
  78       proper ty Buffer:  string re ad getBuff er write s etBuffer;
  79       proper ty HashTex t: string  read getHa shText;
  80       proper ty HashHex : string r ead getHas hHex;
  81       proper ty Signatu re: string  read getS ignature;
  82       proper ty Signatu reID: stri ng read ge tSignature ID;
  83       proper ty CrlURL:  string re ad getCrlU RL;
  84       proper ty DateTim eSigned: T DateTime r ead getDat eTimeSigne d;
  85       proper ty FMDateT imeSigned:  string re ad getFMDa teTimeSign ed;
  86     end;
  87  
  88     IPKIEncr yptionData DEAOrder =  interface (IPKIEncry ptionData)
  89       ['{RED ACTED}']
  90       functi on getDEAN umber: str ing;
  91       functi on getDeto xNumber: s tring;
  92       functi on getDire ctions: st ring;
  93       functi on getDrug Name: stri ng;
  94       functi on getIsDE ASig: bool ean;
  95       functi on getIssu anceDate:  string;
  96       functi on getOrde rNumber: s tring;
  97       functi on getPati entAddress : string;
  98       functi on getPati entName: s tring;
  99       functi on getProv iderAddres s: string;
  100       functi on getProv iderName:  string;
  101       functi on getQuan tity: stri ng;
  102  
  103       proced ure setDEA Number(con st aValue:  string);
  104       proced ure setDet oxNumber(c onst aValu e: string) ;
  105       proced ure setDir ections(co nst aValue : string);
  106       proced ure setDru gName(cons t aValue:  string);
  107       proced ure setIsD EASig(cons t aValue:  boolean);
  108       proced ure setIss uanceDate( const aVal ue: string );
  109       proced ure setOrd erNumber(c onst aValu e: string) ;
  110       proced ure setPat ientAddres s(const aV alue: stri ng);
  111       proced ure setPat ientName(c onst aValu e: string) ;
  112       proced ure setPro viderAddre ss(const a Value: str ing);
  113       proced ure setPro viderName( const aVal ue: string );
  114       proced ure setQua ntity(cons t aValue:  string);
  115  
  116       proced ure LoadFr omVistA(aR PCBroker:  TRPCBroker ; aPatient DFN, aUser DUZ, aCPRS OrderNumbe r: string) ;
  117  
  118       proper ty IsDEASi g: boolean  read getI sDEASig wr ite setIsD EASig;
  119       proper ty Issuanc eDate: str ing read g etIssuance Date write  setIssuan ceDate;
  120       proper ty Patient Name: stri ng read ge tPatientNa me write s etPatientN ame;
  121       proper ty Patient Address: s tring read  getPatien tAddress w rite setPa tientAddre ss;
  122       proper ty DrugNam e: string  read getDr ugName wri te setDrug Name;
  123       proper ty Quantit y: string  read getQu antity wri te setQuan tity;
  124       proper ty Directi ons: strin g read get Directions  write set Directions ;
  125       proper ty DetoxNu mber: stri ng read ge tDetoxNumb er write s etDetoxNum ber;
  126       proper ty Provide rName: str ing read g etProvider Name write  setProvid erName;
  127       proper ty Provide rAddress:  string rea d getProvi derAddress  write set ProviderAd dress;
  128       proper ty DEANumb er: string  read getD EANumber w rite setDE ANumber;
  129       proper ty OrderNu mber: stri ng read ge tOrderNumb er write s etOrderNum ber;
  130     end;
  131  
  132     IPKIEncr yptionSign ature = in terface(II nterface)
  133       ['{RED ACTED}']
  134       functi on getHash Text: stri ng;
  135       functi on getDate TimeSigned : string;
  136       functi on getSign ature: str ing;
  137  
  138       proced ure setHas hText(cons t aValue:  string);
  139       proced ure setDat eTimeSigne d(const aV alue: stri ng);
  140       proced ure setSig nature(con st aValue:  string);
  141  
  142       proced ure LoadSi gnature(co nst aValue : TStringL ist);
  143  
  144       proper ty DataStr ing: strin g read get HashText w rite setHa shText;
  145       proper ty DateTim eSigned: s tring read  getDateTi meSigned w rite setDa teTimeSign ed;
  146       proper ty Signatu re: string  read getS ignature w rite setSi gnature;
  147     end;
  148  
  149   const
  150     Version  = '1.0.2.1 ';
  151  
  152     PKI_VERS ION = 1;
  153  
  154     PKI_PIN_ RESULT: ar ray [TPKIP INResult]  of string  = ('OK', ' PIN Cancel ed', 'Card  Locked',  'PIN Error ');
  155  
  156     PKI_PIN_ MESSAGE: a rray [TPKI PINResult]  of string  = ('OK',  'User canc eled signi ng.', 'Use r card is  locked.',  'PIN Error ');
  157  
  158     PKI_SAN_ LINK_RESUL T: array [ TPKISANLin k] of stri ng = ('OK' , 'Blank v alue in Vi stA', 'Vis tA and PIV  card valu es do not  match', 'N o certific ate found  on the car d', 'Error  getting S AN from Vi stA', 'Unk nown syste m error');
  159  
  160     PKI_ENGI NE_VERSION  = '1.0.0. 1';
  161  
  162     PKI_HASH _ALGORITHM : array [T PKIHashAlg orithm] of  string =  ('SHA1RSA' , 'SHA256R SA', 'SHA3 84RSA', 'S HA512RSA') ;
  163  
  164     // PKI_A CTIVE_CLIE NT = 'Acti vClient Cr yptographi c Service  Provider';  Removed,  using regi stry value
  165  
  166     PKI_ACTI VE_CLIENT_ TYPE = 1;  // Should  probably j ust use PR OV_RSA_FUL L from the  wcrypt2.p as file in stead
  167  
  168     PKI_SCAR D_S_SUCCES S = 0;
  169  
  170     PKI_PROV IDER_TYPE  = PROV_RSA _AES; // S hould prob ably just  use PROV_R SA_AES in  the engine  to keep i t clean
  171  
  172     PKI_ENCO DING_TYPE  = PKCS_7_A SN_ENCODIN G or X509_ ASN_ENCODI NG; // <--  OR of WCr ypt2.pas c onstants
  173  
  174     DLG_8980 2000 = '89 802000^Ord er text to  be signed  is empty. ';
  175  
  176     DLG_8980 2001 = '89 802001^Use r''s DEA #  is missin g.';
  177  
  178     DLG_8980 2002 = '89 802002^Dru g Schedule  is missin g.';
  179  
  180     DLG_8980 2003 = '89 802003^No  Cert with  a valid da te found.' ;
  181  
  182     DLG_8980 2004 = '89 802004^Val id Certifi cate was n ot found.' ;
  183  
  184     DLG_8980 2005 = '89 802005^Cou ldn''t loa d CSP.';
  185  
  186     DLG_8980 2006 = '89 802006^Sma rt Card Re ader not f ound.';
  187  
  188     DLG_8980 2007 = '89 802007^Cer t with DEA  # not fou nd.';
  189  
  190     DLG_8980 2008 = '89 802008^The  Cert was  not valid  for the Dr ug Schedul e.';
  191  
  192     DLG_8980 2009 = '89 802009^Sig nature Che ck failed  (Invalid S ignature). ';
  193  
  194     DLG_8980 2010 = '89 802010^Err or reporte d by the C rypto API:  ';
  195     {
  196       DLG_89 802010 is  the genera l error th at is a ca tch all fo r several  problems.
  197       Things  that IRM  should loo k at if us er reporti ng getting  this erro r.
  198       1. See  that the  PKIserver. exe routin e is insta lled on th e server
  199       in the  WINNT\sys tem32 dire ctory.
  200       2. See  that the  PKIserver. exe routin e has been  registere d with
  201       window s.
  202       3. See  that in A dministrat or tools>s ervices th at PKIServ ice has a
  203       status  of STARTE D and its  Startup Ty pe is Auto matic.
  204     }
  205  
  206     DLG_8980 2011 = '89 802011^Cer tificate C hain not v alid.';
  207  
  208     DLG_8980 2012 = '89 802012^Car d must be  unlocked b efore link ing.';
  209  
  210     DLG_8980 2013 = '89 802013^Err or validat ing PIN, a ccount lin kage cance led.';
  211  
  212     DLG_8980 2014 = '89 802014^Una ble to sig n without  valid PIN  entry.';
  213  
  214     DLG_8980 2015 = '89 802015^Cor rupted (De code failu re).';
  215  
  216     DLG_8980 2016 = '89 802016^Cor rupted (Ha sh mismatc h).';
  217  
  218     DLG_8980 2017 = '89 802017^Cer tificate r evoked.';
  219  
  220     DLG_8980 2018 = '89 802018^Dig ital signa ture verif ication fa iled.';
  221  
  222     DLG_8980 2019 = '89 802019^Bef ore the ce rtificate  effective  date.';
  223  
  224     DLG_8980 2020 = '89 802020^Thi s certific ate or one  of the ce rtificates  in the ce rtificate  chain is n ot time-va lid.';
  225  
  226     DLG_8980 2021 = '89 802021^PIV  card cann ot be link ed without  the prope r PIN.';
  227  
  228     DLG_8980 2022 = '89 802022^Doe s not have  valid sig nature.';
  229  
  230     DLG_8980 2023 = '89 802023^Cer tificate t rust is no t properly  time-nest ed.';
  231  
  232     DLG_8980 2024 = '89 802024^Cer tificate n ot valid i n it''s pr oposed usa ge.';
  233  
  234     DLG_8980 2025 = '89 802025^The  certifica te or cert ificate ch ain is bas ed on an u ntrusted r oot.';
  235  
  236     DLG_8980 2026 = '89 802026^The  revocatio n status o f the cert ificate or  one of th e certific ates in th e certific ate chain  is unknown .';
  237  
  238     DLG_8980 2027 = '89 802027^One  of the ce rtificates  in the ch ain was is sued by a  certificat ion author ity that t he origina l certific ate had ce rtified.';
  239  
  240     DLG_8980 2028 = '89 802028^The  certifica te chain i s not comp lete.';
  241  
  242     DLG_8980 2029 = '89 802029^The  certifica te or one  of the cer tificates  in the cer tificate c hain does  not have a  valid sig nature.';
  243  
  244     DLG_8980 2030 = '89 802030^The  certifica te or cert ificate ch ain is not  valid in  its propos ed usage.' ;
  245  
  246     DLG_8980 2031 = '89 802031^Una ble to acc ess encryp tion data  via IPKIEn cryptionDa taEx Inter face.';
  247  
  248     DLG_8980 2032 = '89 802032^Tru st for thi s certific ate or one  of the ce rtificates  in the ce rtificate  chain has  been revok ed.';
  249  
  250     DLG_8980 2033 = '89 802033^Err or getting  name valu e from cer tificate.' ;
  251  
  252     DLG_8980 2034 = '89 802034^Err or establi shing cont ext with t he card re ader.';
  253  
  254     DLG_8980 2035 = '89 802035^Car d reader n ot ready o r card not  inserted  properly.' ;
  255  
  256     DLG_8980 2036 = '89 802036^Err or reporte d by the P KIServiceE ngine: ';
  257  
  258     DLG_8980 2037 = '89 802037^Inv alid Filem an DateTim e Conversi on.';
  259  
  260     DLG_8980 2038 = '89 802038^Not  marked as  DEA Order .';
  261  
  262     DLG_8980 2039 = '89 802039^DEA  Orders ca n only be  initialize d via indi vidual pro perty valu es.';
  263  
  264     DLG_8980 2040 = '89 802040^Use r canceled  connectio n.';
  265  
  266     DLG_8980 2041 = '89 802041^Una ble to ret rieve SAN  from card. ';
  267  
  268     DLG_8980 2042 = '89 802042^Con nection no t establis hed.';
  269  
  270     DLG_8980 2043 = '89 802043^Use r must hav e the XU E PCS EDIT D ATA contex t option i n their me nu tree.';
  271  
  272     DLG_8980 2044 = '89 802044^You  cannot us e this app lication i f you hold  the ORES  key.';
  273  
  274     DLG_8980 2045 = '89 802045^You  must hold  the XUEPC SEDIT key  to use thi s applicat ion.';
  275  
  276     DLG_8980 2046 = '89 802046^Sub ject Alter nate Name  (SAN) on c ard and in  VistA do  not Match. ';
  277  
  278     DLG_8980 2047 = '89 802047^Err or communi cating wit h VistA vi a the RPC  Broker Con nection.';
  279  
  280     DLG_8980 2048 = '89 802048^Vis tA Subject  Alternate  Name (SAN ) is blank .';
  281  
  282     DLG_8980 2049 = '89 802049^Una ble to upd ate VistA  Subject Al ternate Na me (SAN).' ;
  283  
  284     DLG_8980 2050 = '89 802050^PKI Server Sta tus: ';
  285  
  286     { Interf ace Factor ies and Ot her Utilit ies }
  287   procedure  NewPKIEncr yptionData (var aPKIE ncryptionD ata: IPKIE ncryptionD ata);
  288   procedure  NewPKIEncr yptionData DEAOrder(v ar aPKIEnc ryptionDat aDEAOrder:  IPKIEncry ptionDataD EAOrder);
  289   procedure  NewPKIEncr yptionEngi ne(aRPCBro ker: TRPCB roker; var  aPKIEncry ptionEngin e: IPKIEnc ryptionEng ine);
  290   procedure  NewPKIEncr yptionSign ature(var  aPKIEncryp tionSignat ure: IPKIE ncryptionS ignature);
  291  
  292   procedure  TDateTime2 FMDateTime (const aTD ateTime: T DateTime;  var aFMDat eTime: str ing; aIncl udeTime: b oolean = T rue; aIncl udeSeconds : boolean  = True);
  293   procedure  FMDateTime 2TDateTime (const aFM DateTime:  string; va r aDateTim e: TDateTi me);
  294   procedure  GetPINValu e(var aPin Value: str ing);
  295  
  296   function G etLastSyst emError: s tring;
  297   function I sDigitalSi gnatureAva ilable(aPK IEncryptio nEngine: I PKIEncrypt ionEngine;  var aMess age: strin g; aSucces sfulLinkMe ssage: str ing = ''):  boolean;
  298   function V erifyPKIPI N(aPKIEncr yptionEngi ne: IPKIEn cryptionEn gine): TPK IPINResult ;
  299   function D ialogAsMes sage(aDial og: string ): string;
  300  
  301   implementa tion
  302  
  303   uses
  304     VAUtils,
  305     System.U ITypes,
  306     fPKIPINP rompt,
  307     oPKIEncr yptionEngi ne,
  308     oPKIEncr yptionData ,
  309     oPKIEncr yptionData DEAOrder,
  310     oPKIEncr yptionSign ature;
  311  
  312   const
  313     SAN_LINK _NEEDED =
  314       'Your  VistA acco unt has no t been lin ked to thi s PIV card .' + #13#1 0 +
  315       'Would  you like  to link th is PIV car d now?';
  316  
  317     SAN_LINK _SUCCESS =
  318       'Your  PIV card ( %s) has be en success fully link ed' + #13# 10 +
  319       'to yo ur VistA a ccount, wh ich will a llow you t o digitall y sign.';
  320  
  321     SAN_LINK _FAILURE =
  322       '%s' +  #13#10 +
  323       'VistA  was not a ble to lin k this PIV  card to y our accoun t.' + #13# 10 +
  324       'One p ossible ca use is tha t your car d is alrea dy linked  to another  VistA acc ount.';
  325  
  326     { Factor ies }
  327  
  328   procedure  NewPKIEncr yptionEngi ne(aRPCBro ker: TRPCB roker; var  aPKIEncry ptionEngin e: IPKIEnc ryptionEng ine);
  329   begin
  330     TPKIEncr yptionEngi ne.Create( aRPCBroker ).GetInter face(IPKIE ncryptionE ngine, aPK IEncryptio nEngine);
  331   end;
  332  
  333   procedure  NewPKIEncr yptionData (var aPKIE ncryptionD ata: IPKIE ncryptionD ata);
  334   begin
  335     TPKIEncr yptionData .Create.Ge tInterface (IPKIEncry ptionData,  aPKIEncry ptionData) ;
  336   end;
  337  
  338   procedure  NewPKIEncr yptionData DEAOrder(v ar aPKIEnc ryptionDat aDEAOrder:  IPKIEncry ptionDataD EAOrder);
  339   begin
  340     TPKIEncr yptionData DEAOrder.C reate.GetI nterface(I PKIEncrypt ionDataDEA Order, aPK IEncryptio nDataDEAOr der);
  341   end;
  342  
  343   procedure  NewPKIEncr yptionSign ature(var  aPKIEncryp tionSignat ure: IPKIE ncryptionS ignature);
  344   begin
  345     TPKIEncr yptionSign ature.Crea te.GetInte rface(IPKI Encryption Signature,  aPKIEncry ptionSigna ture);
  346   end;
  347  
  348   { Utilitie s }
  349  
  350   function G etLastSyst emError: s tring;
  351   begin
  352     Result : = Format(' %s x%8x: % s', [DLG_8 9802010, G etLastErro r, SysErro rMessage(G etLastErro r)]);
  353   end;
  354  
  355   function D ialogAsMes sage(aDial og: string ): string;
  356   begin
  357     Result : = Copy(aDi alog, 1, P os('^', aD ialog) - 1 ) +
  358       ': ' +
  359       Copy(a Dialog, Po s('^', aDi alog) + 1,  Length(aD ialog));
  360   end;
  361  
  362   procedure  TDateTime2 FMDateTime (const aTD ateTime: T DateTime;  var aFMDat eTime: str ing; aIncl udeTime: b oolean = T rue; aIncl udeSeconds : boolean  = True);
  363   var
  364     aYear, a Month, aDa y: Word;
  365     aHour, a Minute, aS econd, aMi lliSecond:  Word;
  366   begin
  367     DecodeDa te(aTDateT ime, aYear , aMonth,  aDay);
  368     aFMDateT ime := Int ToStr(aYea r - 1700)  + Format(' %.2d', [aM onth]) + F ormat('%.2 d', [aDay] );
  369     if aIncl udeTime th en
  370       begin
  371         Deco deTime(aTD ateTime, a Hour, aMin ute, aSeco nd, aMilli Second);
  372         aFMD ateTime :=  aFMDateTi me + '.' +  Format('% .2d', [aHo ur]) + For mat('%.2d' , [aMinute ]);
  373         if a IncludeSec onds then
  374           aF MDateTime  := aFMDate Time + For mat('%.2d' , [aSecond ]);
  375       end;
  376     while (L ength(aFMD ateTime) >  7) and (( Copy(aFMDa teTime, Le ngth(aFMDa teTime), 1 ) = '0') o r (Copy(aF MDateTime,  Length(aF MDateTime) , 1) = '.' )) do
  377       aFMDat eTime := C opy(aFMDat eTime, 1,  Length(aFM DateTime)  - 1);
  378   end;
  379  
  380   procedure  FMDateTime 2TDateTime (const aFM DateTime:  string; va r aDateTim e: TDateTi me);
  381   var
  382     aFMDateS tring: str ing;
  383     aYear, a Month, aDa y: Word;
  384     aHour, a Minute, aS econd: Wor d;
  385   begin
  386     try
  387       aDateT ime := 0;
  388       aFMDat eString :=  Format('% 0.6f', [St rToFloat(a FMDateTime ) + 0.0000 001]);
  389       aYear  := StrToIn tDef(Copy( aFMDateStr ing, 1, 3) , -1);
  390       if aYe ar > 0 the n
  391         inc( aYear, 170 0);
  392       aMonth  := StrToI ntDef(Copy (aFMDateSt ring, 4, 2 ), -1);
  393       aDay : = StrToInt Def(Copy(a FMDateStri ng, 6, 2),  -1);
  394  
  395       aHour  := StrToIn tDef(Copy( aFMDateStr ing, 9, 2) , 0);
  396       aMinut e := StrTo IntDef(Cop y(aFMDateS tring, 11,  2), 0);
  397       aSecon d := StrTo IntDef(Cop y(aFMDateS tring, 13,  2), 0);
  398  
  399       aDateT ime := Enc odeDate(aY ear, aMont h, aDay) +  EncodeTim e(aHour, a Minute, aS econd, 0);
  400     except
  401       raise  EPKIEncryp tionError. Create(DLG _89802037  + aFMDateT ime);
  402     end;
  403   end;
  404  
  405   function V erifyPKIPI N(aPKIEncr yptionEngi ne: IPKIEn cryptionEn gine): TPK IPINResult ;
  406   begin
  407     Result : = prOK;
  408     //Result  := TfrmPK IPINPrompt .VerifyPKI PIN(aPKIEn cryptionEn gine);
  409   end;
  410  
  411   procedure  GetPINValu e(var aPin Value: str ing);
  412   begin
  413     aPinValu e := TfrmP KIPINPromp t.GetPINVa lue;
  414   end;
  415  
  416   function I sDigitalSi gnatureAva ilable(aPK IEncryptio nEngine: I PKIEncrypt ionEngine;  var aMess age: strin g; aSucces sfulLinkMe ssage: str ing = ''):  boolean;
  417   { Does the  prelimina ry work of  verifying  the card  is ready a nd the SAN  linkage i s correct  }
  418   var
  419     aSuccess Message: s tring;
  420   begin
  421     try
  422       while  not aPKIEn cryptionEn gine.IsCar dReaderRea dy do
  423         begi n
  424           if  ShowMsg(' Please ins ert your P IV card or  press can cel to exi t.', 'Card  Reader No t Ready',  smiInfo, s mbRetryCan cel) <> sm rRetry the n
  425              raise EPKI Encryption Error.Crea te(DLG_898 02035);
  426           Sl eep(4000);  // Painfu l but the  card will  need time  to synch u p
  427         end;
  428  
  429       case a PKIEncrypt ionEngine. SANLink of
  430         slOK : // Good  To Go!
  431           be gin
  432              aMessage : = 'OK';
  433           en d;
  434  
  435         slBl ankVistA:  // Offer t o Update t he SAN in  VistA, oth erwise bai l with exc eption
  436           be gin
  437              if ShowMsg (SAN_LINK_ NEEDED, 'L ink PIV Ca rd', smiQu estion, sm bYesNo) =  smrYes the n
  438                try
  439                  aPKIEn cryptionEn gine.LinkS ANtoVistA;  // This w ill raise  an excepti on if it f ails, othe rwise upda te is good
  440  
  441                  // Bui ld default  success m essage
  442                  aSucce ssMessage  := Format( SAN_LINK_S UCCESS, [a PKIEncrypt ionEngine. VistAUserN ame]);
  443  
  444                  // if  aSuccessfu lLinkMessa ge has tex t, append  it to the  success me ssage
  445                  if aSu ccessfulLi nkMessage  <> '' then
  446                    aSuc cessMessag e := aSucc essMessage  + #13#10  + aSuccess fulLinkMes sage;
  447  
  448                  // Rep ort the su ccessful l inking
  449                  ShowMs g(aSuccess Message, ' Successful ly Linked' , smiInfo,  smbOK);
  450                except
  451                  raise  EPKIEncryp tionError. CreateFmt( SAN_LINK_F AILURE, [a PKIEncrypt ionEngine. VistAUserN ame]);
  452                end
  453              else
  454                raise EP KIEncrypti onError.Cr eate(DLG_8 9802048);
  455           en d;
  456  
  457         slMi sMatch: //  Both name s exist bu t are diff erent (Non -Case Sens itive matc h used)
  458           ra ise EPKIEn cryptionEr ror.Create (DLG_89802 046);
  459  
  460         slNo CertFound:  // Proble m finding  the cert o n the card , SAN is r eturned bl ank
  461           ra ise EPKIEn cryptionEr ror.Create (DLG_89802 041);
  462       else
  463         rais e EPKIEncr yptionErro r.Create(D LG_8980204 1);
  464       end;
  465  
  466       aMessa ge := 'OK' ;
  467       Result  := True;
  468     except
  469       on E:  Exception  do
  470         begi n
  471           Re sult := Fa lse;
  472           aM essage :=  E.Message;
  473         end;
  474     end;
  475   end;
  476  
  477   end.