16. EPMO Open Source Coordination Office Redaction File Detail Report

Produced by Araxis Merge on 11/2/2017 7:18:08 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.

16.1 Files compared

# Location File Last Modified
1 CAPRI_CIF.zip\CAPRI_CIF\Source main.pas Wed Nov 1 18:09:34 2017 UTC
2 CAPRI_CIF.zip\CAPRI_CIF\Source main.pas Wed Nov 1 19:26:07 2017 UTC

16.2 Comparison summary

Description Between
Files 1 and 2
Text Blocks Lines
Unchanged 14 41864
Changed 13 56
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 main;
  2  
  3   // April 2 007
  4   // NOTE -- ---------- ---------- ------
  5   // Changes  to suppor t CAPRI, r emote logi ns exist i n the RPC  Broker uni ts
  6   // TRPCB a nd CCOWRPC BROKER
  7   // All cha nges can b e found by  searching  for DVB a nd ANU.
  8  
  9   // JANUARY  30, 2005  *****
  10  
  11   // Added " details" b utton to m  emo boxes  on PNCS t emplates.   The butto n will
  12   // display  a larger  pop up, al lowing use rs more ro om to ente r and view  their
  13   // respons es
  14  
  15   // Added/e nabled CCO W patient  context fu nctionalit y.
  16  
  17   // Added t he ability  to remove  or add fo rms to a P NCS templa te, even a fter the
  18   // user ha s already  started us ing the te mplate.
  19  
  20   // FEBRUAR Y 6, 2005  *****
  21  
  22   // Script  processing  mods to s peed up so me repetit ive proces ses in the  script
  23   // engine
  24  
  25   // Updated  CPWMObjec ts with Ed 's fix to  properly e xecute scr ipt when s witching
  26   // to a ta b only use d by one f orm.  The  script did n't kick o ff if a di fferent
  27   // form wa s in use,  then then  user switc hes to ano ther tab b ut it auto matically
  28   // switche s to a dif ferent for m because  the previo us form di dn't have  that tab.
  29  
  30   // Cancel  feature ad ded for te mplates
  31  
  32   // Save ha s been upd ated to fi rst save t o a failsa fe locatio n, then th e real
  33   // locatio n.  This p revents lo st data if  there is  a network  failure.
  34   // There s hould alwa ys be some thing, eve n if it's  the previo us version  of
  35   // the sav ed form
  36  
  37   // FEBRUAR Y 14, 2005
  38   // Added n ews featur e in lower  right of  main CAPRI  window
  39   // Icon sh ould chang e when new  news and  when it's  all been r ead
  40  
  41   // FEBRUAR Y 15,2005
  42   // Templat es can no  longer be  overlayed  on top of  an exam in  AMIE that 's in an
  43   // open st ate and is  in the mi ddle of be ing transc ribed.  Th is glitch  was
  44   // reporte d by a sit e testing  of DVBA*2. 7*71.
  45  
  46   // FEBRUAR Y 16, 2005
  47   // Cancel  feature ad ded to tem plates
  48  
  49   // FEBRUAR Y 17, 2005
  50   // Redunda nt save ad ded to for m save pro cess.
  51   // On rest art, the u ser will b e prompted  for a bac kup versio n to load
  52   // if ther e is a pro blem savin g and a fo rm being s aved doesn 't get
  53   // stored  in VistA.
  54   // Using t he delete  button on  the keyboa rd to dele te a templ ate was
  55   // causing  an except ion
  56  
  57   // FEBRUAR Y 18, 2005
  58   // Record  locking im plemented.
  59   // A templ ate can no w only be  opened by  one user a t a time.
  60  
  61   // FEBRUAR Y 22, 2005
  62   // News fu nction now  goes dire ctly to th e CPEP web server.
  63  
  64   // MARCH 1 , 2005
  65   // Added V HA report  to view te mplate lis t, includi ng status
  66  
  67   // MARCH 2 , 2005
  68   // Modifie d VHA temp late repor t to inclu de sort cr iteria
  69  
  70   // MARCH 3 ,2005
  71   // Added o ption to s elect a fo nt in the  VistA term inal
  72   // VistA t erminal wi ll remembe r last fon t, font si ze, window  size, win dow
  73   // positio n if CAPRI  is exited  normally.
  74   // Added o ption to e xclude "co mpleted" e xams from  the VHA te mplate rep ort.
  75  
  76   // MARCH 4 , 2005
  77   // 1U4N (1 st letter  last name  + last 4 o f SSN) has  been adde d
  78   // as an i dentifier  in the uns igned form s dialog
  79  
  80   // MARCH 9 , 2005
  81   // Ability  to edit a ddress on  admin tab  and when e ntering a  new C&P ha s
  82   // been re moved.  In stead, add ress chang es will be  copied in to the tex t of
  83   // the C&P  request.
  84  
  85   // MARCH 1 0, 2005
  86   // Copy te mplate but ton added  to C&P Wor ksheet tab .
  87  
  88   // There i s a new to ol to rest ore from a  previous  form.  It' s under "O PTIONS."   Autosave w ill create  a restore  point.
  89   // The use r can crea te their o wn restore  point wit h the "sav e" button.   All rest ore points  will be d eleted onc e the form  is signed .
  90  
  91   // MARCH 1 5, 2005
  92   // Save/lo ad functio n in a tem plate save s the colo r info wit h control  data
  93   // Load fe ature fixe d.  Some c ontrols we ren't popu lating cor rectly
  94   // Info bu tton in a  template w ill show i n what ver sion of CA PRI the fo rm
  95   // was las t saved.
  96  
  97   // MARCH 1 7, 2005
  98   // Patient  entry now  runs a ro utine to c heck for p otential m atches
  99   // User ca n cancel o r continue  after dis play.
  100  
  101   // MARCH 2 , 2005
  102   // Added c ode to dea l with TIU  blank cha racter str ing of "** *".
  103   // Some te mplates we re display ing the me ssage abou t the docu ment havin g
  104   // blanks  (Joints, f or example ) when the  site had  set their  string to
  105   // "***" i n TIU.
  106  
  107   // MARCH 2 3
  108   // Faster  form start up.
  109   // Resolve d issue of  flickerin g hourglas s during f irstrun an d lastrun
  110   // script  processing .
  111   // It was  possible t o click a  button, th en click a nother one  but the f irst one h adn't
  112   // been pr ocessed ye t.  Change d it to ig nore subse quent butt ons until  the first  is process ed.
  113  
  114   // MARCH 2 8
  115   // Modifie d co-signa ture trans fer option  to not al low transf er into an  exam
  116   // if ther e's alread y data the re.  This  probably m eans the n ote is in
  117   // the mid dle of bei ng transcr ibed.
  118  
  119   // APRIL 1
  120   // Seattle  is concer ned non C& P alerts a re showing  in the co -signature
  121   // alert w indow.  Lo gic was ad ded to fil ter for ju st C&P one s.  It's t he same
  122   // logic u sed on the  signature  screen to  look for  C&P titles .
  123  
  124   // APRIL 7
  125   // VBA wan ts a way t o add a da te of addr ess info w hen enteri ng a new C &P
  126   // and tel ling it th ere's an a ddress cha nge
  127  
  128   // APRIL 1 1
  129   // Shawnta  found an  issue wher e address  could stil l be edite d on the a dmin tab
  130   // Address  edit has  been disab led but no t removed,  in case V BA changes  its mind
  131   // Changed  label "1U 4N" to "ID " on the u nsigned fo rms dialog .
  132  
  133   ////////// ////////// ////////// ////////// ////////// ////////// ///////
  134  
  135   // The thi ngs below  will are i n this ver sion but w ill be dis abled unti l
  136   // the nex t version  of CAPRI
  137  
  138   // APRIL 1 1
  139   // Under t ools, edit  C&P repor ts for the  loaded pt . has been  added.
  140   // Allows  re-opening  of releas ed exams s o they can  be edited  and
  141   // re-prin ted or rel ease of op en exams s till needi ng release .
  142  
  143   ////////// ////////// ////////// ////////// ////////// ////////// ////////
  144   //
  145   // APRIL 2 2
  146   // Timeout  was being  read from  the conne cted site  when switc hing sites .
  147   // This wa s overridi ng the Cla ims system  timeout v alue.
  148  
  149   // TEST SI TE ISSUES:
  150  
  151   // April 2 5:
  152   // Remedy  Ticked 106 388 by VBA .  Duplex  printing i s difficul t and non- functional .
  153   // A new p rinters di alog box w as added t hat will p op up anyt ime someth ing is
  154   // printed .
  155  
  156   // June 20 05 changes
  157  
  158   // Spell c heck funct ion has be en added.   Access it  with F7.   It'll spe llcheck an
  159   // active  control, I F it's a t ype it's b een allowe d to check .  If it's  a read-on ly
  160   // control  (like pro gress note s on the c linical do cument tab ), it'll s till check  the\
  161   // spellin g but then  warn the  user it ca n't overwr ite the te xt.  This  is by desi gn.
  162  
  163   // Variabl es for run ning forms  will be s aved betwe en session s.  If you  save a fo rm
  164   // and loo k at it in  VistA, yo u'll see t he variabl e info at  the beginn ing of the
  165   // saved f orm file
  166  
  167   // When a  new templa te is star ted, an au tosave kic ks off imm ediately s o somethin g
  168   // will sh ow if the  user tries  to revert  to an old  version.
  169  
  170   // Medical  Opinion f orm can be  added wit h a checkb ox.
  171  
  172   // Details  popus on  CPWM forms  modified  to let the  user chan ge the hei ght, move  them, etc.
  173   // Spellch eck added  to details  popup
  174   // Details  popup cha nged to no t close un til user c hooses to  close it
  175  
  176   //  Rich c lick menu  added to f orms for m emos and e dit boxes  to support  spell che ck
  177  
  178   // Added t raining we bsite to h elp menu
  179  
  180   // Report  text of CP WM Form ha s been hig hlighted w ith colors  to make u ser
  181   // vs. pro mpt text s tand out.
  182  
  183   // July 20 05 Changes
  184  
  185   // Fixed d ate calcul ation on " special" r eport type  used by V BA on repo rts dialog .
  186  
  187   // CAPRI w ill autode tect confl icting CPW M keys at  startup an d display  a warning  to the use r.
  188  
  189   // Data wa s being lo st during  cloning of  objects o n merged f orms, when  objects m atched.
  190  
  191   // RTF Sup port added  to CPWM R eports
  192  
  193   // RTF Pri nting Supp ort added  to CPWM pr int previe w screen
  194  
  195   // Wilming ton was no t showing  in the div ision list  due to ch anges made  in the na tional ins tution fil e
  196   // It will  be forced  into the  list.
  197  
  198   // Errors  with divis ion settin g function  when firs t connecti ng to a si te have be en
  199   // fixed.
  200  
  201   // August  2005 Chang es
  202  
  203   // Sped up  script pr ocessing.   Certain c ommands, l ike the go to command , were ine fficient
  204  
  205   // Cache l atitude an d longitud e for zipc ode distan ce lookup  when enter ing a new  C&P
  206   // request .  Kansas  was having  a problem  for slown ess.  Once  a lat/lon g is found , it'll be
  207   // saved f or later r eference,  which spee ds up the  distance c alculation  process
  208   // conside rably.
  209  
  210   // 200HD,  HDR is sho wing in th e other fa cilities v isited lis t.  It's n ot really  a VistA
  211   // system  that CAPRI  can switc h to.  It' s been rem oved from  the list b ut will st ill
  212   // show on  the "addi tional tre ating faci lities" re port on th e reports  tab.
  213  
  214   // Stephen ie Wallace  (Tuscaloo sa) reques ted the al erts dialo g be chang ed to spli t up
  215   // unsigne d template s into dra ft, awaiti ng signatu re, and se nt back.
  216  
  217   // Zach fo und a prob lem wherei n a user n eeding co- signature  would get  a box popp ing up
  218   // at sign ature tell ing them t hey haven' t selected  enough ex ams to clo se out.  B ut they
  219   // can't b ecause the y need co- signer.  T he box was  removed i f co-signe r is selec ted.
  220  
  221   // Oct 200 5
  222   // Created  a way to  manage/imp ort templa tes under  TOOLS.  Ne ed to have  a high le vel
  223   // securit y key to a ccess it.
  224  
  225   // Added H yperlink t o AMIE Wor ksheets un der TOOLS.   Address  is retriev ed with ne w Broker c all
  226   // DVBAB G ET URL, pa ram 1
  227   // Routine  is DVBABU RL
  228  
  229   // October  2005
  230   // Saved f orms will  restore ba ck with th e screen e xactly as  it was whe n the user  left.  Po pup
  231   // panels  and tabs w ill be rig ht where t hey were.    Autosave  doesn't s ave the sc reen due t o the
  232   // overhea d involved .  The sav e screen o nly happen s at exit  or if the  user click s the "sav e" button.
  233  
  234   // Added a  way to pr int a blan k template  under Opt ions and u nder TOOLS  on the ma in menu.
  235  
  236   Interface
  237  
  238   Uses
  239     Windows,
  240     Messages ,
  241     Buttons,
  242     //CCOWRP CBroker,
  243     CheckLst ,
  244     Classes,
  245     ColorCap riBtn,
  246     ComCtrls ,
  247     ComCtrls 95,
  248     Controls ,
  249     Diaccess ,
  250     Dialogs,
  251     DialogsC APRI,
  252     DiTypLib ,
  253     ExtCtrls ,
  254     FileCtrl ,
  255     Fmcmpnts ,
  256     Fmcntrls ,
  257     Forms,
  258     GIFImage ,
  259     Graphics ,
  260     Grids,
  261     hash,
  262     Hyperlin kLabel,
  263     ImgList,
  264     IPTerm,
  265     JclDateT ime,
  266     jpeg,
  267     KernelUt ilities,
  268     LoginFrm ,
  269     Menus,
  270     mergePSc ripts,
  271     OffBtn,
  272     OleCtrls ,
  273     OleServe r,
  274     ORCtrls,
  275     ORDtTm,
  276     pncsCode Run,
  277     PNCSMain ,
  278     SHDocVw,
  279     SpeechLi b_TLB,
  280     StdCtrls ,
  281     SysUtils ,
  282     TabNotbk ,
  283     Trpcb,
  284     uSpell,
  285     UUCode,
  286     Vawrgrid ,
  287     VERGENCE CONTEXTORL ib_TLB,
  288     ZipMcpt,  CCOWRPCBr okerCAPRI,  CCOWRPCBr oker, Actn List, XPSt yleActnCtr ls,
  289     ActnMan,  ToolWin,  ActnCtrls,  ActnMenus , ActnPopu p,
  290     ShellAPI ,
  291     JclDebug ,
  292     patientl ist, ORCtr lsVA508Com patibility , Accessib ilityUtils ,
  293     VA508Acc essibility Manager, V AUtils,                                                //CodeCR12 4 -MER 07/ 2010
  294     Reflecti onWrapper,
  295     frmVVA,                                                                               {CodeCR353  - rpm 5/1 /12}
  296     VocRehab Class,                                                                       //CodeCR34 7 - jrl 5/ 21/12
  297     CAPRIHel pMgr,                                                                        // CodeCR3 81 - LMS 2 012-11-15
  298     Patient,
  299     clsPatie ntInfo, Ap pEvnts                                                            // CodeCR4 57 - LMS
  300   //  , FrmV lerGetExam   // moved  to Implem entation;  rpk 9/12/2 014
  301     ;
  302  
  303     // moved  TPatientI nfoBucket  to fPatien t // rpk 7 /15/2014
  304   { type
  305     TPatient InfoBucket  = class(T Object)
  306       public
  307       DFN, N ame, SSN,  DOB, AGE,  SEX, DOD,  ClaimNum:  String;
  308       NameCo mponents,  Last, Firs t, Middle:  String;
  309       Addres s1, Addres s2, Addres s3, City,  StateProv,  Zip, Coun try: Strin g;
  310       HomePh one, CellP hone, BadA ddressType , AddrssTy pe: String ;
  311       VTRN:  Boolean;
  312     end; }
  313  
  314   Type
  315     TSearchT ext = reco rd                                                                // CodeCR6 96 JRL 4/8 /15
  316       FoundA t: Integer ;                                                                 // CodeCR6 96 JRL 4/8 /15
  317       LastSe archFoundA t: Integer ;                                                      // CodeCR6 96 JRL 4/8 /15
  318       FindTe xt: String ;                                                                 // CodeCR6 96 JRL 4/8 /15
  319       Option s: Set Of  TSearchTyp e;                                                     // CodeCR6 96 JRL 4/8 /15
  320     end;                                                                                  // CodeCR6 96 JRL 4/8 /15
  321  
  322     TfrmMain  = Class(T Form)
  323       AdminD ocuments:  TTab95Shee t;
  324       BitBtn 1: TBitBtn ;
  325       BitBtn 2: TBitBtn ;
  326       BitBtn 4: TBitBtn ;
  327       BitBtn CCOWLink:  TBitBtn;
  328       BitBtn CCOWLinkBr oken: TBit Btn;
  329       BitBtn CCOWLinkCh anging: TB itBtn;
  330       BitBtn LaunchVist aWeb: TBit Btn;
  331       BitBtn NewForm: T BitBtn;
  332       BitBtn UnsignedFo rms: TBitB tn;
  333       BitBtn VistA: TBi tBtn;
  334       btnAdd 7131: TBut ton;
  335       btnAdd Request: T Button;
  336       btnAdH oc: TButto n;
  337       btnAdm issions: T Button;
  338       btnAll : TButton;
  339       btnDiv isions: TB utton;
  340       btnDoc sRefresh:  TButton;
  341       btnEdi tAddress:  TButton;
  342       btnExa mFinalRepo rt: TButto n;
  343       btnFut ure: TButt on;
  344       btnGen erate7131R eport: TBu tton;
  345       btnGen erateRepor t: TButton ;
  346       btnGra phVS: TBut ton;
  347       btnLoa dHSNames:  TButton;
  348       btnLoa dHSNamesRe moteData:  TButton;
  349       btnMul ti: TBitBt n;
  350       btnMul ti2: TBitB tn;
  351       btnPas t: TButton ;
  352       btnRef reshAddres s: TButton ;
  353       btnSav eAddress:  TButton;
  354       btnVie w7131: TBu tton;
  355       btnVie wExam: TBu tton;
  356       btnVis tAWebHome:  TBitBtn;
  357       Button 1: TButton ;
  358       Button 13: TButto n;
  359       Button 3: TButton ;
  360       Button 4: TButton ;
  361       Button 5: TButton ;
  362       Button 9: TButton ;
  363       button CancelRepo rtAdmissio n: TButton ;
  364       Button CancelSurg eryReports : TButton;
  365       button ClinDocDat eRange: TB utton;
  366       Button CountyAcce pt: TButto n;
  367       Button CPTCopyrig ht: TButto n;
  368       Button GCPRGo: TB utton;
  369       Button Graph: TBu tton;
  370       Button IPRCopy: T Button;
  371       Button IPRDelete:  TButton;
  372       Button IPRDisplay : TButton;
  373       Button IPRRefresh : TButton;
  374       button News: TBit Btn;
  375       button NewsFlash:  TBitBtn;
  376       button OKReportAd mission: T Button;
  377       Button OKSurgeryR eports: TB utton;
  378       Button OtherSites : TButton;
  379       Button RDV: TButt on;
  380       Button Search: TB utton;
  381       Button StateAccep t: TButton ;
  382       CheckB oxMailman:  TCheckBox ;
  383       CheckL istBoxRemo teData: TC heckListBo x;
  384       CNumbe r: TLabel;
  385       ComboB oxHSSectio ns: TCombo Box;
  386       County Fake: TEdi t;
  387       DateTi mePicker1:  TDateTime Picker;
  388       DateTi mePicker2:  TDateTime Picker;
  389       EditDO DMaxItems:  TEdit;
  390       editSe archPN: TE dit;
  391       ExamRe questRefre sh: TButto n;
  392       FMComm entsMemo:  TFMMemo;
  393       FMCoun tiesList:  TFMListBox ;
  394       FMEdit 1: TFMEdit ;
  395       FMEdit 10: TFMEdi t;
  396       FMEdit 11: TFMEdi t;
  397       FMEdit 2: TFMEdit ;
  398       FMEdit 3: TFMEdit ;
  399       FMEdit 4: TFMEdit ;
  400       FMEdit 5: TFMEdit ;
  401       FMEdit 6: TFMEdit ;
  402       FMEdit 7: TFMEdit ;
  403       FMEdit 8: TFMEdit ;
  404       FMEdit 9: TFMEdit ;
  405       FMEdit City: TFME dit;
  406       FMEdit County: TF MEdit;
  407       FMEdit EpisodeBeg inDateTime : TFMEdit;
  408       FMEdit EpisodeEnd DateTime:  TFMEdit;
  409       FMEdit FacilityMo vementType : TFMEdit;
  410       FMEdit IPR10: TFM Edit;
  411       FMEdit IPR11: TFM Edit;
  412       FMEdit IPR2: TFME dit;
  413       FMEdit IPR4: TFME dit;
  414       FMEdit IPR5: TFME dit;
  415       FMEdit IPR6: TFME dit;
  416       FMEdit IPR7: TFME dit;
  417       FMEdit IPR8: TFME dit;
  418       FMEdit IPRExe: TF MEdit;
  419       FMEdit MovementAt tending: T FMEdit;
  420       FMEdit MovementDa teTime: TF MEdit;
  421       FMEdit MovementPr ovider: TF MEdit;
  422       FMEdit MovementRo omBed: TFM Edit;
  423       FMEdit MovementSp ecialty: T FMEdit;
  424       FMEdit MovementTy pe: TFMEdi t;
  425       FMEdit MovementTy peofMoveme nt: TFMEdi t;
  426       FMEdit MovementWa rdLocation : TFMEdit;
  427       FMEdit Office: TF MEdit;
  428       FMEdit Phone: TFM Edit;
  429       FMEdit ReviewStat us: TFMEdi t;
  430       FMEdit State: TFM Edit;
  431       FMEdit Street1: T FMEdit;
  432       FMEdit Street2: T FMEdit;
  433       FMEdit Street3: T FMEdit;
  434       FMEdit Zip: TFMEd it;
  435       FMExam History: T FMLister;
  436       FMExam RequestLis tbox: TFML istBox;
  437       FMExam RequestLis ter1: TFML ister;
  438       FMFile r1: TFMFil er;
  439       FMFile r2: TFMFil er;
  440       FMFind er1: TFMFi nder;
  441       FMFind er2: TFMFi nder;
  442       FMGets 1: TFMGets ;
  443       FMGets 2: TFMGets ;
  444       FMGets 3: TFMGets ;
  445       FMGets 4: TFMGets ;
  446       FMGets 5: TFMGets ;
  447       FMGets 6: TFMGets ;
  448       FMGets AddRequest : TFMGets;
  449       FMGets CAPRIDivis ion: TFMGe ts;
  450       FMGets DrugFile:  TFMGets;
  451       FMGets FacilityMo vementType : TFMGets;
  452       FMGets HospitalLo cation: TF MGets;
  453       FMGets Institutio n: TFMGets ;
  454       FMGets IPRFile: T FMGets;
  455       FMGets IPRFile3:  TFMGets;
  456       FMGets MedicalCen terDivisio n: TFMGets ;
  457       FMGets MovementTy pe: TFMGet s;
  458       FMGets NewPerson:  TFMGets;
  459       FMGets PatientMov ement: TFM Gets;
  460       FMGets PtAddress:  TFMGets;
  461       FMGets TemplateIn fo: TFMGet s;
  462       FMGets TIU: TFMGe ts;
  463       FMList BoxAdmissi on: TFMLis tBox;
  464       FMList BoxCAPRITo ols: TFMLi stBox;
  465       FMList BoxIPR1: T FMListBox;
  466       FMList BoxMedical CenterDivi sion: TFML istBox;
  467       FMList BoxOrderIn fo: TFMLis tBox;
  468       FMList BoxVADrugC lass: TFML istBox;
  469       FMList er1: TFMLi ster;
  470       FMList erAdmissio ns: TFMLis ter;
  471       FMList erCAPRIToo ls: TFMLis ter;
  472       FMList erCounties : TFMListe r;
  473       FMList erExams: T FMLister;
  474       FMList erIPR1: TF MLister;
  475       FMList erMedicalC enterDivis ion: TFMLi ster;
  476       FMList erOrderInf o: TFMList er;
  477       FMList erStates:  TFMLister;
  478       FMList erUserKeys : TFMListe r;
  479       FMList erVADrugCl ass: TFMLi ster;
  480       FMMemo FormDefini tion: TRic hEdit;
  481       FMMemo MovementDi agnosis: T FMMemo;
  482       FMMemo ReportDefi nition: TR ichEdit;
  483       FMMemo ScriptDefi nition: TR ichEdit;
  484       FMRegi onalOffice Number: TF MComboBox;
  485       FMRegi onalOffice NumberFake : TFMEdit;
  486       FMSeve ntyOne31Li ster1: TFM Lister;
  487       FMSeve ntyOne31Re questListb ox: TFMLis tBox;
  488       FMStat esList: TF MListBox;
  489       FMUser Name: TFML abel;
  490       FMVali dator1: TF MValidator ;
  491       FontDi alog1: TFo ntDialog;
  492       FormDa ta: TFMMem o;
  493       GroupB ox1: TGrou pBox;
  494       GroupB ox2: TGrou pBox;
  495       Header ControlDoD Allergies:  THeaderCo ntrol;
  496       Header ControlDOD Consults:  THeaderCon trol;
  497       Header ControlDOD DCS: THead erControl;
  498       Header ControlDOD LRC: THead erControl;
  499       Header ControlDOD LRCY: THea derControl ;
  500       Header ControlDOD MI: THeade rControl;
  501       Header ControlDoD PNs: THead erControl;
  502       Header ControlDOD RR: THeade rControl;
  503       HSMemo : TRichEdi t;
  504       HSMemo Local: TRi chEdit;
  505       Image1 : TImage;
  506       ImageF lagExclama tion: TIma ge;
  507       ImageF lagFlag: T Image;
  508       ImageF lagNew: TI mage;
  509       ImageV istaRed: T Image;
  510       IPRLoc ation: TEd it;
  511       Label1 : TLabel;
  512       Label1 0: TLabel;
  513       Label1 1: TLabel;
  514       Label1 2: TLabel;
  515       Label1 3: TLabel;
  516       Label1 4: TLabel;
  517       Label1 5: TLabel;
  518       Label1 6: TLabel;
  519       Label1 8: TLabel;
  520       Label1 9: TLabel;
  521       Label2 : TLabel;
  522       Label2 0: TLabel;
  523       Label2 3: TLabel;
  524       Label2 4: TLabel;
  525       Label2 5: TLabel;
  526       Label2 9: TLabel;
  527       Label3 : TLabel;
  528       Label4 : TLabel;
  529       Label5 : TLabel;
  530       Label6 : TLabel;
  531       Label7 : TLabel;
  532       Label8 : TLabel;
  533       Label9 : TLabel;
  534       LabelA ctiveContr ol: TLabel ;
  535       LabelC urrentView : TLabel;
  536       LabelD ivision: T Label;
  537       LabelD OB: TLabel ;
  538       LabelD ocsFound:  TLabel;
  539       LabelD oDInfo: TL abel;
  540       LabelG ridHeader:  TLabel;
  541       LabelI CN: TLabel ;
  542       labelR eportChoic e: TLabel;
  543       LabelR eportChoic e2: TLabel ;
  544       lbHeal thSummaryL ist: TList Box;
  545       lblAdd ress: TLab el;
  546       lblApp tStatus: T Label;
  547       lblCit y: TLabel;
  548       lblCou nty: TLabe l;
  549       lblOff ice: TLabe l;
  550       lblPho ne: TLabel ;
  551       lblSta te: TLabel ;
  552       lblZip : TLabel;
  553       ListBo xIPR1: TLi stBox;
  554       ListBo xRemoteDat a: TListBo x;
  555       ListBo xRemoteDat aPending:  TListBox;
  556       ListBo xRestricte dPatients:  TListBox;
  557       lstDoc s: TORList Box;
  558       lstIns titutions:  TListBox;
  559       MailMa nBuffer: T Memo;
  560       MemoAp pointments : TRichEdi t;
  561       memoCl inDocument : TMemo;
  562       MemoCP TCopyright : TMemo;
  563       memoDo cs: TRichE dit;
  564       MemoNa meAddressH older: TMe mo;
  565       MemoPr int: TRich Edit;
  566       MiniZi p1: TMiniZ ip;
  567       ORHeal thSummaryU serList: T ORListBox;
  568       ORList BoxDODRepo rtTypes: T ORListBox;
  569       ORList BoxSurgery Reports: T ORListBox;
  570       ORRepo rtsAvailab le: TORLis tBox;
  571       Page95 Control1:  TPage95Con trol;
  572       Panel1 : TPanel;
  573       Panel1 0: TPanel;
  574       Panel1 1: TPanel;
  575       Panel1 2: TPanel;
  576       Panel2 : TPanel;
  577       Panel3 : TPanel;
  578       Panel4 : TPanel;
  579       Panel5 : TPanel;
  580       Panel6 : TPanel;
  581       Panel7 : TPanel;
  582       Panel8 : TPanel;
  583       Panel9 : TPanel;
  584       PanelA ppointment s: TPanel;
  585       panelC ount: TPan el;
  586       PanelD ivision: T Panel;
  587       panelD ocs: TPane l;
  588       PanelD ODGrids: T Panel;
  589       PanelF HIEOptions : TPanel;
  590       PanelG raphVS: TP anel;
  591       PanelH SReport: T Panel;
  592       PanelR emoteData:  TPanel;
  593       panelR eportChoic e: TPanel;
  594       panelR eportChoic e2: TPanel ;
  595       panelS earch: TPa nel;
  596       PanelS urgeryRepo rts: TPane l;
  597       PopupM enuImages:  TImageLis t;
  598       PrintD ialog1: TP rintDialog ;
  599       Printe rSetupDial og1: TPrin terSetupDi alog;
  600       Progre ssBarLoadP t: TProgre ssBar;
  601       Report Memo: TRic hEdit;
  602       RichEd itDODRepor t: TRichEd it;
  603       RichEd itDODTempR eport: TRi chEdit;
  604       RichEd itFormEven ts: TRichE dit;
  605       RichEd itReport:  TRichEdit;
  606       RPCBro ker1: TCCO WRPCBroker CAPRI;
  607       RPCBro kerDoD: TC COWRPCBrok erCAPRI;
  608       Scroll BoxAddress : TScrollB ox;
  609       Sevent yOne31Requ estRefresh : TButton;
  610       Shape1 : TShape;
  611       Splitt er1: TSpli tter;
  612       Splitt er2: TSpli tter;
  613       Splitt er3: TSpli tter;
  614       Splitt er4: TSpli tter;
  615       Splitt er5: TSpli tter;
  616       Splitt er6: TSpli tter;
  617       Splitt er7: TSpli tter;
  618       SpVoic e1: TSpVoi ce;
  619       StateF ake: TEdit ;
  620       Status BarLoadPt:  TLabel;
  621       Tab713 1Request:  TTab95Shee t;
  622       Tab95C ontrol1: T Tab95Contr ol;
  623       Tab95C ontrol2: T Tab95Contr ol;
  624       Tab95C ontrol3: T Tab95Contr ol;
  625       TabCli nicalDocum ents: TTab 95Sheet;
  626       TabCPE xams: TTab 95Sheet;
  627       TabCPW orksheets:  TTab95She et;
  628       TabDOD : TTab95Sh eet;
  629       TabHea lthSummari es: TTab95 Sheet;
  630       TabRep orts: TTab 95Sheet;
  631       TabVis tAWeb: TTa b95Sheet;
  632       Timeou tTimer: TT imer;
  633       TimerF HIERunning : TTimer;
  634       TimerH alt: TTime r;
  635       TimerI nfoBox: TT imer;
  636       TimerI nitialConn ection: TT imer;
  637       TimerN ews: TTime r;
  638       TimerR emoteData:  TTimer;
  639       VAWrap GridDOD: T VAWrapGrid ;
  640       WebBro wser1: TWe bBrowser;
  641       xFMEdi tObjectCou nt: TFMEdi t;
  642       xFMTem platesUtil ized: TFMM emo;
  643       xHyper linkLabel1 : THyperli nkLabel;
  644       GIFIma geVistaYel low: TImag e;
  645       Action ManMain: T ActionMana ger;
  646       actFil eConnect:  TAction;
  647       actFil eSwitchSit es: TActio n;
  648       actFil eSelectPat ient: TAct ion;
  649       actFil eReports:  TAction;
  650       actFil ePrint: TA ction;
  651       actFil ePrintPrev iew: TActi on;
  652       actFil ePrinterSe tup: TActi on;
  653       actFil eQuit: TAc tion;
  654       actEdi tUndo: TAc tion;
  655       actEdi tCut: TAct ion;
  656       actEdi tCopy: TAc tion;
  657       actEdi tPaste: TA ction;
  658       actEdi tSelectAll : TAction;
  659       actToo lsAMIE: TA ction;
  660       actToo lsPrintBla nkExam: TA ction;
  661       actToo lsBringExa mToFront:  TAction;
  662       actToo lsMacroEdi tor: TActi on;
  663       actToo lsUnsigned WorkSheets : TAction;
  664       actToo lsUncosign edDocs: TA ction;
  665       actToo lsNews: TA ction;
  666       actToo lsVista: T Action;
  667       actToo lsSearch:  TAction;
  668       actToo lsProperti es: TActio n;
  669       actToo lsChangeAd dress: TAc tion;
  670       actToo lsEditEsig : TAction;
  671       actToo lsEditCPRe ports: TAc tion;
  672       actToo lsExamList Parameters : TAction;
  673       actToo lsCPRSCosi gUtil: TAc tion;
  674       actToo lsManageTe mplateDef:  TAction;
  675       Action MainMenuBa r1: TActio nMainMenuB ar;
  676       actDev EditUserKe ys: TActio n;
  677       actDev ThrowExcep t: TAction ;
  678       actDev UserKeys:  TAction;
  679       actHel pAbout: TA ction;
  680       actHel pCAPRITrai ning: TAct ion;
  681       actHel pAuditUtil : TAction;
  682       actHel pCheckConn ections: T Action;
  683       actHel pConsRepor ts: TActio n;
  684       actHel pEditRemot eUser: TAc tion;
  685       actHel pEditPatie ntLists: T Action;
  686       actHel pRPCBroker History: T Action;
  687       actToo lsExternal Apps: TAct ion;
  688       actPop TempDelete : TAction;
  689       actPop TempTogNew : TAction;
  690       actPop TempTogGre en: TActio n;
  691       actPop TempTogExc lamation:  TAction;
  692       actPop ReadOnlyCo py: TActio n;
  693       actPop ReadOnlySe lectAll: T Action;
  694       actPop EditUndo:  TAction;
  695       actPop EditCut: T Action;
  696       actPop EditCopy:  TAction;
  697       actPop EditPaste:  TAction;
  698       actPop EditDelete : TAction;
  699       actPop EditSelect All: TActi on;
  700       actPop EditCheckS pelling: T Action;
  701       actPop EditLoadEx am: TActio n;
  702       mnuPop Template:  TPopupActi onBar;
  703       mnuPop TempDelete : TMenuIte m;
  704       menuPo pTempN1: T MenuItem;
  705       mnuPop TempTogNew : TMenuIte m;
  706       mnuPop TempTogGre en: TMenuI tem;
  707       mnuPop TempTogExc lamation:  TMenuItem;
  708       mnuPop ReadOnly:  TPopupActi onBar;
  709       mnuPop ReadOnlyCo py: TMenuI tem;
  710       mnuPop ReadOnlySe lectAll: T MenuItem;
  711       mnuPop Edit: TPop upActionBa r;
  712       mnuPop EditUndo:  TMenuItem;
  713       mnuPop EditN1: TM enuItem;
  714       mnuPop EditCut: T MenuItem;
  715       mnuPop EditCopy:  TMenuItem;
  716       mnuPop EditPaste:  TMenuItem ;
  717       mnuPop EditDelete : TMenuIte m;
  718       mnuPop EditSelect All: TMenu Item;
  719       mnuPop EditN2: TM enuItem;
  720       mnuPop EditCheckS pelling: T MenuItem;
  721       mnuPop EditN3: TM enuItem;
  722       mnuPop EditLoadEx am: TMenuI tem;
  723       lblCou ntry: TLab el;
  724       lblPro vince: TLa bel;
  725       lblPos talCode: T Label;
  726       lblLas tUpdate: T Label;
  727       lblUpd ateSite: T Label;
  728       FMEdit Country: T FMEdit;
  729       FMEdit Province:  TFMEdit;
  730       FMEdit PostalCode : TFMEdit;
  731       FMEdit LastUpdate : TFMEdit;
  732       FMEdit UpdateSite : TFMEdit;
  733       FMEdit TempCountr y: TFMEdit ;
  734       FMEdit TempProvin ce: TFMEdi t;
  735       FMEdit TempPostal Code: TFME dit;
  736       FMEdit TempLastUp date: TFME dit;
  737       FMEdit TempUpdate Site: TFME dit;
  738       lblTem pCountry:  TLabel;
  739       lblTem pProvince:  TLabel;
  740       lblTem pPostalCod e: TLabel;
  741       lblTem pLastUpdat e: TLabel;
  742       lblTem pUpdateSit e: TLabel;
  743       FMGets Country: T FMGets;
  744       grpDOD StartDate:  TGroupBox ;                                                      //CodeCR10 2 - rpm 4/ 12/10
  745       grpDOD EndDate: T GroupBox;                                                         //CodeCR10 2 - rpm 4/ 12/10
  746       dtpDOD StartDate:  TDateTime Picker;                                                //CodeCR10 2 - rpm 4/ 12/10
  747       dtpDOD EndDate: T DateTimePi cker;                                                  //CodeCR10 2 - rpm 4/ 12/10
  748       VA508A ccessibili tyManager1 : TVA508Ac cessibilit yManager;
  749       ca508L istBoxIPR1 : TVA508Co mponentAcc essibility ;
  750       actHIA Search: TA ction;
  751       actFil eTransmitV irtualVA:  TAction;                                               //CodeCR35 3 - rpm 5/ 1/12
  752       actCap riHelp: TA ction;
  753       TabVoc Rehab: TTa b95Sheet;
  754       pnlVoc Rehab: TPa nel;
  755       btnVRA ddNewReque st: TBitBt n;
  756       btnVRE ditRequest : TBitBtn;
  757       lbVocR ehab: TLis tBox;
  758       FMGets VocRehab:  TFMGets;
  759       FMList erVocRehab : TFMListe r;
  760       edtHea der: TEdit ;
  761       edtCol umnHeader:  TEdit;
  762       actFil eRetrieveV irtualVA:  TAction;
  763       actCCR Launch: TA ction;
  764       actFil eRetrieveD ocsVLERDAS : TAction;
  765       actHel pEdtCancel Reasons: T Action;
  766       actHel pEdtInsuff Reasons: T Action;
  767       Find1:  TMenuItem ;                                                                 // CodeCR6 96 JRL 4/8 /15
  768       FindNe xt1: TMenu Item;
  769       lbNUTA SSESSSearc hIndex: TL istBox;                                                // CodeCR6 96 JRL 4/8 /15
  770       btnSor tAdmincmt:  TButton;
  771       cbxSor tExamReq:  TComboBox;
  772       lblSor tDir: TLab el;
  773       actHel pEdtReRout eReasons:  TAction;
  774       actHel pEdtVRERer outeReason s: TAction ;  // Patc h197 JRL 2 /9/17
  775       Functi on Authori zedOption( Const Opti onName: St ring): Boo lean;
  776       Functi on CCOWFor ceCloseOfA llDialogs:  boolean;
  777       Functi on Connect ToServer(C onst Optio nName: Str ing): Bool ean;
  778       Functi on GetAdho cLookup: i nteger;
  779       Functi on GetDivi sions: TSt rings;
  780       Functi on HSFileL ookup(aFil e: String;  Const Sta rtFrom: St ring; Dire ction: Int eger): TSt rings;
  781       Functi on removes paces(temp string: St ring): Str ing;
  782       Proced ure Animat eLogo(YesO rNo: Boole an);
  783       Proced ure Applic ationExcep tionHandle r(Sender:  TObject; E : Exceptio n);
  784       Proced ure BitBtn 1Click(Sen der: TObje ct);
  785       Proced ure BitBtn 2Click(Sen der: TObje ct);
  786       Proced ure BitBtn 4Click(Sen der: TObje ct);
  787       Proced ure BitBtn CCOWLinkBr okenClick( Sender: TO bject);
  788       Proced ure BitBtn CCOWLinkCl ick(Sender : TObject) ;
  789       Proced ure BitBtn LaunchVist aWebClick( Sender: TO bject);
  790       Proced ure BitBtn NewFormCli ck(Sender:  TObject);
  791       Proced ure BitBtn UnsignedFo rmsClick(S ender: TOb ject);
  792       Proced ure BitBtn VistAClick (Sender: T Object);
  793       Proced ure btnAdd 7131Click( Sender: TO bject);
  794       Proced ure btnAdd ExamClick( Sender: TO bject);
  795       Proced ure btnAdd RequestCli ck(Sender:  TObject);
  796       Proced ure btnAdH ocClick(Se nder: TObj ect);
  797       Proced ure btnAdm issionsCli ck(Sender:  TObject);
  798       Proced ure btnAll Click(Send er: TObjec t);
  799       Proced ure btnDiv isionsClic k(Sender:  TObject);
  800       Proced ure btnDoc sRefreshCl ick(Sender : TObject) ;
  801       Proced ure btnEdi tAddressCl ick(Sender : TObject) ;
  802       Proced ure btnExa mFinalRepo rtClick(Se nder: TObj ect);
  803       Proced ure btnFut ureClick(S ender: TOb ject);
  804       Proced ure btnGen erate7131R eportClick (Sender: T Object);
  805       Proced ure btnGen erateRepor tClick(Sen der: TObje ct);
  806       Proced ure btnGra phVSClick( Sender: TO bject);
  807       Proced ure btnLoa dHSNamesCl ick(Sender : TObject) ;
  808       Proced ure btnLoa dHSNamesRe moteDataCl ick(Sender : TObject) ;
  809       Proced ure btnMul ti2Click(S ender: TOb ject);
  810       Proced ure btnMul tiClick(Se nder: TObj ect);
  811       Proced ure btnPas tClick(Sen der: TObje ct);
  812       Proced ure btnRef reshAddres sClick(Sen der: TObje ct);
  813       Proced ure btnRef reshPtDemo graphicsCl ick(Sender : TObject) ;
  814       Proced ure btnSav eAddressCl ick(Sender : TObject) ;
  815       Proced ure btnVie w7131Click (Sender: T Object);
  816       Proced ure btnVie wExamClick (Sender: T Object);
  817       Proced ure btnVis tAWebHomeC lick(Sende r: TObject );
  818       Proced ure Button 1Click(Sen der: TObje ct);
  819       Proced ure Button 3Click(Sen der: TObje ct);
  820       Proced ure Button 4Click(Sen der: TObje ct);
  821       Proced ure Button 5Click(Sen der: TObje ct);
  822       Proced ure Button 9Click(Sen der: TObje ct);
  823       Proced ure button CancelRepo rtAdmissio nClick(Sen der: TObje ct);
  824       Proced ure Button CancelSurg eryReports Click(Send er: TObjec t);
  825       Proced ure button ClinDocDat eRangeClic k(Sender:  TObject);
  826       Proced ure Button CountyAcce ptClick(Se nder: TObj ect);
  827       Proced ure Button CPTCopyrig htClick(Se nder: TObj ect);
  828       Proced ure Button GCPRGoClic k(Sender:  TObject);
  829       Proced ure Button IPRCopyCli ck(Sender:  TObject);
  830       Proced ure Button IPRDeleteC lick(Sende r: TObject );
  831       Proced ure Button IPRDisplay Click(Send er: TObjec t);
  832       Proced ure Button IPRRefresh Click(Send er: TObjec t);
  833       Proced ure Button IPRRefresh Enter(Send er: TObjec t);
  834       Proced ure button NewsClick( Sender: TO bject);
  835       Proced ure button OKReportAd missionCli ck(Sender:  TObject);
  836       Proced ure Button OKSurgeryR eportsClic k(Sender:  TObject);
  837       Proced ure Button OtherSites Click(Send er: TObjec t);
  838       Proced ure Button RDVClick(S ender: TOb ject);
  839       Proced ure Button SearchClic k(Sender:  TObject);
  840       Proced ure Button StateAccep tClick(Sen der: TObje ct);
  841       Proced ure ComboB oxHSSectio nsChange(S ender: TOb ject);
  842       Proced ure Contex torControl Canceled(S ender: TOb ject);
  843       Proced ure Contex torControl Committed( Sender: TO bject);
  844       Proced ure Contex torControl Pending(Se nder: TObj ect; Const  aContextI temCollect ion: IDisp atch);
  845       Proced ure County FakeEnter( Sender: TO bject);
  846       Proced ure Delete TemplateCl ick(Sender : TObject) ;
  847       Proced ure Delete Text(Sende r: TObject );
  848       Proced ure DimMen uOptions;
  849       Proced ure EditDO DMaxItemsE xit(Sender : TObject) ;
  850       Proced ure Ensure Broker;
  851       Proced ure ExamRe questRefre shClick(Se nder: TObj ect);
  852       Proced ure FMCoun tiesListEx it(Sender:  TObject);
  853       Proced ure FMEdit CityExit(S ender: TOb ject);
  854       Proced ure FMEdit Street1Exi t(Sender:  TObject);
  855       Proced ure FMExam RequestLis tboxClick( Sender: TO bject);
  856       Proced ure FMExam RequestLis tboxDrawIt em(Control : TWinCont rol; Index : Integer;  Rect: TRe ct; State:  TOwnerDra wState);
  857       Proced ure FMList BoxAdmissi onEnter(Se nder: TObj ect);
  858       Proced ure FMList BoxAdmissi onExit(Sen der: TObje ct);
  859       Proced ure FMList BoxIPR1Dra wItem(Cont rol: TWinC ontrol; In dex: Integ er; Rect:  TRect; Sta te: TOwner DrawState) ;
  860       Proced ure FMMemo FormDefini tionChange (Sender: T Object);
  861       Proced ure FMRegi onalOffice NumberExit (Sender: T Object);
  862       Proced ure FMSeve ntyOne31Re questListb oxClick(Se nder: TObj ect);
  863       Proced ure FMSeve ntyOne31Re questListb oxDrawItem (Control:  TWinContro l; Index:  Integer; R ect: TRect ; State: T OwnerDrawS tate);
  864       Proced ure FMStat esListExit (Sender: T Object);
  865       Proced ure FormAc tivate(Sen der: TObje ct);
  866       Proced ure Format IPRList1;
  867       Proced ure FormCl ose(Sender : TObject;  Var Actio n: TCloseA ction);
  868       Proced ure FormCl oseQuery(S ender: TOb ject; Var  CanClose:  Boolean);
  869       Proced ure FormCr eate(Sende r: TObject );
  870       Proced ure FormPa int(Sender : TObject) ;
  871       Proced ure FormRe size(Sende r: TObject );
  872       Proced ure Header ControlDoD AllergiesS ectionResi ze(HeaderC ontrol: TH eaderContr ol; Sectio n: THeader Section);
  873       Proced ure Header ControlDOD ConsultsSe ctionResiz e(HeaderCo ntrol: THe aderContro l; Section : THeaderS ection);
  874       Proced ure Header ControlDOD DCSSection Resize(Hea derControl : THeaderC ontrol; Se ction: THe aderSectio n);
  875       Proced ure Header ControlDOD LRCSection Resize(Hea derControl : THeaderC ontrol; Se ction: THe aderSectio n);
  876       Proced ure Header ControlDOD LRCYSectio nResize(He aderContro l: THeader Control; S ection: TH eaderSecti on);
  877       Proced ure Header ControlDOD MISectionR esize(Head erControl:  THeaderCo ntrol; Sec tion: THea derSection );
  878       Proced ure Header ControlDoD PNsSection Resize(Hea derControl : THeaderC ontrol; Se ction: THe aderSectio n);
  879       Proced ure Header ControlDOD RRSectionR esize(Head erControl:  THeaderCo ntrol; Sec tion: THea derSection );
  880       Proced ure HorScr ollBar(Lis tBox: TLis tBox; MaxW idth: inte ger);
  881       Proced ure HSABVC omponents( Dest: TStr ings);
  882       Proced ure HSComp onentFiles (Dest: TSt rings; aCo mponent: S tring);
  883       Proced ure HSComp onents(Des t: TString s);
  884       Proced ure HSComp onentSubs( Dest: TStr ings; aIte m: String) ;
  885       Proced ure HSDisp Components (Dest: TSt rings);
  886       Proced ure HSMemo Change(Sen der: TObje ct);
  887       Proced ure HSMemo Enter(Send er: TObjec t);
  888       Proced ure HSMemo LocalChang e(Sender:  TObject);
  889       Proced ure HSRepo rtText(Des t: TString s; aCompon ents: TStr inglist);
  890       Proced ure ListBo xIPR1Click (Sender: T Object);
  891       Proced ure ListBo xIPR1DblCl ick(Sender : TObject) ;
  892       Proced ure ListBo xIPR1DrawI tem(Contro l: TWinCon trol; Inde x: Integer ; Rect: TR ect; State : TOwnerDr awState);
  893       Proced ure ListBo xIPR1KeyUp (Sender: T Object; Va r Key: Wor d; Shift:  TShiftStat e);
  894       Proced ure loadin stitutions ;
  895       Proced ure LoadRe portsOptio ns;
  896       Proced ure lstDoc sChange(Se nder: TObj ect);
  897       Proced ure lstDoc sClick(Sen der: TObje ct);
  898       Proced ure MemoAp pointments Change(Sen der: TObje ct);
  899       Proced ure MemoAp pointments Enter(Send er: TObjec t);
  900       Proced ure memoDo csChange(S ender: TOb ject);
  901       Proced ure memoDo csEnter(Se nder: TObj ect);
  902       Proced ure MyTemp ExceptionH andler(Sen der: TObje ct; E: Exc eption);
  903       Proced ure ORHeal thSummaryU serListCli ck(Sender:  TObject);
  904       Proced ure ORList BoxSurgery ReportsCha nge(Sender : TObject) ;
  905       Proced ure ORList BoxSurgery ReportsCli ck(Sender:  TObject);
  906       Proced ure ORRepo rtsAvailab leClick(Se nder: TObj ect);
  907       Proced ure Page95 Control1Ch ange(Sende r: TObject );
  908       Proced ure Page95 Control1Ch anging(Sen der: TObje ct; Var Al lowChange:  Boolean);
  909       Proced ure PopupR eadonlyRic heditPopup (Sender: T Object);
  910       Proced ure Report MemoChange (Sender: T Object);
  911       Proced ure Report MemoEnter( Sender: TO bject);
  912       Proced ure Restor eMenuOptio ns;
  913       Proced ure RPCBro ker1AfterC all(Sender : TObject) ;
  914       Proced ure RPCBro ker1Before Call(Sende r: TObject );
  915       Proced ure RPCBro kerCall;
  916       Proced ure RPCBro kerDODCall ;
  917       Proced ure SaveCA PRISetting s;
  918       Proced ure SetAdh ocLookup(a Lookup: in teger);
  919       Proced ure SetBro kerServer( Const ANam e: String;  APort: In teger; Wan tDebug: Bo olean);
  920       Proced ure SetFon t;
  921       Proced ure Sevent yOne31Requ estRefresh Click(Send er: TObjec t);
  922       Proced ure ShowHI AUserDownl oadWebsite ;
  923       Proced ure Splitt er3Moved(S ender: TOb ject);
  924       Proced ure Splitt er7CanResi ze(Sender:  TObject;  Var NewSiz e: Integer ; Var Acce pt: Boolea n);
  925       Proced ure StateF akeChange( Sender: TO bject);
  926       Proced ure StateF akeEnter(S ender: TOb ject);
  927       Proced ure Tab95C ontrol1Cha nge(Sender : TObject) ;
  928       Proced ure Tab95C ontrol1Cha nging(Send er: TObjec t; Var All owChange:  Boolean);
  929       Proced ure Tab95C ontrol2Cha nge(Sender : TObject) ;
  930       Proced ure Tab95C ontrol3Cha nge(Sender : TObject) ;
  931       Proced ure tempTo olClick(Se nder: TObj ect);
  932       Proced ure Timeou tTimerTime r(Sender:  TObject);
  933       Proced ure TimerF HIERunning Timer(Send er: TObjec t);
  934       Proced ure TimerH altTimer(S ender: TOb ject);
  935       Proced ure TimerI nfoBoxTime r(Sender:  TObject);
  936       Proced ure TimerI nitialConn ectionTime r(Sender:  TObject);
  937       Proced ure TimerN ewsTimer(S ender: TOb ject);
  938       Proced ure TimerR emoteDataT imer(Sende r: TObject );
  939       Proced ure UserKe ys1Click(S ender: TOb ject);
  940       Proced ure VAWrap GridDODCli ck(Sender:  TObject);
  941       Proced ure WebBro wser1Befor eNavigate2 (Sender: T Object; Co nst pDisp:  IDispatch ; Var URL,  Flags, Ta rgetFrameN ame, PostD ata, Heade rs: OleVar iant; Var  Cancel: Wo rdBool);
  942       Proced ure WebBro wser1Docum entComplet e(Sender:  TObject; C onst pDisp : IDispatc h; Var URL : OleVaria nt);
  943       Proced ure WebBro wser1Navig ateComplet e2(Sender:  TObject;  Const pDis p: IDispat ch; Var UR L: OleVari ant);
  944       Proced ure WebBro wser1Progr essChange( Sender: TO bject; Pro gress, Pro gressMax:  Integer);
  945       proced ure actFil eConnectEx ecute(Send er: TObjec t);
  946       proced ure actFil eConnectUp date(Sende r: TObject );
  947       proced ure actFil eSwitchSit esUpdate(S ender: TOb ject);
  948       proced ure actFil eSelectPat ientUpdate (Sender: T Object);
  949       proced ure actFil eSelectPat ientExecut e(Sender:  TObject);
  950       proced ure actFil eReportsEx ecute(Send er: TObjec t);
  951       proced ure actFil eReportsUp date(Sende r: TObject );
  952       proced ure actFil ePrintUpda te(Sender:  TObject);
  953       proced ure actFil ePrintExec ute(Sender : TObject) ;
  954       proced ure actFil ePrintPrev iewUpdate( Sender: TO bject);
  955       proced ure actFil ePrintPrev iewExecute (Sender: T Object);
  956       proced ure actFil ePrinterSe tupUpdate( Sender: TO bject);
  957       proced ure actFil ePrinterSe tupExecute (Sender: T Object);
  958       proced ure actFil eQuitExecu te(Sender:  TObject);
  959       proced ure actEdi tUpdate(Se nder: TObj ect);
  960       proced ure actEdi tUndoExecu te(Sender:  TObject);
  961       proced ure actEdi tCutExecut e(Sender:  TObject);
  962       proced ure actEdi tCopyExecu te(Sender:  TObject);
  963       proced ure actEdi tPasteExec ute(Sender : TObject) ;
  964       proced ure actEdi tSelectAll Execute(Se nder: TObj ect);
  965       proced ure actToo lsAMIEExec ute(Sender : TObject) ;
  966       proced ure actToo lsPrintBla nkExamExec ute(Sender : TObject) ;
  967       proced ure actToo lsBringExa mToFrontEx ecute(Send er: TObjec t);
  968       proced ure actToo lsBringExa mToFrontUp date(Sende r: TObject );
  969       proced ure actToo lsMacroEdi torExecute (Sender: T Object);
  970       proced ure actToo lsUnsigned WorkSheets Update(Sen der: TObje ct);
  971       proced ure actToo lsUncosign edDocsUpda te(Sender:  TObject);
  972       proced ure actToo lsUncosign edDocsExec ute(Sender : TObject) ;
  973       proced ure actToo lsVistaUpd ate(Sender : TObject) ;
  974       proced ure actToo lsSearchUp date(Sende r: TObject );
  975       proced ure actToo lsSearchEx ecute(Send er: TObjec t);
  976       proced ure actToo lsProperti esUpdate(S ender: TOb ject);
  977       proced ure actToo lsProperti esExecute( Sender: TO bject);
  978       proced ure actToo lsChangeAd dressUpdat e(Sender:  TObject);
  979       proced ure actToo lsChangeAd dressExecu te(Sender:  TObject);
  980       proced ure actToo lsEditEsig Execute(Se nder: TObj ect);
  981       proced ure actToo lsEditCPRe portsUpdat e(Sender:  TObject);
  982       proced ure actToo lsEditCPRe portsExecu te(Sender:  TObject);
  983       proced ure actToo lsExamList Parameters Update(Sen der: TObje ct);
  984       proced ure actToo lsExamList Parameters Execute(Se nder: TObj ect);
  985       proced ure actToo lsCPRSCosi gUtilUpdat e(Sender:  TObject);
  986       proced ure actToo lsCPRSCosi gUtilExecu te(Sender:  TObject);
  987       proced ure actToo lsManageTe mplateDefE xecute(Sen der: TObje ct);
  988       proced ure actDev EditUserKe ysExecute( Sender: TO bject);
  989       proced ure actDev ThrowExcep tExecute(S ender: TOb ject);
  990       proced ure actDev UserKeysEx ecute(Send er: TObjec t);
  991       proced ure actHel pAboutUpda te(Sender:  TObject);
  992       proced ure actHel pAboutExec ute(Sender : TObject) ;
  993       proced ure actHel pCAPRITrai ningExecut e(Sender:  TObject);
  994       proced ure actHel pAuditUtil Execute(Se nder: TObj ect);
  995       proced ure actHel pAuditUtil Update(Sen der: TObje ct);
  996       proced ure actHel pRPCBroker HistoryUpd ate(Sender : TObject) ;
  997       proced ure actHel pCheckConn ectionsExe cute(Sende r: TObject );
  998       proced ure actHel pConsRepor tsExecute( Sender: TO bject);
  999       proced ure actHel pEditRemot eUserExecu te(Sender:  TObject);
  1000       proced ure actHel pEditPatie ntListsExe cute(Sende r: TObject );
  1001       proced ure actHel pRPCBroker HistoryExe cute(Sende r: TObject );
  1002       proced ure actPop TempDelete Update(Sen der: TObje ct);
  1003       proced ure actPop TempDelete Execute(Se nder: TObj ect);
  1004       proced ure actPop TempTogNew Execute(Se nder: TObj ect);
  1005       proced ure actPop TempTogGre enExecute( Sender: TO bject);
  1006       proced ure actPop TempTogExc lamationEx ecute(Send er: TObjec t);
  1007       proced ure actPop EditUndoEx ecute(Send er: TObjec t);
  1008       proced ure actPop EditCutExe cute(Sende r: TObject );
  1009       proced ure actPop EditCopyEx ecute(Send er: TObjec t);
  1010       proced ure actPop EditPasteE xecute(Sen der: TObje ct);
  1011       proced ure actPop EditSelect AllExecute (Sender: T Object);
  1012       proced ure actPop EditCheckS pellingExe cute(Sende r: TObject );
  1013       proced ure actPop EditLoadEx amExecute( Sender: TO bject);
  1014       proced ure actPop EditUndoUp date(Sende r: TObject );
  1015       proced ure Action MainMenuBa r1EnterMen uLoop(Send er: TObjec t);
  1016       proced ure ShowPa tientList( Sender: TO bject; Pat ientFilter Type: TPat ientFilter Type); //C odeCR124 - MER 07/201 0
  1017       proced ure ListBo xIPR1KeyDo wn(Sender:  TObject;  var Key: W ord;
  1018         Shif t: TShiftS tate);
  1019       proced ure ca508L istBoxIPR1 ValueQuery (Sender: T Object;
  1020         var  Text: stri ng);                                                              // -MER Co deCR117 8/ 2010
  1021       proced ure WebBro wser1Windo wClosing(A Sender: TO bject;
  1022         IsCh ildWindow:  WordBool;  var Cance l: WordBoo l);
  1023       proced ure actHIA SearchExec ute(Sender : TObject) ;
  1024       proced ure actFil eTransmitV irtualVAEx ecute(Send er: TObjec t);
  1025       proced ure actFil eTransmitV irtualVAUp date(Sende r: TObject );
  1026       proced ure actCap riHelpExec ute(Sender : TObject) ;
  1027       proced ure lbVocR ehabClick( Sender: TO bject);                                     // CodeCR3 47 - JRL 0 5/22/12
  1028       proced ure btnVRA ddNewReque stClick(Se nder: TObj ect);                            // CodeCR3 47 - JRL 0 5/22/12
  1029       proced ure btnVRE ditRequest Click(Send er: TObjec t);                              // CodeCR3 47 - JRL 0 5/22/12
  1030       proced ure actFil eRetrieveV irtualVAEx ecute(Send er: TObjec t);                   //CodeCR42 4 - rpm 11 /13/12
  1031       proced ure actFil eRetrieveV irtualVAUp date(Sende r: TObject );                    //CodeCR42 4 - rpm 11 /13/12
  1032       proced ure actCCR LaunchExec ute(Sender : TObject) ;
  1033       proced ure actFil eRetrieveD ocsVLERDAS Execute(Se nder: TObj ect);
  1034       proced ure actFil eRetrieveD ocsVLERDAS Update(Sen der: TObje ct);
  1035   //    proc edure Appl icationEve nts1Messag e(var Msg:  tagMSG; v ar Handled : Boolean) ;
  1036   //    proc edure Appl icationEve nts1Idle(S ender: TOb ject; var  Done: Bool ean);
  1037   //    proc edure Form MouseWheel (Sender: T Object; Sh ift: TShif tState;
  1038   //      Wh eelDelta:  Integer; M ousePos: T Point; var  Handled:  Boolean);
  1039       proced ure actHel pEdtCancel ReasonsExe cute(Sende r: TObject );
  1040   //    proc edure actH elpEdtCanc elReasonsU pdate(Send er: TObjec t);
  1041       proced ure actHel pEdtInsuff ReasonsExe cute(Sende r: TObject );
  1042   //    proc edure actH elpEdtInsu ffReasonsU pdate(Send er: TObjec t);
  1043   //    proc edure Appl icationEve nts1Idle(S ender: TOb ject; var  Done: Bool ean);
  1044       proced ure RunSea rch(Search String: St ring);                                      //CodeCR69 6 JRL 4/8/ 15
  1045       proced ure Find1C lick(Sende r: TObject );                                          //CodeCR69 6 JRL 4/8/ 15
  1046       proced ure FindNe xt1Click(S ender: TOb ject);                                      //CodeCR69 6 JRL 4/8/ 15
  1047   //    proc edure btnS ortAdmincm tClick(Sen der: TObje ct);
  1048       proced ure cbxSor tExamReqCl ick(Sender : TObject) ;
  1049       proced ure actHel pEdtRerout eReasonsEx ecute(Send er: TObjec t);
  1050       proced ure actHel pEdtVRERer outeReason sExecute(S ender: TOb ject); //  Patch197 J RL 2/9/17
  1051   //  proced ure FindTe xtDlgFind( Sender: TO bject);                                     //CodeCR69 6 JRL 4/8/ 15
  1052   //  proced ure FindTe xtDlgShow( Sender: TO bject);                                     //CodeCR69 6 JRL 4/8/ 15
  1053  
  1054     Private
  1055       { Priv ate declar ations }
  1056       FMVISe archDebug:  Boolean;                                                         //CodeCR26 7 - 8/28/1 2
  1057       FNoDel eteVVA: Bo olean;                                                            //CodeCR35 3 - 5/30/1 2
  1058       FVirtu alVAURL: S tring;                                                            //CodeCR35 3 - rpm 5/ 14/12
  1059       FVirtu alVAToken:  String;                                                          //CodeCR35 3 - rpm 5/ 31/12
  1060       FAMIS2 90URL: str ing;                                                              //CodeCR44 0 (AMIS290 ) - JRL 11 /15/12
  1061       // FVl erDasURL :  String;   //CodeCR50 0 JRL 8/27 /13
  1062       // FVl erDasToken  : String;  //CodeCR5 40 JRL 12/ 11/13
  1063       FPrima ryMenuAssi gnable: Bo olean;                                                 //CodeCR10 9 - rpm 8/ 4/10
  1064       FIsDoD User: Bool ean;                                                              //CodeCR13 1 - rpm 10 /26/10
  1065       FPatie ntInfoBuck et: TPatie ntInfoBuck et;
  1066       Patien tSex: stri ng;
  1067       Patien tAge: stri ng;
  1068       functi on IsPrima ryMenuAssi gnable(con st UserPri maryMenu:  String): B oolean;    //CodeCR10 9 - rpm 8/ 1/10
  1069       Functi on UserCon firmsAssig ningEmptyS tring: boo lean;
  1070       proced ure GetPat ientProfil eMAS(aDFN:  String);                                   //CodeCR85  - rpm 4/1 3/10
  1071       proced ure CCOWIc onSetup;                                                          //CodeCR12 4 refactor  -MER 07/2 010
  1072       proced ure Update AuditOnHom eServer;                                               //CodeCR12 4 refactor  -MER 07/2 010
  1073       functi on GetBHIE Institutio nIEN: Stri ng;                                         //CodeCR13 1 - rpm 12 /8/10
  1074       proced ure ClearF orm;                                                              //CodeCR24 8 - rpm 3/ 8/12
  1075       functi on GetServ erDateTime (): String ;                                           //CodeCR35 3 - rpm 4/ 30/12
  1076       functi on GetFoot erDescript ion(Sender : TObject;  var footD escrip: St ring; var  ErrorText:  String):  Boolean; / /CodeCR353  - rpm 4/3 0/12
  1077       proced ure Format ReportFoot er(Sender:  TObject;  footDescri p: String;  DtTm: Str ing; Divis ion: Strin g); //Code CR353 - rp m 4/30/12
  1078       proced ure Format ReportBody (Sender: T Object);                                    //CodeCR35 3 - rpm 4/ 30/12
  1079       functi on FormatR eport(Send er: TObjec t): Boolea n; overloa d;                    //CodeCR35 3 - rpm 5/ 8/12
  1080       functi on FormatR eport(Send er: TObjec t; var foo tdescrip:  String;               //CodeCR35 3 - rpm 5/ 8/12
  1081         var  DtTm: Stri ng; var Di vision: St ring): Boo lean; over load;                 //CodeCR35 3 - rpm 5/ 8/12
  1082       proced ure Cleanu pAfterRepo rt(Sender:  TObject);                                  //CodeCR35 3 - rpm 5/ 8/12
  1083       proced ure DoLega cyEnterpri seSearch(S ender: TOb ject);                           //CodeCR26 7 - rpm 8/ 28/12
  1084       proced ure DoMVIS iteSwitch( Sender: TO bject);                                     //CodeCR26 7 - rpm 8/ 30/12
  1085       functi on IsButto nTagOne(Se nder: TObj ect): Bool ean;                             //CodeCR26 7 - rpm 8/ 30/12
  1086       proced ure LoadRe strictedSe archTraits ;                                           //CodeCR26 7 - rpm 9/ 13/12
  1087       functi on GetCurr entPatient Info: TPat ientInfoBu cket;
  1088       functi on RemoveS pecialChar acters(Inp utExamName : string):  string;              //CodeCR52 2 JRL 11/1 5/13
  1089     Public
  1090       { Publ ic declara tions }
  1091       VocReh ab: TVocRe hab;                                                              //CodeCR34 7 - JRL 5/ 22/12
  1092       Reflec tionWrappe r: TReflec tionWrappe r;                                          //CodeCR18 5 -MER 4/2 011
  1093       ExamTe xtForPDFs:  array of  TMemoryStr eam;                                        // CodeCR5 65 JRL 7/9 /14
  1094       NumExa mTextForPD Fs: Intege r;                                                     // CodeCR5 65 JRL 7/1 0/14
  1095       Search Text: TSea rchText;                                                          //CodeCR69 6 JRL 4/8/ 15
  1096       VVARet ransmit: B oolean;                                                           // CodeCR7 10 JRL 6/1 1/15
  1097       Proper ty Patient Info: TPat ientInfoBu cket read  GetCurrent PatientInf o write FP atientInfo Bucket; //  CodeCR???  TODO: LMS  Check to  see if Pat ient Bucke t was ever  used.
  1098       proper ty MVISear chDebug: B oolean rea d FMVISear chDebug wr ite FMVISe archDebug;  //CodeCR2 67 - rpm 8 /28/12
  1099       proper ty Virtual VAURL: Str ing read F VirtualVAU RL write F VirtualVAU RL;        //CodeCR35 3 - rpm 5/ 14/12
  1100       proper ty Virtual VAToken: S tring read  FVirtualV AToken wri te FVirtua lVATOken;  //CodeCR35 3 - rpm 5/ 31/12
  1101       proper ty AMIS290 URL: Strin g read FAM IS290URL w rite FAMIS 290URL;               // CodeCR4 40 (AMIS29 0) JRL 11/ 15/12
  1102       proper ty IsDoDUs er: Boolea n read FIs DoDUser wr ite FIsDoD User;                 //CodeCR13 1 - rpm 10 /26/10
  1103       // pro perty Vler DasURL : S tring read  FVlerDasU RL write F VlerDasURL ; // CodeC R500 JRL 8 /27/13          // Co deCR??? LM S 2014-07- 21  Moving  from main  form fiel d. moving  to VlerDas Client
  1104       // pro perty Vler DasToken :  String re ad FVlerDa sToken wri te FVlerDa sToken; // CodeCR540  JRL 12/11/ 13
  1105       functi on IsAllow ed2OpenExa m(anIENS:  String): B oolean;
  1106       functi on IsLocke dDate(anIE NS: String ): Boolean ;
  1107       functi on GetDivi sion(aRemo teLogin: B oolean; aR PCBroker:  TCCOWRPCBr okerCAPRI) : String;
  1108       //QC # 2016 - Cal l no longe r needed
  1109       //Func tion CanAc cessReview (): Boolea n;
  1110       Functi on FileDel eteOldSave History(Ex istingFile , Existing DateCreate d, Current File: Stri ng): Boole an;
  1111       Functi on IsPNCSO pen(): Boo lean;
  1112       Functi on IsPNCSR ecordSelec ted(FMList Box: TFMLi stBox): Bo olean;
  1113       Functi on IsRPCBr okerConnec ted(): Boo lean; over load;
  1114       Functi on IsRPCBr okerConnec ted(RPCBro ker: TCCOW RPCBrokerC APRI; Show Msg: Boole an; Status : TLabel):  Boolean;  overload;
  1115       Functi on IsRPCBr okerConnec ted(ShowMs g: Boolean ; Status:  TLabel): B oolean; ov erload;
  1116       Functi on IsUserK ey(KeyName : String):  Boolean;
  1117       Functi on IsUserK eyInList(K eyList: St ring): Boo lean;
  1118       Functi on Piece(C onst S: St ring; Deli m: char; P ieceNum: I nteger): S tring;
  1119       Proced ure AppMes sage(Var M sg: TMsg;  Var Handle d: Boolean );
  1120       Proced ure HSSubI tems(Dest:  TStrings;  aItem: St ring);
  1121       Proced ure FileCr eateNameFo rApplicati onExceptio nLog(var F ilename: S tring; Day Counter: i nteger);
  1122       Proced ure FileCr eateNameFo rSaveHisto ryLog(var  Filename:  String; Da yCounter:  integer);
  1123       Functi on TIUShow Modal(Send erName: St ring; FMLi stBox: TFM ListBox):  Boolean;
  1124       Proced ure SaveTo UsersTempD irectory(S ender: TOb ject; Erro rMsg: Stri ng; ParseE rrorMsg: b oolean);
  1125       Proced ure SetFil eAttribute sReadOnly( Sender: TO bject; Fil eName: Str ing; ReadO nly: boole an);
  1126       Proced ure UserKe ysDialog() ;
  1127       Proced ure UserKe ysEditDial og();
  1128       functi on GetCoun tryName(aC ountryIEN:  String):  String;
  1129       functi on GetVers ionUser: S tring;
  1130       proced ure GetAct iveCapriDi visions(aD ivisionLis t: TString s; Target:  TStrings) ; //CodeCR 173 - rpm  4/18/11
  1131       proced ure GetAll Divisions( aDivisionL ist: TStri ngs);                            //CodeCR18 6 - rpm 4/ 18/11
  1132       functi on GetDisp layGrpIEN( aDisplayGr oup: Strin g): String ;                     //CodeCR17 8 - rpm 4/ 18/11
  1133       functi on IsCCRUs er: Boolea n;
  1134       functi on IsCCRSu perVisor:  Boolean;
  1135     End;
  1136  
  1137  
  1138   Var
  1139    {Prior to  v149, Ver sionUser w as a strin g const fi xed at 27  characters  to
  1140     be compa tible with  the versi on update  tool (ex.' *#/VUSER/# *^DVBA*2.7 *143.01').
  1141     v149 imp lemented G etVersionU ser to dyn amically b uild the v ersion fro m the
  1142     project  fileversio n options}
  1143     VersionU ser: Strin g;
  1144     MergedFo rmMode: Bo olean;
  1145     TabReord erMode: Bo olean;
  1146     FHIESite Location:  String;
  1147     CallRPCE rrorTest:  Boolean =  false;
  1148   Const
  1149     // *** t hese are c onstants f rom RPCBEr r.pas, wil l broker d ocument th em????
  1150     XWB_M_RE JECT = 200 00 + 2;                                                           // M erfsr or
  1151     XWB_BadS ignOn = 20 000 + 4;                                                          // SignOn  'Error' (h appens whe n cancel p ressed)
  1152  
  1153     Version  = 'DVBA2.7 *193*1*A';                                                        // Change  to *1*A to  distingui sh release  version f rom test v ersion
  1154     CAPRIVer sion = 1.0 ;                                                                 // For PNC SCodeRun.p as
  1155  
  1156       //MessageF ile = '\\ DNS               . DNS             \caprimess ages\DVBA_ 2_7_91A.tx t';
  1157       //NewsFold er = '\\ DNS               . DNS             \caprimess ages\';
  1158       NewsURL =  'vaww.cpep . URL         /SHARE/CAP RI%20Annou ncements/' ;
  1159       //NewsURL  = ' DNS               . DNS             /CAPRI%20A nnouncemen ts/';
  1160     (* rpm 5 /26/09 - F HIE server  locations  determine d in Conne ctToServer  *)
  1161       //FHIESite Location = ' IP           , PORT ';    //Test Sys tem
  1162       //FHIESite Location =  'FHIE URL          , PORT '; //Live  system
  1163       //FHIESite Location = ' IP            , PORT ';
  1164     app_name  = 'CAPRI' ;
  1165       PROXYSERVE R_DEV_URL  = 'https:/ / IP                    /CapriProx yServlet/' ;
  1166       PROXYSERVE R_TEST_URL  = 'https: // IP                    /CapriProx yServlet/' ;
  1167  
  1168   Var
  1169     AddReque stIEN: Str ing;
  1170     addressi nfo: Strin g;
  1171     AllowSur geryReport : Boolean;
  1172     // QC #2 016 - jcs  - found va riable no  longer nee ded.
  1173     //ANUCan EditCPWM:  Boolean;
  1174     ANURefre shCPWMTitl es: Boolea n;
  1175     ANURepor tsClosing:  Boolean;
  1176     ANUTelne tLoginName : String;
  1177     AppStart ed: Boolea n;
  1178     AuditInP rogress: B oolean;
  1179     authorie n: String;
  1180     authorna me: String ;
  1181     authorss n: String;
  1182     Brokerfi rstLogin:  Boolean;
  1183     CancelIt : Array[0. .1000] Of  boolean;
  1184     Cancella tionReason : String;                                                         // Used to  control C ancel All  Exams
  1185     CancelRe ason: Arra y[0..1000]  Of String ;
  1186     CCOWBrea kLink: Boo lean;
  1187     CCOWInit ialized: B oolean;
  1188     CCOWMode : Boolean;
  1189     CCOWSusp ended: Boo lean;
  1190     ClinDocD ateRangeSe lected: Bo olean;
  1191     ConfigMo de508: Boo lean;
  1192     Contexto rChangeMes sage: Stri ng;
  1193     Contexto rControl:  TContextor Control;
  1194     CPRSVers ion: Strin g;
  1195     CurrentC ontrol, Cu rrentDialo g: String;
  1196     currentp ncstabname : String;
  1197     DebugSQA : Boolean;
  1198     Division Run: Boole an;
  1199     DocType:  String;
  1200     dvbaTime rInfoBox:  integer;
  1201     dvbaz: i nteger;                                                                      // Used fo r report b uilder
  1202     EditWhic h: Integer ;
  1203     ESSOConn ecting: Bo olean;
  1204     ESSOInit ialized: B oolean;
  1205     ESSOLogi nYet: bool ean;
  1206     FEditCtr l: TCustom Edit;
  1207     FEditCtr lRichEdit:  TRichEdit ;
  1208     foundMer geflag: in teger;
  1209     frmMain:  TfrmMain;
  1210     HaltFlag : Boolean;
  1211     hOldWnd:  hWnd;
  1212     homeemai laddress:  String;
  1213     Homeserv er, HomePo rt: String ;
  1214     Insuffic ientExam:  Boolean;
  1215     iprdirec tory: Stri ng;
  1216     LastAnim ationFrame : Integer;
  1217     LastSear ch: String ;
  1218     LastSear chFoundAt:  Integer;
  1219     listDocs : tstrings ;
  1220     listExam s: tstring s;
  1221     listLabT estNames:  tstrings;
  1222     listMedi calCenterD ivision: t strings;
  1223     listRest rictedPati ents: tstr ings;
  1224     localema iladdress:  String;
  1225     LocalSta tionNumber : String;
  1226     loggermo deforCPEP:  boolean;
  1227     NewMail:  Boolean;
  1228     noprinti ng: boolea n;
  1229     NumberCl inDocsToRe trieve: In teger;
  1230   //  Select edPatient:  TPatient;
  1231     patientc laimnumber : String;
  1232     patienti cn: String ;
  1233     patienti en: String ;
  1234     patienti enDOD: Str ing;
  1235     patientn ame: Strin g;
  1236     PatientS electionLi st: String ;
  1237     patients ensitive:  String;
  1238     patients sn: String ;
  1239     PNCSTime outValue:  Integer;
  1240     ProgramN ameCaption : String;
  1241     ReadOnly Mode: Bool ean;
  1242     RemoteDa taPtId: St ring;
  1243     RemoteSi teName: St ring;
  1244     RemoteSi teNamePoin ter: Strin g;
  1245     RemoteUs erDivision Number: St ring;
  1246     Restrict edPtSelect ion: Strin g;
  1247     SaveFlag : Boolean;
  1248     ScreenRe aderActive : Boolean;
  1249     SearchFo rString: S tring;
  1250     SearchRu nning: Int eger;
  1251     SendPNCS Counter: I nteger;
  1252     SendPNCS EventHint:  String;
  1253     Shutting Down: Bool ean;
  1254     SpeechAP IInstalled : boolean;
  1255     starttim e: tdateti me;
  1256     surgeryr eports: ts trings;
  1257     SwitchTo PatientSSN : String;
  1258     SwitchTo Site: Stri ng;
  1259     telnetca pturefile:  String;
  1260     TelnetCo nfigX: Int eger;
  1261     tempCurs or: TCurso r;
  1262     \x0006TempDir : TFileNam e;
  1263     TempFile Name: Stri ng;
  1264     tempHSMe mo: TStrin gList;
  1265     tempIEN:  String;
  1266     TempLast Memo: TMem o;
  1267     TempActi on: Array[ 0..49] Of  TAction;
  1268     TestSyst emLogin: S tring;
  1269     timeoutv al, timeou tcount: lo ngint;
  1270     TimeSinc eLastBroke rCall: Int eger;
  1271     uHSCompo nents: TSt ringList;                                                         //componen ts selecte d
  1272     uListSta te: Intege r;                                                                //Checked  state of l ist of Adh oc compone nts Checke d: Abbrevi ation, UnC hecked: Na me
  1273     uLocalRe portData:  TStringLis t;                                                     //Storage  for Local  report dat a
  1274     UserDivi sion: Stri ng;
  1275     UserDivi sionNumber : String;
  1276     UserDUZH omeServer:  String;
  1277     UserFile manCode: S tring;
  1278     UserHasN ewStyleRes trictedLis t: Integer ;
  1279     UserHome PrimaryMen u: String;
  1280     UserKeys : TStrings ;
  1281     UserKeys Str: Strin g;
  1282     UserRemo teDISUSER,  UserRemot eTerminati onDate, Us erRemotePr imaryMenu:  String;
  1283     UserRemo teHIAUser:  Boolean;
  1284     VistAHos t: String;
  1285     VistAWeb Loaded: Bo olean;
  1286     whichmer geform: in teger;
  1287     PARAM_SA VE_XML: Bo olean;
  1288     PARAM_SA VE_VLER_WS : Boolean;
  1289  
  1290   Implementa tion
  1291  
  1292   Uses
  1293     about,
  1294     alerts,
  1295     audit,
  1296     auditold ,
  1297     browsete mplates,
  1298     CAPRISup port,
  1299     checkrem oteconnect ions,
  1300     checktas ks,
  1301     Clipbrd,
  1302     comments 1,
  1303     //  Como bj,      L MS removed .. was onl y added fo r one call .. the cal l moved to  untMiscMt hds
  1304     connecte d,
  1305     CPWMObje cts,
  1306     DateRang eSelect,
  1307     daterang eshort,
  1308     DateUtil s,                                                                           // CodeCR7 08 rpk 5/1 9/2015
  1309     deletete mplateveri fication,
  1310     division lister,
  1311     editpati entlists,
  1312     editpt,
  1313     electron icsignatur e,
  1314     emailfor ward,
  1315     essosele ct,
  1316     establis hingnetwor kconnectio n,
  1317     examdet,
  1318     EdtCance lReasons,                                                                    // CodeCR6 98 rpk 3/2 4/2015
  1319     EdtInsuf fReasons,                                                                    // CodeCR6 98 rpk 3/3 0/2015
  1320     EdtRerou teReasons,                                                                   // Patch 1 93 JRL 7/2 9/16
  1321     EdtVRRer outeReason s,                                                                // Patch 1 97 JRL 2/8 /17
  1322     FHIEGrap h,
  1323     findpati entanywher e,
  1324     FiveZero EightMessa ges,
  1325     fPatient ProfileMAS  {CodeCR85  rpm 4/13/ 10},
  1326     fReports AdhocCompo nent1,
  1327     frmWebDi splay,
  1328     fWindows Processes,
  1329     graphvs,
  1330     hintdisp lay,
  1331     infobox,
  1332     labgraph ,
  1333     loadexam comments,
  1334     macroedi t,
  1335     mailman,
  1336     mailmanm essage,
  1337     managere ports,
  1338     managete mplatedefs ,
  1339     manifest s,
  1340     mfunstr,                                                                              // CodeCR7 08 rpk 5/2 6/2015
  1341     new7131,
  1342     newexam,
  1343     news,
  1344     ORFn,
  1345     patientl istrestric ted,
  1346     pncsrevi ewer,
  1347     pncsShow ,
  1348     printcon firm,
  1349     Printers ,
  1350     printsup port,
  1351     printtem plate,
  1352     properti es,
  1353     registry ,
  1354     remotere ports,
  1355     remotesi tepick,
  1356     remoteus ersitesedi tor,
  1357     reportau to,
  1358     reportbl d,
  1359     REPORTS,
  1360     rofinder ,
  1361     rpcbroke rcallsbuff er,
  1362     RPCConf1 ,
  1363     siteexam list,
  1364     spellche ck,
  1365     splash,
  1366     StrUtils ,                                                                            // CodeCR7 08 rpk 5/1 9/2015
  1367     telnet,
  1368     tiucosig nature,
  1369     tiudispl ayunit,
  1370     tiusign,                                                                              // CodeCR4 23 JRL 11/ 9/12
  1371     uncosign edutility,
  1372     unitsibl ings,
  1373     unitzip,
  1374     unsigned ,
  1375     UserKeyE ditor,
  1376     view7131 ,
  1377     viewaddr ess,
  1378     viewexam ,
  1379     VocRehab MedicalReq uest,                                                             //CodeCR34 7 - jrl 5/ 22/12
  1380     wait,
  1381     HIAVerif yPatient,  frmMVISear ch,
  1382     frmVVAGe tDocs,                                                                       //CodeCR42 4 - rpm 11 /13/12
  1383     demTranM ain                                                                          // CodeCR4 57 - LMS M inimalisti cs Embed d emTRAN/CCR  into CAPR I
  1384     , untCon stVals                                                                       // CodeCR4 57 - LMS A nother CCR  unit
  1385     , untMis cMthds                                                                       // CodeCR? ?? - LMS -  2014-07-1 4 consolid ate/refact or all Get TempDir in to one loc ation, so  all can be nefit from  Win 7 spe cific hand ling.
  1386     , untBrk rMthds                                                                       // JRL 12/ 10/13
  1387     , FrmVle rGetExam                                                                     // rpk 9/1 2/2014
  1388     , VlerDa sClient                                                                      //  CodeCR ??? LMS 20 14-07-21   Moving Vle r specific  reference s out of m ain form.
  1389     , VlerDa sIdHTTP                                                                      //  CodeCR ??? LMS 20 14-07-21   Moving Vle r specific  reference s out of m ain form.
  1390     , Search Text
  1391     ;
  1392  
  1393  
  1394   Var
  1395     UnitName : String =  'main';
  1396     FormTIUD isplay: TF ormTIUDisp lay;                                                   //CodeCR35 3 - rpm 5/ 7/12
  1397     ReverseE xamRequest SortOrder:  Boolean;                                              // CodeCR7 08 rpk 8/2 7/2015
  1398   //  Revers eAdminSort Order: Boo lean;                                                    // CodeC R708 rpk 8 /27/2015
  1399  
  1400   {$R *.DFM}
  1401   {$R zipcod es.RES}
  1402   {$R caprid ictionary. RES}
  1403  
  1404   (*   // LM S - consol idate/refa ctor all G etTempDir  into one
  1405   type
  1406     KNOWNFOL DERID = TG uid;
  1407     TSHGetKn ownFolderP ath = func tion(const  rfid: KNO WNFOLDERID ; dwFlags:  DWord; hT oken: THan dle; var p pSzPath: L PWSTR) : H Result; St dCall;
  1408   const
  1409     FOLDERID _LocalAppD ata: KNOWN FOLDERID =  '{F1B3278 5-6FBA-4FC F-9D55-7B8 E7F157091} ';
  1410  
  1411   {The next  two functi ons will s etup the c all and re turn the r esult.  Af ter that t he Memory  will be fr eeand Nil}
  1412   function S hGetKnownF olderPath( const rfid : KNOWNFOL DERID; dwF lags: DWor d; hToken:  THandle;  var ppszPa th: LPWSTR ): HResult ;
  1413   var
  1414     Shell: H Module;
  1415     SHGetKno wnFolderPa th: TSHGet KnownFolde rPath;
  1416   begin
  1417     Shell :=  LoadLibra ry('shell3 2.dll');
  1418     Win32Che ck(Shell < > 0);
  1419     try
  1420       @SHGet KnownFolde rPath := G etProcAddr ess(Shell,  'SHGetKno wnFolderPa th');
  1421       Win32C heck(Assig ned(SHGetK nownFolder Path));
  1422       Result  := SHGetK nownFolder Path(rfid,  dwFlags,  hToken, pp szPath);
  1423     finally
  1424       FreeLi brary(Shel l);
  1425     end;
  1426   end;
  1427  
  1428   function G etKnownFol derPath(co nst rfid:  KNOWNFOLDE RID; dwFla gs: DWord;  hToken: T Handle): W ideString;
  1429   var
  1430     buffer:  LPWSTR;
  1431   begin
  1432     buffer : = nil;
  1433     OleCheck (ShGetKnow nFolderPat h(rfid, dw Flags, hTo ken, buffe r));
  1434     try
  1435       Result  := buffer ;
  1436     finally
  1437       CoTask MemFree(bu ffer);
  1438     end;
  1439   end;
  1440  
  1441   {--------- ---------- ---------- ---------- ---------- ---------- ---------- --------
  1442     Procedur e: GetTemp Dir
  1443     Author:     From ht tp://www.l atiumsoftw are.com/en /delphi/00 017.php
  1444     Date:       24-Feb- 2004
  1445     Argument s: None
  1446     Result:     TFileNa me
  1447   ---------- ---------- ---------- ---------- ---------- ---------- ---------- -------}
  1448  
  1449   Function G etTempDir:  TFileName ;
  1450   Var
  1451     TmpDir:  Array[0..M AX_PATH -  1] Of char ;
  1452   Begin
  1453     Try
  1454       Result  := GetKno wnFolderPa th(FOLDERI D_LocalApp Data, 0, 0 ) + '\CAPR I\';     / /rra 81909 2 Find pat h to Local  App Data
  1455       If not  Directory Exists(Res ult) then                                            / /rra 81909 2 Check if  CAPRI Dir  exists
  1456          If  not Create Dir(Result ) then                                                 //rra 8190 92
  1457          Beg in                                                                           //rra 8190 92
  1458            S etString(R esult, Tmp Dir, GetTe mpPath(MAX _PATH, Tmp Dir));
  1459            I f Not Dire ctoryExist s(Result)  Then
  1460               If Not Cr eateDirect ory(PChar( Result), N il) Then
  1461               Begin
  1462                 Result  := Include TrailingPa thDelimite r(GetWindo wsDir) + ' TEMP';
  1463                 If Not  DirectoryE xists(Resu lt) Then
  1464                   If No t CreateDi rectory(Po inter(Resu lt), Nil)  Then
  1465                   Begin
  1466                     Res ult := Ext ractFileDr ive(Result ) + '\TEMP ';
  1467                     If  Not Direct oryExists( Result) Th en
  1468                       I f Not Crea teDirector y(Pointer( Result), N il) Then
  1469                       B egin
  1470                          Result :=  ExtractFi leDrive(Re sult) + '\ TMP';
  1471                          If Not Di rectoryExi sts(Result ) Then
  1472                            If Not  CreateDire ctory(Poin ter(Result ), Nil) Th en
  1473                            Begin
  1474                              Raise  Exception .Create(Sy sErrorMess age(GetLas tError));
  1475                            End;
  1476                       E nd;
  1477                   End;
  1478               End;
  1479          End ;                                                                            //rra 8190 92
  1480     Except
  1481       Result  := '';
  1482       Raise;
  1483     End;
  1484   End;
  1485   *)
  1486  
  1487   Procedure  TfrmMain.H SABVCompon ents(Dest:  TStrings) ;
  1488   Begin
  1489     frmMain. RPCBroker1 .Results.C lear;
  1490     RPCBroke r1.RemoteP rocedure : = 'ORWRP2  COMPABV';
  1491     //RPCBro ker1.Param [0].Value  := '';
  1492     //RPCBro ker1.Param [0].PType  := literal ;
  1493     RPCBroke rCall;
  1494     Try
  1495       RPCBro ker1.Call;
  1496     Except
  1497       On EBr okerError  Do
  1498       Begin
  1499         ANUR emoteProce dureCallIn Progress : = False;
  1500         Anim ateLogo(Fa lse);
  1501         Stat usBarLoadP t.Caption  := 'ORWRP2  COMPABV c ould not b e accessed !';
  1502         Stat usBarLoadP t.Repaint;
  1503         Appl ication.Pr ocessmessa ges;
  1504         Show MessageCAP RI('ORWRP2  COMPABV c ould not b e accessed !');
  1505       End;
  1506     End;
  1507     QuickCop y(RPCBroke r1.Results , Dest);
  1508   End;
  1509  
  1510   Procedure  TfrmMain.H SDispCompo nents(Dest : TStrings );
  1511   Begin
  1512     If ANURe moteProced ureCallInP rogress =  True Then
  1513       exit;
  1514     frmMain. RPCBroker1 .Results.C lear;
  1515     RPCBroke r1.RemoteP rocedure : = 'ORWRP2  COMPDISP';
  1516     //RPCBro ker1.Param [0].Value  := '';
  1517     //RPCBro ker1.Param [0].PType  := literal ;
  1518     RPCBroke rCall;
  1519     Try
  1520       RPCBro ker1.Call;
  1521     Except
  1522       On EBr okerError  Do
  1523       Begin
  1524         ANUR emoteProce dureCallIn Progress : = False;
  1525         Anim ateLogo(Fa lse);
  1526         Stat usBarLoadP t.Caption  := 'ORWRP2  COMPDISP  could not  be accesse d!';
  1527         Stat usBarLoadP t.Repaint;
  1528         Appl ication.Pr ocessmessa ges;
  1529         Show MessageCAP RI('ORWRP2  COMPDISP  could not  be accesse d!');
  1530       End;
  1531     End;
  1532     QuickCop y(RPCBroke r1.Results , Dest);
  1533   End;
  1534  
  1535   Procedure  TfrmMain.H SComponent s(Dest: TS trings);
  1536   Begin
  1537     If ANURe moteProced ureCallInP rogress =  True Then
  1538       exit;
  1539     frmMain. RPCBroker1 .Results.C lear;
  1540     RPCBroke r1.RemoteP rocedure : = 'ORWRP2  HS COMPONE NTS';
  1541     //RPCBro ker1.Param [0].Value  := '';
  1542  
  1543     //RPCBro ker1.Param [0].PType  := literal ;
  1544     RPCBroke rCall;
  1545     Try
  1546       RPCBro ker1.Call;
  1547     Except
  1548       On EBr okerError  Do
  1549       Begin
  1550         ANUR emoteProce dureCallIn Progress : = False;
  1551         Anim ateLogo(Fa lse);
  1552         Stat usBarLoadP t.Caption  := 'ORWRP2  HS COMPON ENTS could  not be ac cessed!';
  1553         Stat usBarLoadP t.Repaint;
  1554         Appl ication.Pr ocessmessa ges;
  1555         Show MessageCAP RI('ORWRP2  HS COMPON ENTS could  not be ac cessed!');
  1556       End;
  1557     End;
  1558     QuickCop y(RPCBroke r1.Results , Dest);
  1559   End;
  1560  
  1561   Procedure  TfrmMain.H SComponent Subs(Dest:  TStrings;  aItem: St ring);
  1562   Begin
  1563     If ANURe moteProced ureCallInP rogress =  True Then
  1564       exit;
  1565     frmMain. RPCBroker1 .Results.C lear;
  1566     RPCBroke r1.RemoteP rocedure : = 'ORWRP2  HS COMPONE NT SUBS';
  1567     RPCBroke r1.Param[0 ].Value :=  aItem;
  1568     RPCBroke r1.Param[0 ].PType :=  literal;
  1569     RPCBroke rCall;
  1570     Try
  1571       RPCBro ker1.Call;
  1572     Except
  1573       On EBr okerError  Do
  1574       Begin
  1575         ANUR emoteProce dureCallIn Progress : = False;
  1576         Anim ateLogo(Fa lse);
  1577         Stat usBarLoadP t.Caption  := 'ORWRP2  HS COMPON ENT SUBS c ould not b e accessed !';
  1578         Stat usBarLoadP t.Repaint;
  1579         Appl ication.Pr ocessmessa ges;
  1580         Show MessageCAP RI('ORWRP2  HS COMPON ENT SUBS c ould not b e accessed !');
  1581       End;
  1582     End;
  1583     MixedCas eList(RPCB roker1.Res ults);
  1584     QuickCop y(RPCBroke r1.Results , Dest);
  1585   End;
  1586  
  1587   Procedure  TfrmMain.H SComponent Files(Dest : TStrings ; aCompone nt: String );
  1588   Begin
  1589     If ANURe moteProced ureCallInP rogress =  True Then
  1590       exit;
  1591     frmMain. RPCBroker1 .Results.C lear;
  1592     RPCBroke r1.RemoteP rocedure : = 'ORWRP2  HS COMP FI LES';
  1593     RPCBroke r1.Param[0 ].Value :=  aComponen t;
  1594     RPCBroke r1.Param[0 ].PType :=  literal;
  1595     RPCBroke rCall;
  1596     Try
  1597       RPCBro ker1.Call;
  1598     Except
  1599       On EBr okerError  Do
  1600       Begin
  1601         ANUR emoteProce dureCallIn Progress : = False;
  1602         Anim ateLogo(Fa lse);
  1603         Stat usBarLoadP t.Caption  := 'ORWRP2  HS COMP F ILES could  not be ac cessed!';
  1604         Stat usBarLoadP t.Repaint;
  1605         Appl ication.Pr ocessmessa ges;
  1606         Show MessageCAP RI('ORWRP2  HS COMP F ILES could  not be ac cessed!');
  1607       End;
  1608     End;
  1609     QuickCop y(RPCBroke r1.Results , Dest);
  1610   End;
  1611  
  1612   Procedure  TfrmMain.S etAdhocLoo kup(aLooku p: integer );
  1613   Begin
  1614     If ANURe moteProced ureCallInP rogress =  True Then
  1615       exit;
  1616     frmMain. RPCBroker1 .Results.C lear;
  1617     RPCBroke r1.RemoteP rocedure : = 'ORWRP2  SAVLKUP';
  1618     RPCBroke r1.Param[0 ].Value :=  IntToStr( aLookup);
  1619     RPCBroke r1.Param[0 ].PType :=  literal;
  1620     RPCBroke rCall;
  1621     Try
  1622       RPCBro ker1.Call;
  1623     Except
  1624       On EBr okerError  Do
  1625       Begin
  1626         ANUR emoteProce dureCallIn Progress : = False;
  1627         Anim ateLogo(Fa lse);
  1628         Stat usBarLoadP t.Caption  := 'ORWRP2  SAVLKUP c ould not b e accessed !';
  1629         Stat usBarLoadP t.Repaint;
  1630         Appl ication.Pr ocessmessa ges;
  1631         Show MessageCAP RI('ORWRP2  SAVLKUP c ould not b e accessed !');
  1632       End;
  1633     End;
  1634   End;
  1635  
  1636   Procedure  TfrmMain.H SReportTex t(Dest: TS trings; aC omponents:  TStringli st);
  1637   Var
  1638     i: integ er;
  1639   Begin
  1640     If ANURe moteProced ureCallInP rogress =  True Then
  1641       exit;
  1642     frmMain. RPCBroker1 .Results.C lear;
  1643     RPCBroke r1.RemoteP rocedure : = 'ORWRP2  HS REPORT  TEXT';
  1644     RPCBroke r1.Param[1 ].PType :=  list;
  1645     For i :=  0 To aCom ponents.co unt - 1 Do
  1646       frmMai n.RPCBroke r1.Param[1 ].Mult[Int ToStr(i +  1)] := aCo mponents[i ];
  1647     RPCBroke r1.Param[2 ].Value :=  PatientIE N;
  1648     RPCBroke r1.Param[2 ].PType :=  literal;
  1649     RPCBroke rCall;
  1650     Try
  1651       RPCBro ker1.Call;
  1652     Except
  1653       On EBr okerError  Do
  1654       Begin
  1655         ANUR emoteProce dureCallIn Progress : = False;
  1656         Anim ateLogo(Fa lse);
  1657         Stat usBarLoadP t.Caption  := 'ORWRP2  HS REPORT  TEXT coul d not be a ccessed!';
  1658         Stat usBarLoadP t.Repaint;
  1659         Appl ication.Pr ocessmessa ges;
  1660         Show MessageCAP RI('ORWRP2  HS REPORT  TEXT coul d not be a ccessed!') ;
  1661       End;
  1662     End;
  1663     QuickCop y(RPCBroke r1.Results , Dest);
  1664   End;
  1665  
  1666   Function T frmMain.Ge tDivisions : TStrings ;
  1667   Var
  1668     x: integ er;
  1669   Begin
  1670     // Get d ivisions a nd force t hem in the  order the y are in t he file
  1671     FMListBo xMedicalCe nterDivisi on.Sorted  := False;
  1672     FMListBo xMedicalCe nterDivisi on.GetList ;
  1673     If FMLis tBoxMedica lCenterDiv ision.Item s.Count >  0 Then
  1674       For x  := 0 To FM ListBoxMed icalCenter Division.I tems.Count  - 1 Do
  1675       Begin
  1676         FMLi stBoxMedic alCenterDi vision.Ite mIndex :=  x;
  1677         FMLi stBoxMedic alCenterDi vision.Ite ms[x] := F MListBoxMe dicalCente rDivision. GetSelecte dRecord.IE N + '^' +  FMListBoxM edicalCent erDivision .Items[x];
  1678       End;
  1679     FMListBo xMedicalCe nterDivisi on.Sorted  := True;
  1680     ListMedi calCenterD ivision.Cl ear;
  1681     If FMLis tBoxMedica lCenterDiv ision.Item s.Count >  0 Then
  1682       For x  := 0 To FM ListBoxMed icalCenter Division.I tems.Count  - 1 Do
  1683         List MedicalCen terDivisio n.Add(Piec e(FMListBo xMedicalCe nterDivisi on.Items[x ], '^', 2)  + ' ^' +  Piece(FMLi stBoxMedic alCenterDi vision.Ite ms[x], '^' , 1));
  1684  
  1685     Result : = ListMedi calCenterD ivision;
  1686   End;
  1687  
  1688   Function T frmMain.Ge tAdhocLook up: intege r;
  1689   Begin
  1690     If ANURe moteProced ureCallInP rogress =  True Then
  1691     Begin
  1692       result  := 0;
  1693       exit;
  1694     End;
  1695     frmMain. RPCBroker1 .Results.C lear;
  1696     RPCBroke r1.RemoteP rocedure : = 'ORWRP2  GETLKUP';
  1697     //RPCBro ker1.Param [0].Value  := '';
  1698     //RPCBro ker1.Param [0].PType  := literal ;
  1699     RPCBroke rCall;
  1700     Try
  1701       RPCBro ker1.Call;
  1702     Except
  1703       On EBr okerError  Do
  1704       Begin
  1705         ANUR emoteProce dureCallIn Progress : = False;
  1706         Anim ateLogo(Fa lse);
  1707         Stat usBarLoadP t.Caption  := 'ORWRP2  GETLKUP c ould not b e accessed !';
  1708         Stat usBarLoadP t.Repaint;
  1709         Appl ication.Pr ocessmessa ges;
  1710         Show MessageCAP RI('ORWRP2  GETLKUP c ould not b e accessed !');
  1711       End;
  1712     End;
  1713  
  1714     If RPCBr oker1.Resu lts.Count  > 0 Then
  1715       Result  := StrToI nt(RPCBrok er1.Result s[0])
  1716     Else
  1717       Result  := 0;
  1718   End;
  1719  
  1720   {========= ========== ========== ========== ========== ========== ========== ====
  1721    GetBHIEIn stitutionI EN
  1722    This func tion deter mines the  INSTITUTIO N (#4) fil e IEN for  station 20 0
  1723    that is u sed to den ote BHIE/F HIE data i n the TREA TING FACIL ITIES LIST .
  1724    This retu rned value  is used t o populate  the BHIEI nstitution IEN proper ty
  1725    in the Pa tient Sele ctor (frmP atientList ).
  1726  
  1727    Returns t he INSTITU TION (#4)  file IEN o n success;  otherwise  returns ' 0'.
  1728    //CodeCR1 31 - rpm 1 2/8/10
  1729    ========= ========== ========== ========== ========== ========== ========== ====}
  1730  
  1731   function T frmMain.Ge tBHIEInsti tutionIEN:  String;
  1732   var
  1733     FMFindBH IEIEN: TFM FindOne;
  1734     BHIEIEN:  String;
  1735     ErrMsg:  String;
  1736     I, J: In teger;
  1737   begin
  1738     Result : = '0';
  1739     ErrMsg : = '';
  1740     FMFindBH IEIEN := T FMFindOne. Create(nil );
  1741     try
  1742       FMFind BHIEIEN.RP CBroker :=  RPCBroker 1;
  1743       FMFInd BHIEIEN.Fi nderFlags  := [fnfXac tMatch];
  1744       FMFind BHIEIEN.Fi leNumber : = '4';                                                 //INSTITUT ION file
  1745       FMFind BHIEIEN.Va lue := '20 0';                                                    //AUSTIN ( BHIE/FHIE)  station #
  1746       FMFind BHIEIEN.FM Index := ' D';                                                    //Station  # index in  the INSTI TUTION fil e
  1747       BHIEIE N := FMFin dBHIEIEN.G etIEN;
  1748       if (FM FIndBHIEIE N.ErrorLis t.Count >  0) then
  1749       begin
  1750         ErrM sg := 'Due  to the fo llowing er ror, CAPRI  is unable  to filter  DOD patie nts.' + #1 3#10
  1751           +  'As a resu lt, the pa tient sele ction dial og will no t display  any patien ts.' + #13 #10
  1752           +  #13#10
  1753           +  'FileMan E rror detai ls: ' + #1 3#10;
  1754         for  I := 0 to  FMFIndBHIE IEN.ErrorL ist.Count  - 1 do
  1755           fo r J := 0 t o TFMError Obj(FMFInd BHIEIEN.Er rorList[I] ).ErrorTex t.Count -  1 do
  1756              ErrMsg :=  ErrMsg + T FMErrorObj (FMFIndBHI EIEN.Error List[I]).E rrorText[J ] + #13#10 ;
  1757         Show MessageCAP RI(ErrMsg) ;
  1758       end
  1759       else
  1760         Resu lt := BHIE IEN;
  1761     finally
  1762       FreeAn dNil(FMFin dBHIEIEN);
  1763     end;
  1764   end;
  1765  
  1766   Function T frmMain.HS FileLookup (aFile: St ring; Cons t StartFro m: String;
  1767     Directio n: Integer ): TString s;
  1768   Begin
  1769     If ANURe moteProced ureCallInP rogress =  True Then
  1770     Begin
  1771       result  := Nil;
  1772       exit;
  1773     End;
  1774     frmMain. RPCBroker1 .Results.C lear;
  1775     RPCBroke r1.RemoteP rocedure : = 'ORWRP2  HS FILE LO OKUP';
  1776     RPCBroke r1.Param[0 ].Value :=  aFile;
  1777     RPCBroke r1.Param[0 ].PType :=  literal;
  1778     RPCBroke r1.Param[1 ].Value :=  StartFrom ;
  1779     RPCBroke r1.Param[1 ].PType :=  literal;
  1780     RPCBroke r1.Param[2 ].Value :=  IntToStr( Direction) ;
  1781     RPCBroke r1.Param[2 ].PType :=  literal;
  1782     RPCBroke rCall;
  1783     Try
  1784       RPCBro ker1.Call;
  1785     Except
  1786       On EBr okerError  Do
  1787       Begin
  1788         ANUR emoteProce dureCallIn Progress : = False;
  1789         Anim ateLogo(Fa lse);
  1790         Stat usBarLoadP t.Caption  := 'ORWRP2  HS FILE L OOKUP coul d not be a ccessed!';
  1791         Stat usBarLoadP t.Repaint;
  1792         Appl ication.Pr ocessmessa ges;
  1793         Show MessageCAP RI('ORWRP2  HS FILE L OOKUP coul d not be a ccessed!') ;
  1794       End;
  1795     End;
  1796     MixedCas eList(RPCB roker1.Res ults);
  1797     Result : = RPCBroke r1.Results ;
  1798   End;
  1799  
  1800   Procedure  TfrmMain.H SSubItems( Dest: TStr ings; aIte m: String) ;
  1801   Begin
  1802     If ANURe moteProced ureCallInP rogress =  True Then
  1803       exit;
  1804     frmMain. RPCBroker1 .Results.C lear;
  1805     RPCBroke r1.RemoteP rocedure : = 'ORWRP2  HS SUBITEM S';
  1806     RPCBroke r1.Param[0 ].Value :=  aItem;
  1807     RPCBroke r1.Param[0 ].PType :=  literal;
  1808     RPCBroke rCall;
  1809     Try
  1810       RPCBro ker1.Call;
  1811     Except
  1812       On EBr okerError  Do
  1813       Begin
  1814         ANUR emoteProce dureCallIn Progress : = False;
  1815         Anim ateLogo(Fa lse);
  1816         Stat usBarLoadP t.Caption  := 'ORWRP2  HS SUBITE MS could n ot be acce ssed!';
  1817         Stat usBarLoadP t.Repaint;
  1818         Appl ication.Pr ocessmessa ges;
  1819         Show MessageCAP RI('ORWRP2  HS SUBITE MS could n ot be acce ssed!');
  1820       End;
  1821     End;
  1822     MixedCas eList(RPCB roker1.Res ults);
  1823     QuickCop y(RPCBroke r1.Results , Dest);
  1824   End;
  1825  
  1826   Function T frmMain.re movespaces (tempstrin g: String) : String;
  1827   Var
  1828     x: integ er;
  1829   Begin
  1830     // Remov e trailing  spaces
  1831     If Lengt h(tempstri ng) > 0 Th en
  1832     Begin
  1833       x := l ength(temp string);
  1834       Repeat
  1835         Begi n
  1836           If  Copy(temp string, x,  1) = ' '  Then
  1837              tempstring  := copy(t empstring,  1, x - 1)
  1838           El se
  1839              x := 1;
  1840           de c(x);
  1841       End Un til x = 0;
  1842     End;
  1843     // Remov e leading  spaces
  1844     If Lengt h(tempstri ng) > 0 Th en
  1845     Begin
  1846       x := 0 ;
  1847       Repeat
  1848         Begi n
  1849           If  Copy(temp string, 1,  1) = ' '  Then
  1850           Be gin
  1851              tempstring  := copy(t empstring,  2, length (tempstrin g) - 1);
  1852              dec(x);
  1853           En d
  1854           El se
  1855              x := lengt h(tempstri ng);
  1856           in c(x);
  1857       End Un til x > le ngth(temps tring);
  1858     End;
  1859     result : = tempstri ng;
  1860   End;
  1861  
  1862   Procedure  TfrmMain.S etFont;
  1863   Begin
  1864     If FormE ssoSelect  <> Nil The n
  1865     Begin
  1866       formES SOSelect.f ont := pan el1.font;
  1867       formEs soSelect.h eight := f rmMain.Hei ght - 100;
  1868       formEs soSelect.t op := frmM ain.Top +  ((frmMain. Height - f ormEssoSel ect.Height ) Div 2);
  1869       formEs soSelect.l eft := frm Main.left  + ((frmMai n.Width -  formEssoSe lect.Width ) Div 2);
  1870       formEs soSelect.L abelMessag e.Left :=  (formEssoS elect.Widt h Div 2) -  (formEsso Select.Lab elMessage. width Div  2);
  1871       formEs soSelect.W idth := fo rmEssoSele ct.Label1. Width + fo rmEssoSele ct.Label1. Left * 3;
  1872       formEs soSelect.l stUserSite s.Top := f ormEssoSel ect.Label1 .Top + for mEssoSelec t.Label1.H eight + 8;  //CodeCR7 7
  1873       formEs soSelect.B utton2.Hei ght := pan el1.Height ;
  1874       formEs soSelect.B utton1.Hei ght := pan el1.Height ;
  1875       bitbtn CCOWLink.H eight := p anel1.Heig ht;
  1876       bitbtn CCOWLinkBr oken.Heigh t := panel 1.Height;
  1877       bitbtn CCOWLinkCh anging.Hei ght := pan el1.Height ;
  1878       //form EssoSelect .ButtonHom eMail.Heig ht:=panel1 .Height;
  1879       formEs soSelect.B utton1.Wid th := (for mEssoSelec t.lstUserS ites.width  Div 2);   //CodeCR77
  1880       formEs soSelect.B utton2.Wid th := form EssoSelect .Button1.W idth;
  1881       formEs soSelect.B utton1.Lef t := formE ssoSelect. Button2.Le ft + formE ssoSelect. Button2.Wi dth;
  1882       //form EssoSelect .ButtonHom eMail.widt h:=formEss oSelect.bu tton1.widt h+formEsso Select.but ton2.width ;
  1883       formes soselect.b utton1.top  := formes soselect.h eight - (f ormessosel ect.button 1.height *  2) - 16;
  1884       //form essoselect .buttonhom email.top: =formessos elect.butt on1.top+fo rmessosele ct.button1 .height+1;
  1885       formEs soSelect.B utton2.Top  := FormEs soSelect.B utton1.Top ;
  1886       formEs soSelect.S taticText1 .Top := Fo rmEssoSele ct.Button1 .Top - 8 -  formEssoS elect.Stat icText1.He ight;
  1887       formEs soSelect.l stUserSite s.Height : = FormEsso Select.Sta ticText1.T op - 1 - f ormEssoSel ect.lstUse rSites.Top ; //CodeCR 77
  1888     End;
  1889  
  1890     PanelSur geryReport s.Left :=  (frmMain.W idth Div 2 ) - (Panel SurgeryRep orts.width  Div 2);
  1891     PanelSur geryReport s.Top := ( frmMain.He ight Div 2 ) - (Panel SurgeryRep orts.heigh t Div 2) -  30;
  1892  
  1893     //FMExam RequestLis tbox.Font: =FontDialo g1.Font;
  1894     FMSevent yOne31Requ estListbox .Font := F MExamReque stListbox. Font;
  1895     ORReport sAvailable .Font := F ontDialog1 .Font;
  1896     ORHealth SummaryUse rList.Font  := FontDi alog1.Font ;
  1897  
  1898     {rpm 9/2 2/09 -  Th e followin g 5 lines  cause the  non-propor tional rep ort
  1899                      co ntrols to  display wi th the def ault propo rtional fo nt.
  1900                      Th is was not  evident i n Delphi 5 , but caus es problem s
  1901                      in  Delphi 20 06.
  1902     MemoDocs .Font := P anel1.Font ;
  1903     ReportMe mo.Font :=  Panel1.Fo nt;
  1904     HSMemo.F ont := Pan el1.Font;
  1905     HSMemoLo cal.Font : = Panel1.F ont;
  1906     MemoAppo intments.F ont := Pan el1.Font;
  1907     }
  1908  
  1909     //Report Memo.SelAt tributes.N ame:=FontD ialog1.Fon t.name;
  1910       //Repo rtMemo.Sel Attributes .Size:=Fon tDialog1.F ont.Size;
  1911       //Repo rtMemo.Sel Attributes .Style:=Fo ntDialog1. Font.Style ;
  1912     //HSMemo .SelAttrib utes.name: =FontDialo g1.Font.na me;
  1913       //HSMe mo.SelAttr ibutes.siz e:=FontDia log1.Font. size;
  1914       //HSMe mo.SelAttr ibutes.sty le:=FontDi alog1.Font .style;
  1915     //HSMemo Local.SelA ttributes. name:=Font Dialog1.Fo nt.name;
  1916       //HSMe moLocal.Se lAttribute s.size:=Fo ntDialog1. Font.size;
  1917       //HSMe moLocal.Se lAttribute s.style:=F ontDialog1 .Font.styl e;
  1918     //MemoDo cs.SelAttr ibutes.nam e:=FontDia log1.Font. name;
  1919       //Memo Docs.SelAt tributes.s ize:=FontD ialog1.Fon t.size;
  1920       //Memo Docs.SelAt tributes.s tyle:=Font Dialog1.Fo nt.style;
  1921     //MemoAp pointments .SelAttrib utes.name: =FontDialo g1.Font.na me;
  1922       //Memo Appointmen ts.SelAttr ibutes.siz e:=FontDia log1.Font. size;
  1923       //Memo Appointmen ts.SelAttr ibutes.sty le:=FontDi alog1.Font .style;
  1924     lstDocs. Font := Fo ntDialog1. Font;
  1925     Tab95Con trol1.Font  := FontDi alog1.Font ;
  1926     Page95Co ntrol1.Fon t := FontD ialog1.Fon t;
  1927     frmMain. font := Fo ntDialog1. Font;
  1928     Groupbox 2.Font :=  GroupBox1. Font;
  1929     //HSMemo Local.Plai ntext:=Tru e;
  1930     //HSMemo .Plaintext :=true;
  1931     //Report Memo.Plain Text:=true ;
  1932     //MemoAp pointments .PlainText :=True;
  1933     //frmRep orts.Repor tMemo.Plai ntext:=Tru e;
  1934     //memodo cs.plainte xt:=true;
  1935     FormResi ze(applica tion);
  1936   End;
  1937  
  1938   Procedure  TfrmMain.R PCBrokerCa ll;
  1939   Var
  1940     x: integ er;
  1941   Begin
  1942     TimeSinc eLastBroke rCall := 0 ;
  1943     If ANURe moteProced ureCallInP rogress =  True Then
  1944       Repeat
  1945         Begi n
  1946           Ti meSinceLas tBrokerCal l := 0;
  1947           Fo r x := 1 T o 50 Do
  1948              applicatio n.processm essages;
  1949       End Un til ANURem oteProcedu reCallInPr ogress = F alse;
  1950   End;
  1951  
  1952   // DoD tab  function  - DoD tab  is no long er display ed so this  function  will 
  1953   // never e xecute.  P atch 193 J RL 7/21/16
  1954   Procedure  TfrmMain.R PCBrokerDO DCall;
  1955   Var
  1956     x: integ er;
  1957   Begin
  1958     TimeSinc eLastBroke rCall := 0 ;
  1959     If ANURe moteProced ureCallInP rogress =  True Then
  1960       Repeat
  1961         Begi n
  1962           Ti meSinceLas tBrokerCal l := 0;
  1963           Fo r x := 1 T o 50 Do
  1964              applicatio n.processm essages;
  1965       End Un til ANURem oteProcedu reCallInPr ogress = F alse;
  1966   End;
  1967  
  1968   Function r emovetrail ingspaces( tempstring : String):  String;
  1969   Var
  1970     x: integ er;
  1971   Begin
  1972     // Remov e trailing  spaces
  1973     If Lengt h(tempstri ng) > 0 Th en
  1974     Begin
  1975       x := l ength(temp string);
  1976       Repeat
  1977         Begi n
  1978           If  Copy(temp string, x,  1) = ' '  Then
  1979              tempstring  := copy(t empstring,  1, x - 1)
  1980           El se
  1981              x := 1;
  1982           de c(x);
  1983       End Un til x = 0;
  1984     End;
  1985     result : = tempstri ng;
  1986   End;
  1987  
  1988   Function F MToDateCon vert(DateT imeST: Str ing): Stri ng;
  1989   Begin
  1990     Result : = caprisup port.FMToD ateConvert (DateTimeS T);
  1991   End;
  1992  
  1993   Procedure  TfrmMain.b tnVistAWeb HomeClick( Sender: TO bject);
  1994   Var
  1995     tempstri ng, tempst ring2: Str ing;
  1996     tempdivi sion: Stri ng;
  1997     tempDUZ:  String;
  1998     tempUser Division:  String;
  1999     x: integ er;
  2000     URLStrin g: String;
  2001   Begin
  2002     tempDivi sion := '' ;
  2003     // Check  for URL
  2004     //CAPRI_ CodeCR95   - jcs - 05 /20/2010
  2005     if not C allRPC(RPC Broker1, ' DVBAB GET  URL', ['3' ], nil) th en
  2006       exit;
  2007  
  2008     If RPCBr oker1.Resu lts.Count  > 0 Then
  2009     Begin
  2010       If Pie ce(RPCBrok er1.Result s[0], '^',  1) = '-1'  Then
  2011       Begin
  2012         TabV istAWeb.Vi sible := F alse;
  2013         TabV istAWeb.Ta bVisible : = False;
  2014         exit ;
  2015       End;
  2016     End
  2017     Else
  2018     Begin
  2019       TabVis tAWeb.Visi ble := Fal se;
  2020       TabVis tAWeb.TabV isible :=  False;
  2021       exit;
  2022     End;
  2023  
  2024     URLStrin g := RPCBr oker1.Resu lts[0];
  2025  
  2026     {CodeCR1 81 - rpm 3 /31/11 - a lways retu rn divisio n at patie nt locatio n for Vist aWeb}
  2027     tempDivi sion := Pi ece(GetDiv ision(Fals e, RPCBrok er1), '^',  3);
  2028     if tempD ivision =  '' then
  2029       tempDi vision :=  '???';
  2030  
  2031     If ESSOV ersion = T rue Then
  2032     Begin
  2033       tempUs erDivision  := '100';
  2034       tempDU Z := UserD UZHomeServ er;
  2035     End
  2036     Else
  2037     Begin
  2038       tempUs erDivision  := tempDi vision;
  2039       {Get U ser DUZ}
  2040  
  2041       //CAPR I_CodeCR95   - jcs -  05/20/2010
  2042       if not  CallRPC(R PCBroker1,  'XWB GET  VARIABLE V ALUE', ['D UZ'], nil,  True) the n
  2043         exit ;
  2044  
  2045       tempDU Z := RPCBr oker1.Resu lts[0];
  2046     End;
  2047       //URLStrin g:='https: //vistaweb . URL         /CapriPage .aspx';
  2048     tempStri ng := URLS tring + '? q9gtw0' +
  2049       '=' +
  2050       tempUs erDivision
  2051       + '&yi icf=' +
  2052       tempDU Z                                                                            // User DU Z
  2053       + '&hi aoe=' +
  2054       Author SSN
  2055       + '&qq lwel=' +
  2056       Author Name + '&x qi4z=' +
  2057       Patien tIEN +
  2058       '&vmc3 ed5f=' + t empDivisio n;
  2059     //+
  2060     //'&hs77 sq=bMdlIJo d56'; // A pp Passcod e
  2061     tempstri ng2 := '';
  2062     If lengt h(tempstri ng) > 0 Th en
  2063       For x  := 1 To le ngth(temps tring) Do
  2064         If t empstring[ x] <> ' '  Then
  2065           te mpstring2  := tempstr ing2 + tem pstring[x]
  2066         Else
  2067           te mpstring2  := tempstr ing2 + '%2 0';
  2068     tempstri ng := temp string2;
  2069  
  2070     If sende r = bitbtn LaunchVist aWeb Then
  2071     Begin
  2072       xHyper linkLabel1 .targetURL  := tempst ring;
  2073       xHyper linkLabel1 .Navigate;
  2074     End
  2075     Else
  2076       WebBro wser1.Navi gate(tempS tring);
  2077  
  2078   End;
  2079  
  2080  
  2081   Function T frmMain.Au thorizedOp tion(Const  OptionNam e: String) : Boolean;
  2082   { checks t o see if t he user is  authorize d to use t his applic ation }
  2083   Begin
  2084     EnsureBr oker;
  2085     RPCBroke rCall;
  2086     Result : = RPCBroke r1.CreateC ontext(Opt ionName);
  2087     //Set up  Server/Po rt values  to be used  by Telnet  window -  rpm 3/16/0 9
  2088     if RPCBr oker1.ANUs trServer =  '' then
  2089     begin
  2090       RPCBro ker1.ANUst rServer :=  RPCBroker 1.Server;
  2091       RPCBro ker1.ANUst rPort := I ntToStr(RP CBroker1.L istenerPor t);
  2092     end;
  2093   End;
  2094  
  2095   Procedure  TfrmMain.E nsureBroke r;
  2096   { ensures  that a bro ker object  has been  created -  creates &  initialize s it if ne cessary }
  2097   Begin
  2098     If RPCBr oker1 = Ni l Then
  2099     Begin
  2100       RPCBro ker1 := TC COWRPCBrok erCAPRI.Cr eate(Appli cation);
  2101       With R PCBroker1  Do
  2102       Begin
  2103         Clea rParameter s := True;
  2104         Clea rResults : = True;
  2105         Debu gMode := F alse;
  2106       End;
  2107     End;
  2108   End;
  2109  
  2110   Procedure  TfrmMain.S etBrokerSe rver(Const  AName: St ring; APor t: Integer ; WantDebu g: Boolean );
  2111   { makes th e initial  connection  to a serv er }
  2112   Begin
  2113     EnsureBr oker;
  2114     With RPC Broker1 Do
  2115     Begin
  2116       Server  := AName;
  2117       If APo rt > 0 The n
  2118         List enerPort : = APort;
  2119       DebugM ode := Wan tDebug;
  2120       Connec ted := Tru e;
  2121     End;
  2122   End;
  2123  
  2124   Function T frmMain.Co nnectToSer ver(Const  OptionName : String):  Boolean;
  2125   { establis h initial  connection  to server  using opt ional comm and line p arameters  and check  that
  2126     this app lication ( option) is  allowed f or this us er }
  2127   Var
  2128     APort: S tring;
  2129     AServer:  String;
  2130     i: Integ er;
  2131     ModalRes ult: Integ er;
  2132     WantDebu g: Boolean ;
  2133     x: Strin g;
  2134     IsConnec ted: Boole an;
  2135   Begin
  2136     Result : = False;
  2137     WantDebu g := False ;
  2138     AServer  := '';
  2139     APort :=  '';
  2140  
  2141     If Broke rFirstLogi n Then                                                            // LMS
  2142     Begin
  2143       RPCBro ker1.ANUTe stMode :=  False;
  2144       RPCBro kerDOD.ANU TestMode : = False;
  2145         FHIESiteLo cation :=  'FHIE URL          , PORT ';                                      //producti on server
  2146  
  2147       PARAM_ SAVE_VLER_ WS := Fals e;
  2148       PARAM_ SAVE_XML : = False;
  2149       FMVISe archDebug  := FALSE;
  2150       FNoDel eteVVA :=  False;
  2151  
  2152       TIdHTT PVler.SetV lerDasURL( '');                                                   // VlerDas URL := '';      // Co deCR540 JR L 12/11/13
  2153       // Vle rDasToken  := '';   / / CodeCR54 0 JRL 12/1 1/13     / / LMS remo ved.
  2154  
  2155       For i  := 1 To Pa ramCount D o                                                      // params  may be: S[ ERVER]=hos tname P[OR T]=port DE BUG
  2156       Begin
  2157         If U pperCase(P aramStr(i) ) = 'DEBUG ' Then
  2158           Wa ntDebug :=  True;
  2159         x :=  UpperCase (Piece(Par amStr(i),  '=', 1));
  2160         If ( x = 'S') O r (x = 'SE RVER') The n
  2161           AS erver := P iece(Param Str(i), '= ', 2);
  2162         If ( x = 'P') O r (x = 'PO RT') Then
  2163           AP ort := Pie ce(ParamSt r(i), '=',  2);
  2164         If ( x = 'R') O r (x = 'RE MOTE') The n
  2165         Begi n
  2166           If  Piece(Par amStr(i),  '=', 2) =  '1' Then
  2167              essoversio n := true
  2168           El se
  2169              essoversio n := false ;
  2170         End;
  2171         (* r pm 5/26/09  - TESTMOD E paramete r must be  '1' to use
  2172              Test.claim s.isc-wash . URL           server wit h BSE.
  2173            A NUTestMode  property  used to se lect corre ct Applica tionCode
  2174            S et FHIE se rver to 'S ilver' tes t server * )
  2175         if ( x = 'T') o r (x = 'TE STMODE') t hen
  2176           if  (Piece(Pa ramStr(i),  '=', 2) =  '1') then
  2177           be gin
  2178              RPCBroker1 .ANUTestMo de := True ;
  2179              RPCBrokerD OD.ANUTest Mode := Tr ue;
  2180              //Updated  server DNS  - rpm 11/ 14/12
  2181               FHIESiteLo cation :=  'silverFHI E.vaco. DNS     , PORT                       //test ser ver
  2182           en d;
  2183  
  2184         If ( x = 'VISTA HOST') The n
  2185           Vi stAHost :=  Piece(Par amStr(i),  '=', 2);
  2186         If ( x = 'DEBUG SQA') Then
  2187           If  Piece(Par amStr(i),  '=', 2) =  '1' Then
  2188           Be gin
  2189              DebugSQA : = true;
  2190           En d
  2191           El se
  2192              DebugSQA : = false;
  2193         If ( x = 'PNCST IMEOUT') T hen
  2194           PN CSTimeoutV alue := st rtoInt(Pie ce(ParamSt r(i), '=',  2));
  2195         If ( x = 'CONFI G508') The n
  2196           If  Piece(Par amStr(i),  '=', 2) =  '1' Then
  2197           Be gin
  2198              configMode 508 := tru e;
  2199              Try
  2200                frm508Me ssages.Ric hEditRaw50 8Messages. Lines.Load FromFile(e xtractfile path(appli cation.exe name) + 'C APRI508Mes sages.txt' );
  2201                Applicat ion.messag ebox('A lo cal copy o f custom S ection 508  messages  has been l oaded.' +  char(13) +  'It may b e differen t from wha t has been  compiled  into CAPRI .', '508 C ustomizati on',
  2202                  MB_OK) ;
  2203              Except
  2204              End;
  2205           En d
  2206           El se
  2207              configMode 508 := fal se;
  2208         //NO DELETEVVA  parameter  allows the  option of  not delet ing the te mporary
  2209         //Vi rtual VA P DF file... primarily  for testin g
  2210         if ( UpperCase( ParamStr(i )) = 'NODE LETEVVA')  then                             //CodeCR35 3 - rpm 5/ 30/12
  2211           FN oDeleteVVA  := True;
  2212         //SH OWDEBUGSEA RCH parame ter brings  up the te st utility  for runni ng the
  2213         // M VI search  - used for  testing
  2214         if ( UpperCase( ParamStr(i )) = 'SHOW DEBUGSEARC H') then                         //CodeCR26 7 - rpm 8/ 28/12
  2215           FM VISearchDe bug := TRU E;
  2216  
  2217         if ( UpperCase( ParamStr(i ))) = 'SAV EXML' then
  2218           PA RAM_SAVE_X ML := True ;
  2219  
  2220         if ( UpperCase( ParamStr(i ))) = 'SAV EVLERWS' t hen
  2221           PA RAM_SAVE_V LER_WS :=  True;
  2222  
  2223         if ( x = 'VLER' ) then
  2224         begi n
  2225           TI dHTTPVler. SetVlerDas URL(Piece( ParamStr(i ), '=', 2) );                    // LMS wra p variable  in optimi zation
  2226         end;
  2227       End;
  2228       Broker FirstLogin  := False;
  2229     End;
  2230     If AServ er = '' Th en
  2231     Begin
  2232       AServe r := RPCBr oker1.Serv er;
  2233       APort  := IntToSt r(RPCBroke r1.Listene rPort);
  2234     End;
  2235  
  2236       //AServer: ='cor. DNS         . URL         ';    // this is  now obsol ete, below  is correc t
  2237       //AServer: ='cor. DNS        . URL         ';
  2238       //APort:=' PORT ';
  2239       //AServer: ='forum. DNS     ';
  2240       //APort:=' PORT ';
  2241  
  2242     If (ASer ver = '')  Or (APort  = '') Then
  2243     Begin
  2244       ModalR esult := G etServerIn fo(AServer , APort);
  2245       //if M odalResult  = mrCance l then exi t; //SPH
  2246       If Mod alResult =  mrCancel  Then
  2247       Begin
  2248         //ex it;
  2249         //ap plication. OnExceptio n:=MyTempE xceptionHa ndler;
  2250         appl ication.te rminate;
  2251       End;
  2252     End;
  2253  
  2254     // Force  to ESSOVe rsion for  Forum
  2255       //CodeCR33 3 rpm 3/20 /12 - add  'CLAIMS.FO RUM. D O MAIN '
  2256       If (Upperc ase(AServe r) = 'FORU M. D O MAIN ') or
  2257         (Uppercase (AServer)  = 'CLAIMS URL          ') or                                   // lms 201 3-03-25 -  Added due  to dynamic  updates t o FQDN ent ries for F ORUM. D O MAIN , CLAIMS.F ORUM. D O MAIN  and IFCAP - DNS  . D O MAIN  are not a llowed.
  2258         (Uppercase (AServer)  = 'FORUM URL          ') or                                     // lms 201 3-03-25 -  Added as a bove
  2259         (Uppercase (AServer)  = 'CLAIMS. FORUM. D O MAIN ') Then
  2260       EssoVe rsion := T rue;
  2261  
  2262     // use t ry..except  to work a round erro rs in the  Broker Sig nOn screen
  2263     Try
  2264       if (RP CBroker1.A NUstrServe rHome = '' ) or
  2265         (ASe rver = RPC Broker1.AN UstrServer Home) then
  2266         IsCo nnected :=  RPCBroker 1.Connect2 HomeServer (RPCBroker 1.ANUAcces sCodeHome,
  2267           RP CBroker1.A NUVerifyCo deHome,
  2268           AS erver,
  2269           AP ort,
  2270           Wa ntDebug)
  2271       else
  2272       begin
  2273         if R PCBroker1. ANUBSEToke n = '' the n                                           //must ret urn "home"  and retri eve token
  2274           RP CBroker1.C onnect2Hom eServer(RP CBroker1.A NUAccessCo deHome,
  2275              RPCBroker1 .ANUVerify CodeHome,
  2276              RPCBroker1 .ANUstrSer verHome,
  2277              RPCBroker1 .ANUstrPor tHome,
  2278              WantDebug) ;
  2279         IsCo nnected :=  RPCBroker 1.Connect2 RemoteServ er(Aserver , APort, W antDebug);
  2280       end;
  2281         //    SetBrokerS erver(ASer ver, StrTo IntDef(APo rt,  PORT ), WantDeb ug);
  2282       if IsC onnected t hen
  2283       begin
  2284         if A uthorizedO ption(Opti onName) th en
  2285         begi n
  2286           RP CBroker1.R PCTimeLimi t := 28800 ;
  2287           Re sult := Tr ue;
  2288         end;
  2289       end;
  2290     Except
  2291       On E:  EBrokerErr or Do
  2292       Begin
  2293         If E .Code <> X WB_BadSign On Then
  2294           Me ssageDlgCA PRI(E.Mess age, mtErr or, [mbOK] , 0);
  2295         Resu lt := Fals e;
  2296       End;
  2297     End;
  2298   End;
  2299  
  2300   Procedure  TfrmMain.A ppMessage( Var Msg: T Msg; Var H andled: Bo olean);
  2301   Var
  2302     bReaderR unning: Bo olean;
  2303     bReaderS tateOn: Bo olean;
  2304     CrPos: T Point;
  2305     hNewWnd:  HWnd;
  2306     hWnd: TH andle;
  2307     message5 08: String ;
  2308     tempCont rol: TCont rol;
  2309     tempstri ng: String ;
  2310     tempstri ng2: Strin g;
  2311     tempstri ng3: Strin g;
  2312     tempTToo lBar: TToo lBar;
  2313     tempTWin Control: T WinControl ;
  2314     Text: St ring;
  2315     x: integ er;
  2316     xx: inte ger;
  2317     yy: inte ger;
  2318  
  2319     Function  Removewin dowscontro lstrings(s t: String) : String;
  2320     Var
  2321       x: int eger;
  2322     Begin
  2323       result  := '';
  2324       If len gth(st) >  0 Then
  2325         For  x := 1 To  length(st)  Do
  2326           If  st[x] <>  '&' Then
  2327              result :=  result + s t[x];
  2328     End;                                                                                  { Removewi ndowscontr olstrings  }
  2329  
  2330     Procedur e ButtonBa rCheck;
  2331     Var
  2332       x: int eger;
  2333     Begin
  2334       If ass igned(temp TWinContro l) Then
  2335         If ( UpperCase( Copy(tempT WinControl .Name, 1,  1)) = 'X')  And
  2336           (U pperCase(t empTWinCon trol.Class Name) = 'T TOOLBAR')  Then
  2337         Begi n
  2338           te mpTToolBar  := tempTW inControl  As TToolBa r;
  2339           If  tempTTool Bar.Button Count > 0  Then
  2340              For x := 0  To tempTT oolBar.But tonCount -  1 Do
  2341                If tempT ToolBar.Bu ttons[x].M arked = Tr ue Then
  2342                Begin
  2343                  If pie ce(tempTTo olBar.Butt ons[x].Hin t, '^', 4)  <> 'CLICK ED' Then
  2344                    temp TToolBar.B uttons[x]. Hint := te mpTToolBar .Buttons[x ].Hint + ' ^CLICKED';
  2345                  FormID Changed(Pi ece(tempTT oolBar.But tons[x].Hi nt, '^', 3 ));
  2346                End;                                                                       { for }
  2347         End;                                                                              { if }
  2348     End;                                                                                  { ButtonBa rCheck }
  2349  
  2350   Begin
  2351     tempTWin Control :=  Nil;
  2352     CurrentC ontrol :=  '';
  2353     CurrentD ialog := ' ';
  2354     If scree n.ActiveCo ntrol <> N il Then
  2355     Begin
  2356       Curren tControl : = screen.a ctivecontr ol.Name;
  2357       Curren tDialog :=  screen.Ac tiveForm.N ame;
  2358     End;
  2359  
  2360     If (Msg. message =  WM_MOUSEMO VE) Or (Ms g.message  = WM_KEYUP ) Then
  2361     Begin
  2362       // Che ck screenr eader stat e
  2363       bReade rRunning : = SystemPa rametersIn fo(SPI_GET SCREENREAD ER, 0, @bR eaderState On, 0);
  2364       Screen ReaderActi ve := (bRe aderRunnin g And bRea derStateOn );
  2365  
  2366       TimeOu tCount :=  0;
  2367  
  2368       If msg .message =  WM_MouseM ove Then
  2369       Begin
  2370           {r pm/jcs 9/2 1/2009 - R eplace Mou se.CursorP os with Wi ndows.GetC ursorPos t o
  2371            p revent err ors caused  by screen savers.  S hort-circu it when Ge tCursorPos
  2372            f ails.
  2373           Cr Pos.x := m ouse.Curso rPos.x;
  2374           Cr Pos.y := m ouse.Curso rPos.y;}
  2375         if W indows.Get CursorPos( CrPos) the n
  2376           te mpControl  := FindDra gTarget(Cr Pos, True)
  2377         else                                                                              //failed:  short-circ uit
  2378           Ex it;
  2379  
  2380         If t empControl  = Nil The n
  2381           Ex it;
  2382  
  2383         If U ppercase(t empControl .Classname ) = 'TMEMO ' Then
  2384           te mpLastMemo  := tempco ntrol As t memo;
  2385  
  2386         try                                                                               // rpk 4/2 9/2015
  2387           If  ((Upperca se(tempCon trol.Class Name) <> ' TMEMO')
  2388              And (Upper case(tempC ontrol.Nam e) <> 'XBU TTONDETAIL S'))
  2389              And (assig ned(formCu stomHint))  Then
  2390              If formCus tomHint.Vi sible = tr ue Then
  2391              Begin
  2392                formCust omHint.Tim erShowHint .Enabled : = False;
  2393                If Upper case(tempC ontrol.Nam e) = 'RICH EDITHINT'  Then
  2394                  exit;
  2395              End;
  2396         exce pt                                                                           // rpk 4/2 9/2015
  2397         end;                                                                              // rpk 4/2 9/2015
  2398       End;                                                                                // If msg. message =  WM_MouseMo ve Then
  2399  
  2400       // Sho w 508 mess ages
  2401       If Spe echAPIInst alled = Tr ue Then
  2402       Begin
  2403         If C urrentDial og <> scre en.ActiveF orm.Name T hen
  2404         Begi n
  2405           //  Dialog ch anged, che ck for aut o message
  2406           me ssage508 : = '';
  2407           x  := 0;
  2408           Re peat
  2409              If upperca se(frm508M essages.Ri chEditRaw5 08Messages .Lines[x])  = upperca se('AMD.'  + screen.A ctiveForm. Name) Then
  2410              Begin
  2411                Repeat
  2412                  inc(x) ;
  2413                  If frm 508Message s.RichEdit Raw508Mess ages.Lines [x] <> '!@ #$END$#@!'  Then
  2414                    Mess age508 :=  Message508  + frm508M essages.Ri chEditRaw5 08Messages .Lines[x];
  2415                Until fr m508Messag es.RichEdi tRaw508Mes sages.Line s[x] = '!@ #$END$#@!' ;
  2416                x := frm 508Message s.RichEdit Raw508Mess ages.Lines .Count;
  2417                If Speec hAPIInstal led = True  Then
  2418                Begin
  2419                  If frm Properties .CheckBoxA ctivateSpe echPrompts .Checked T hen
  2420                    SPVo ice1.Speak ('<speak>'  + Message 508 + '</s peak>', SV SFlagsAsyn c + SVSFPu rgeBeforeS peak);
  2421                End;
  2422                //Applic ation.Mess ageBox(PCh ar(Message 508),'508  Automessag e for Cont rol',mb_ok );
  2423              End;
  2424              inc(x);
  2425           Un til x >= f rm508Messa ges.RichEd itRaw508Me ssages.Lin es.Count -  1;
  2426         End;
  2427       End;
  2428  
  2429       If Spe echAPIInst alled = Tr ue Then
  2430       Begin
  2431         If ( CurrentCon trol <> sc reen.activ econtrol.N ame) And ( frmPropert ies.CheckB oxActivate SpeechProm pts.Checke d = true)  Then
  2432         Begi n
  2433           me ssage508 : = '';
  2434           //  Control c hanged, sp eak it
  2435  
  2436           If  Uppercase ((Screen.A ctiveContr ol.ClassNa me)) = 'TB UTTON' The n
  2437           Be gin
  2438              message508  := ((Scre en.ActiveC ontrol) As  TButton). Caption +  ' button';
  2439              Message508  := Remove windowscon trolstring s(message5 08);
  2440           En d
  2441           El se
  2442              If Upperca se((Screen .ActiveCon trol.Class Name)) = ' TBITBTN' T hen
  2443              Begin
  2444                message5 08 := ((Sc reen.Activ eControl)  As TButton ).Caption  + ' button ';
  2445                Message5 08 := Remo vewindowsc ontrolstri ngs(messag e508);
  2446              End
  2447              Else
  2448                If Upper case((Scre en.ActiveC ontrol.Cla ssName)) =  'TCHECKBO X' Then
  2449                Begin
  2450                  messag e508 := (( Screen.Act iveControl ) As TChec kBox).Capt ion + ' ch eckbox';
  2451                  If ((S creen.Acti veControl)  As TCheck Box).Check ed = True  Then
  2452                    mess age508 :=  message508  + ' - che cked'
  2453                  Else
  2454                    mess age508 :=  message508  + ' - not  checked';
  2455                  Messag e508 := Re movewindow scontrolst rings(mess age508);
  2456                End;
  2457  
  2458           If  message50 8 <> '' Th en
  2459              SPVoice1.S peak('<spe ak>' + Mes sage508 +  '</speak>' , SVSFlags Async + SV SFPurgeBef oreSpeak);
  2460  
  2461           //  Control c hanged, ch eck for au to message
  2462           me ssage508 : = '';
  2463           x  := 0;
  2464           Re peat
  2465              If upperca se(frm508M essages.Ri chEditRaw5 08Messages .Lines[x])  = upperca se('AMC.'  + screen.A ctiveForm. Name + '.'  + screen. activecont rol.Name)  Then
  2466              Begin
  2467                Repeat
  2468                  inc(x) ;
  2469                  If frm 508Message s.RichEdit Raw508Mess ages.Lines [x] <> '!@ #$END$#@!'  Then
  2470                    Mess age508 :=  Message508  + frm508M essages.Ri chEditRaw5 08Messages .Lines[x];
  2471                Until fr m508Messag es.RichEdi tRaw508Mes sages.Line s[x] = '!@ #$END$#@!' ;
  2472                x := frm 508Message s.RichEdit Raw508Mess ages.Lines .Count;
  2473                If Speec hAPIInstal led = True  Then
  2474                Begin
  2475                  If frm Properties .CheckBoxA ctivateSpe echPrompts .Checked T hen
  2476                    SPVo ice1.Speak ('<speak>'  + Message 508 + '</s peak>', SV SFlagsAsyn c + SVSFPu rgeBeforeS peak);
  2477                End;
  2478              End;
  2479              inc(x);
  2480           Un til x >= f rm508Messa ges.RichEd itRaw508Me ssages.Lin es.Count -  1;
  2481         End;
  2482       End;
  2483  
  2484       If Spe echAPIInst alled = Tr ue Then
  2485       Begin
  2486         If ( configMode 508 = true ) And (msg .message =  WM_KEYUP)  And (Msg. wParam = V K_F1) Then
  2487         Begi n
  2488           //  Dialog he lp message  activated
  2489           me ssage508 : = '';
  2490           x  := 0;
  2491           Re peat
  2492              If upperca se(frm508M essages.Ri chEditRaw5 08Messages .Lines[x])  = upperca se('HMD.'  + screen.A ctiveForm. Name) Then
  2493              Begin
  2494                Repeat
  2495                  inc(x) ;
  2496                  If frm 508Message s.RichEdit Raw508Mess ages.Lines [x] <> '!@ #$END$#@!'  Then
  2497                    Mess age508 :=  Message508  + frm508M essages.Ri chEditRaw5 08Messages .Lines[x];
  2498                Until fr m508Messag es.RichEdi tRaw508Mes sages.Line s[x] = '!@ #$END$#@!' ;
  2499                x := frm 508Message s.RichEdit Raw508Mess ages.Lines .Count;
  2500                If Speec hAPIInstal led = True  Then
  2501                Begin
  2502                  If frm Properties .CheckBoxA ctivateSpe echPrompts .Checked T hen
  2503                    SPVo ice1.Speak ('<speak>'  + Message 508 + '</s peak>', SV SFlagsAsyn c + SVSFPu rgeBeforeS peak);
  2504                End;
  2505              End;
  2506              inc(x);
  2507           Un til x >= f rm508Messa ges.RichEd itRaw508Me ssages.Lin es.Count -  1;
  2508         End;
  2509       End;
  2510  
  2511       If Spe echAPIInst alled = Tr ue Then
  2512       Begin
  2513         If ( configMode 508 = true ) And (msg .message =  WM_KEYUP)  And (Msg. wParam = V K_F2) Then
  2514         Begi n
  2515           //  Control h elp messag e activate d
  2516           me ssage508 : = '';
  2517           x  := 0;
  2518           Re peat
  2519              If upperca se(frm508M essages.Ri chEditRaw5 08Messages .Lines[x])  = upperca se('HMC.'  + screen.A ctiveForm. Name + '.'  + screen. activecont rol.Name)  Then
  2520              Begin
  2521                Repeat
  2522                  inc(x) ;
  2523                  If frm 508Message s.RichEdit Raw508Mess ages.Lines [x] <> '!@ #$END$#@!'  Then
  2524                    Mess age508 :=  Message508  + frm508M essages.Ri chEditRaw5 08Messages .Lines[x];
  2525                Until fr m508Messag es.RichEdi tRaw508Mes sages.Line s[x] = '!@ #$END$#@!' ;
  2526                x := frm 508Message s.RichEdit Raw508Mess ages.Lines .Count;
  2527                If Speec hAPIInstal led = True  Then
  2528                Begin
  2529                  If frm Properties .CheckBoxA ctivateSpe echPrompts .Checked T hen
  2530                    SPVo ice1.Speak ('<speak>'  + Message 508 + '</s peak>', SV SFlagsAsyn c + SVSFPu rgeBeforeS peak);
  2531                End;
  2532              End;
  2533              inc(x);
  2534           Un til x >= f rm508Messa ges.RichEd itRaw508Me ssages.Lin es.Count -  1;
  2535         End;
  2536       End;
  2537  
  2538       If (co nfigMode50 8 = true)  And (msg.m essage = W M_KEYUP) A nd (Msg.wP aram = VK_ F5) And (s creen.Acti veForm.Nam e <> 'frm5 08Messages ') Then
  2539       Begin
  2540         frm5 08Messages .EditCurre ntControl. text := sc reen.activ econtrol.N ame;
  2541         frm5 08Messages .EditCurre ntDialog.t ext := scr een.Active Form.Name;
  2542         frm5 08Messages .BringToFr ont;
  2543         frm5 08Messages .ShowModal ;
  2544         frm5 08Messages .TabbedNot ebook1.Pag eIndex :=  0;
  2545         Try
  2546         frm5 08Messages .MemoHelpC urrentDial og.SetFocu s Except
  2547         End;
  2548       End;
  2549  
  2550       If (ms g.message  = WM_KEYUP ) And (Msg .wParam =  VK_F7) The n
  2551       Begin
  2552         text  := screen .activecon trol.class Name;
  2553         If ( text <> 'T Edit') And  (text <>  'TMemo') A nd (text < > 'TRichEd it') And
  2554           (t ext <> 'TF MMemo') Th en
  2555         Begi n
  2556           ex it;
  2557         End;
  2558  
  2559         If N ot assigne d(frmSpell check) The n
  2560         Begi n
  2561           //  Need hour glass b/c  word list  takes time  to load
  2562           sc reen.curso r := crHou rglass;
  2563           fr mSpellChec k := TfrmS pellCheck. Create(frm Main);
  2564           sc reen.curso r := crDef ault;
  2565           te xtposspell check := 0 ;
  2566           wh ichspellch eckline :=  0;
  2567         End;
  2568         hWnd  := screen .activecon trol.Handl e;
  2569         frmS pellCheck. RichEditTe xtToCheck. Lines.Clea r;
  2570  
  2571         temp control :=  Nil;
  2572  
  2573         If t ext = 'TEd it' Then
  2574           te mpControl  := screen. activecont rol As TEd it;
  2575         If t ext = 'TMe mo' Then
  2576           te mpControl  := screen. activecont rol As TMe mo;
  2577         If t ext = 'TRi chEdit' Th en
  2578           te mpControl  := screen. activecont rol As TRi chEdit;
  2579         If t ext = 'TFM Memo' Then
  2580           te mpControl  := screen. activecont rol As TFM Memo;
  2581  
  2582         text  := '';
  2583  
  2584         xx : = SendMess age(hWnd,  WM_GETTEXT LENGTH, 0,  0);
  2585         For  xx := 0 To  xx Do
  2586           te xt := text  + ' ';
  2587         // U se pointer  to first  character  of string  space
  2588         Send Message(hW nd, WM_GET TEXT, Leng th(Text),  integer(ad dr(text[1] )));
  2589         frmS pellCheck. RichEditTe xtToCheck. Text := te xt;
  2590         text  := '';                                                                      // free up  memory
  2591         If f rmSpellChe ck.Visible  = false T hen
  2592           If  frmSpellc heck.Showm odal <> mr Cancel The n
  2593           Be gin
  2594              If tempCon trol = Nil  Then
  2595                exit;
  2596              If tempcon trol Is TE dit Then
  2597              Begin
  2598                If TEdit (tempcontr ol).readon ly = false  Then
  2599                Begin
  2600                  If frm SpellCheck .RichEditT extToCheck .Text = ''  Then
  2601                  Begin
  2602                    If U serConfirm sAssigning EmptyStrin g Then
  2603                      TE dit(tempco ntrol).tex t := frmSp ellCheck.R ichEditTex tToCheck.T ext;
  2604                  End
  2605                  Else
  2606                    TEdi t(tempcont rol).text  := frmSpel lCheck.Ric hEditTextT oCheck.Tex t
  2607                End
  2608                Else
  2609                  showme ssage('Thi s control  is read on ly.  Chang es were no t made.')
  2610              End
  2611              Else
  2612                If tempc ontrol Is  TMemo Then
  2613                Begin
  2614                  If TMe mo(tempcon trol).read only = fal se Then
  2615                  Begin
  2616                    If f rmSpellChe ck.RichEdi tTextToChe ck.Text =  '' Then
  2617                    Begi n
  2618                      If  UserConfi rmsAssigni ngEmptyStr ing Then
  2619                         TMemo(temp control).t ext := frm SpellCheck .RichEditT extToCheck .Text
  2620                    End
  2621                    Else
  2622                      TM emo(tempco ntrol).tex t := frmSp ellCheck.R ichEditTex tToCheck.T ext
  2623                  End
  2624                  Else
  2625                    show message('T his contro l is read  only.  Cha nges were  not made.' );
  2626                End
  2627                Else
  2628                  If tem pcontrol I s TRichEdi t Then
  2629                  Begin
  2630                    If T RichEdit(t empcontrol ).readonly  = false T hen
  2631                    Begi n
  2632                      If  frmSpellC heck.RichE ditTextToC heck.Text  = '' Then
  2633                      Be gin
  2634                         If UserCon firmsAssig ningEmptyS tring Then
  2635                           TRichEdi t(tempcont rol).text  := frmSpel lCheck.Ric hEditTextT oCheck.Tex t
  2636                      En d
  2637                      El se
  2638                         TRichEdit( tempcontro l).text :=  frmSpellC heck.RichE ditTextToC heck.Text
  2639                    End
  2640                    Else
  2641                      sh owmessage( 'This cont rol is rea d only.  C hanges wer e not made .');
  2642                  End
  2643                  Else
  2644                    If t empcontrol  Is TFMMem o Then
  2645                    Begi n
  2646                      If  TFMMemo(t empcontrol ).readonly  = false T hen
  2647                      Be gin
  2648                         If frmSpel lCheck.Ric hEditTextT oCheck.Tex t = '' The n
  2649                         Begin
  2650                           If UserC onfirmsAss igningEmpt yString Th en
  2651                             TFMMem o(tempcont rol).text  := frmSpel lCheck.Ric hEditTextT oCheck.Tex t
  2652                         End
  2653                         Else
  2654                           TFMMemo( tempcontro l).text :=  frmSpellC heck.RichE ditTextToC heck.Text
  2655                      En d
  2656                      El se
  2657                         showmessag e('This co ntrol is r ead only.   Changes w ere not ma de.');
  2658                    End;
  2659           En d;                                                                           // If frmS pellcheck. Showmodal  <> mrCance l Then
  2660       End;                                                                                // If (msg .message =  WM_KEYUP)  And (Msg. wParam = V K_F7) Then
  2661  
  2662     End;                                                                                  // If (Msg .message =  WM_MOUSEM OVE) Or (M sg.message  = WM_KEYU P) Then
  2663  
  2664     If PNCSR esetDoneBu tton = Tru e Then
  2665     Begin
  2666       PNCSRe setDoneBut ton := Fal se;
  2667       If PNC SForm <> N il Then
  2668         PNCS Form.xButt on4.Enable d := True;
  2669     End;
  2670  
  2671     If (Msg. message =  WM_LBUTTON UP) Then
  2672     Begin
  2673       If Fir stRun = 1  Then
  2674         exit ;
  2675       PauseS cript := F alse;
  2676       If PNC SForm = Ni l Then
  2677         exit ;
  2678       If PNC SForm <> N il Then
  2679         If P NCSForm.Ac tive = Fal se Then
  2680           ex it;
  2681       PNCSEv ent := Tru e;
  2682       tempst ring2 := ' ';
  2683       Try
  2684         temp TWinContro l := FindC ontrol(msg .Hwnd);
  2685         If t empTWinCon trol = Nil  Then
  2686           Ex it;
  2687  
  2688         If t empTWinCon trol.Class name = 'TG roupButton ' Then
  2689         Begi n
  2690           //  Get paren t radiogro up name th at'll be r eferenced  in the scr ipt
  2691           PN CSEventCon trol := te mpTWinCont rol.Parent .Name;
  2692           te mpstring2  := tempTWi nControl.P arent.Name ;
  2693           te mpTWinCont rol.Hint : = tempTWin Control.Pa rent.Hint;
  2694           PN CSButtonWa sClicked : = True;
  2695         End
  2696         Else
  2697           If  tempTWinC ontrol.Nam e <> '' Th en
  2698           Be gin
  2699              If upperca se(copy(te mpTWinCont rol.Name,  1, 1)) = ' X' Then
  2700              Begin
  2701                // one o f the form 's buttons  or object s was clic ked, so do n't reset
  2702                // the s cript
  2703                PNCSEven t := False ;
  2704                exit;
  2705              End;
  2706              PNCSEventC ontrol :=  tempTWinCo ntrol.Name ;
  2707              PNCSButton WasClicked  := True;
  2708           En d
  2709           El se
  2710           Be gin
  2711              // PNCSEve ntControl: ='';
  2712           En d;
  2713       Except
  2714       End;
  2715       button barcheck;
  2716       If cur rentPNCSTa bName = ''  Then
  2717         curr entPNCSTab Name := '? ?UNKNOWN?? ';
  2718       If tem pTWinContr ol <> Nil  Then
  2719         If t empTWinCon trol.Class Name = 'TT abbedNoteb ook' Then
  2720           If  Uppercase (tempTWinC ontrol.Nam e) = 'XMET ANOTEBOOK'  Then
  2721              currentPNC STabName : = (tempTWi nControl A s TTabbedN otebook).A ctivePage;
  2722       If (lo ggermodefo rCPEP = tr ue) Then
  2723       Begin
  2724         temp String :=  FormatDate Time('hh:n n:ss:zzz',  now - sta rttime);
  2725         If t empTWinCon trol <> Ni l Then
  2726         Begi n
  2727           te mpstring3  := tempTWi nControl.H int;
  2728           If  tempTWinC ontrol.Nam e = 'RichE ditHint' T hen
  2729           Be gin
  2730              tempstring 2 := Piece (tempTWinC ontrol.Hin t, '^', 2) ;
  2731              tempstring 3 := Piece (tempTWinC ontrol.Hin t, '^', 1) ;
  2732              val(Piece( tempTWinCo ntrol.Hint , '^', 1),  xx, yy);
  2733              If yy <> 0  Then
  2734                Raise Ex ception.Cr eate('Erro r:val(Piec e(tempTWin Control.Hi nt, ''^'',  1), xx, y y);>yy=' +  IntToStr( yy) + ';') ;
  2735           En d
  2736           El se
  2737           Tr y
  2738           va l(tempTWin Control.Hi nt, xx, yy )Except xx  := 0
  2739           En d;
  2740           If  tempTWinC ontrol.Hin t <> '' Th en
  2741              If xx > 0  Then
  2742              Begin
  2743                If temps tring2 = ' ' Then
  2744                  tempst ring2 := t empTWinCon trol.Name;
  2745                If tempT WinControl .Name = 'R ichEditHin t' Then
  2746                  tempst ring2 := t empLastMem o.Name;
  2747                RichEdit FormEvents .Lines.Add ('"' + For matDateTim e('hh:nn:s s:zzz', no w) + '","'  + tempstr ing + '"," ' + tempst ring2 + '" ,"' + temp string3 +  '","' + cu rrentpncst abname + ' ","' + pat ientssn +
  2748                  '","Cl ick"');
  2749              End;
  2750         End;
  2751       End;
  2752     End;
  2753  
  2754     If (Msg. message =  WM_KEYUP)  Then
  2755     Begin
  2756  
  2757       If fir strun = 1  Then
  2758         exit ;
  2759       PauseS cript := T rue;
  2760       SendPN CSCounter  := 0;                                                             // Wait 2  seconds af ter final  keypress t o send a m essage
  2761       tempTW inControl  := FindCon trol(msg.H wnd);
  2762       button barcheck;
  2763       If (te mpTWinCont rol <> Nil ) Then
  2764       Begin
  2765         Send PNCSEvent  := tempTWi nControl.N ame;
  2766         Send PNCSEventH int := tem pTWinContr ol.Hint;
  2767       End
  2768       Else
  2769       Begin
  2770         Send PNCSEvent  := '8974u8 93oirjhweg erwuyrty34 289rdjery8 t949okdgjk fg';
  2771         Send PNCSEventH int := '';
  2772       End;
  2773  
  2774     End;
  2775  
  2776     If ANURe moteProced ureCallInP rogress =  true Then
  2777     Begin
  2778       If Msg .message =  WM_CHAR T hen
  2779       Begin
  2780         hand led := Tru e;
  2781       End;
  2782       If Msg .message =  WM_LBUTTO NUP Then
  2783       Begin
  2784         hand led := Tru e;
  2785       End;
  2786       If Msg .message =  WM_MBUTTO NUP Then
  2787       Begin
  2788         hand led := Tru e;
  2789       End;
  2790       If Msg .message =  WM_RBUTTO NUP Then
  2791       Begin
  2792         hand led := Tru e;
  2793       End;
  2794       If Msg .message =  WM_LBUTTO NDOWN Then
  2795       Begin
  2796         hand led := Tru e;
  2797       End;
  2798       If Msg .message =  WM_MBUTTO NDOWN Then
  2799       Begin
  2800         hand led := Tru e;
  2801       End;
  2802       If Msg .message =  WM_RBUTTO NDOWN Then
  2803       Begin
  2804         hand led := Tru e;
  2805       End;
  2806     End;
  2807  
  2808     Try                                                                                   // Need th e try...ex cept to pr event erro r when ret urning fro m active s creen save r
  2809       If ass igned(PNCS Form) And  (PNCSForm. Active) Th en
  2810         If P NCSForm.xb uttondetai ls.visible  = true Th en
  2811         Begi n
  2812           hN ewWnd := W indowFromP oint(Mouse .CursorPos );
  2813           If  (hNewWnd  <> hOldWnd ) And (hNe wWnd <> 0)  Then
  2814              If (assign ed(formCus tomHint) A nd (formCu stomHint.V isible = F alse)) Or
  2815                (Not ass igned(form CustomHint )) Then
  2816                If (PNCS Form.xButt onDetails. Handle <>  hNewWnd) T hen
  2817                  PNCSFo rm.xButton Details.Vi sible := F alse;
  2818              // Don't l ose the la st handle  if pointin g to the b utton itse lf
  2819           If  hNewWnd < > PNCSForm .xButtonDe tails.Hand le Then
  2820              hOldWnd :=  hNewWnd;
  2821         End;                                                                              { if }
  2822     Except
  2823     End;
  2824  
  2825     { for al l other me ssages, Ha ndled rema ins False  }
  2826     { so tha t other me ssage hand lers can r espond }
  2827   End;
  2828  
  2829   Function T frmMain.Us erConfirms AssigningE mptyString : boolean;
  2830   Var
  2831     Msg: Str ing;
  2832   Begin
  2833     result : = False;
  2834     Msg := ' There will  be no tex t transfer red back i nto' + CR  + LF;
  2835     Msg := M sg + 'the  original M emo contro l.' + CR +  LF + CR +  LF;
  2836     Msg := M sg + 'Do y ou want to  proceed?' ;
  2837     If Appli cation.Mes sageBox(PC har(Msg),  'Transfer  empty text ?', MB_YES NO) = IDYE S Then
  2838       result  := True;
  2839   End;                                                                                    { UserConf irmsAssign ingEmptySt ring }
  2840  
  2841   Procedure  TfrmMain.A nimateLogo (YesOrNo:  Boolean);
  2842   Begin
  2843     If YesOr No = True  Then
  2844     Begin
  2845       Try
  2846       ImageV istaRed.Vi sible := F alse Excep t
  2847       End;
  2848       TGifIm age(GifIma geVistaYel low.pictur e.Graphic) .Animation Speed := 1 500;
  2849       TGifIm age(GifIma geVistaYel low.pictur e.Graphic) .PaintStar t;
  2850  
  2851       Try
  2852       GifIma geVistaYel low.Visibl e := True  Except
  2853       End;
  2854       BitBtn VistA.enab led := fal se;
  2855       //Chan geVerifyCo de1.enable d:=False;
  2856     End
  2857     Else
  2858     Begin
  2859       Try
  2860       ImageV istaRed.Vi sible := T rue Except
  2861       End;
  2862       TGifIm age(GifIma geVistaYel low.pictur e.Graphic) .PaintStop ;
  2863       Try
  2864       GifIma geVistaYel low.Visibl e := False  Except
  2865       End;
  2866       if Ess oVersion =  False The n
  2867       begin
  2868         BitB tnVistA.En abled := F alse;
  2869       end
  2870       else
  2871       begin
  2872         BitB tnVistA.En abled := T rue;                                                   //only rem ote connec tions - rp m 3/17/09
  2873       end;
  2874  
  2875       //Chan geVerifyCo de1.enable d:=True;
  2876       ANURem oteProcedu reCallInPr ogress :=  False;
  2877     End;
  2878   End;
  2879  
  2880   Procedure  TfrmMain.S aveToUsers TempDirect ory(Sender : TObject;  ErrorMsg:  String; P arseErrorM sg: boolea n);
  2881   Var
  2882     AddText:  String;
  2883     DatePart : String;
  2884     Filename : String;
  2885     SaveFile : TextFile ;
  2886     TextHold er: String ;
  2887     VersionP art: Strin g;
  2888   Begin
  2889     //DatePa rt := IntT oStr(DateT imeToFileD ate(Date)) ;
  2890     DateTime ToString(D atePart, ' dd_mm_yy',  Date);
  2891     VersionP art := Ver sionUser;
  2892     VersionP art := Str ingReplace (VersionPa rt, '*', ' _', [rfRep laceAll]);
  2893     Filename  := TempDi r + Versio nPart + '_ ' + DatePa rt + '.Txt ';
  2894     SetFileA ttributesR eadOnly(Se nder, File name, Fals e);
  2895     AssignFi le(SaveFil e, FileNam e);
  2896     { append  each days  messages  or create  a new file  for each  day }
  2897     Try
  2898       Try
  2899         If F ileExists( FileName)  Then
  2900           Ap pend(SaveF ile)
  2901         Else
  2902           Re Write(Save File);
  2903         Writ eLn(SaveFi le, '');
  2904         Writ eLn(SaveFi le, 'APPLI CATION EXC EPTION AT  ' + DateTi meToStr(No w));
  2905         Writ eLn(SaveFi le, 'User:  ' + Autho rName);
  2906         Writ eLn(SaveFi le, 'User  Division:  ' + UserDi vision + C R + LF);
  2907         If ( Sender <>  Nil) Then
  2908           If  (Sender I s TCompone nt) And (T Component( Sender).Na me <> '')  Then
  2909           Be gin
  2910              WriteLn(Sa veFile, '-    Sender  Name: ' +  TComponent (Sender).N ame);
  2911              If (TCompo nent(Sende r).Owner < > Nil) And  (TCompone nt(Sender) .Owner.Nam e <> '') T hen
  2912                WriteLn( SaveFile,  '-   Sende r Owner: '  + TCompon ent(Sender ).Owner.Na me);
  2913           En d;
  2914         Text Holder :=  'Error Mes sage:  ' +  ErrorMsg;
  2915         If P arseErrorM sg Then
  2916           Re peat
  2917              Begin
  2918                AddText  := Copy(Te xtHolder,  1, 128);
  2919                WriteLn( SaveFile,  AddText);
  2920                If AddTe xt = Error Msg Then
  2921                  TextHo lder := ''
  2922                Else
  2923                  TextHo lder := Co py(TextHol der, 129,  length(Tex tHolder) -  128);
  2924           En d Until Te xtHolder =  ''
  2925         Else
  2926           Wr iteLn(Save File, Text Holder);
  2927       Except
  2928         On e : EInOutEr ror Do
  2929           Ap plication. MessageBox (PChar(E.M essage), P Char('Exce ption File  Error'),  MB_OK);
  2930       End;                                                                                { try/exce pt }
  2931  
  2932     Finally
  2933       Try
  2934         Flus h(SaveFile );
  2935         Clos eFile(Save File);
  2936         SetF ileAttribu tesReadOnl y(Sender,  Filename,  True);
  2937       Except
  2938         Clos eFile(Save File);
  2939       End;                                                                                { try/fina lly }
  2940     End;                                                                                  { try/fina lly }
  2941  
  2942   End;                                                                                    { SaveToUs ersTempDir ectory }
  2943  
  2944   Procedure  TfrmMain.S etFileAttr ibutesRead Only(Sende r: TObject ; FileName : String;  ReadOnly:  boolean);
  2945   Var
  2946     Attribut es: word;
  2947     Msg: Str ing;
  2948     NewAttri butes: wor d;
  2949     ToFrom:  String;
  2950   Begin
  2951     If FileE xists(File name) Then
  2952     Begin
  2953       Attrib utes := Fi leGetAttr( Filename);
  2954       If Rea dOnly Then
  2955         ToFr om := 'to'
  2956       Else
  2957         ToFr om := 'fro m';
  2958  
  2959       If Rea dOnly Then
  2960         NewA ttributes  := Attribu tes + SysU tils.faRea dOnly
  2961       Else
  2962         NewA ttributes  := Attribu tes - SysU tils.faRea dOnly;
  2963  
  2964       If Fil eSetAttr(F ilename, N ewAttribut es) <> 0 T hen
  2965       Begin
  2966         Msg  := 'Could  not change  ' + ToFro m + ' Read Only: ' +  FileName;
  2967         Save ToUsersTem pDirectory (Sender, M sg, False) ;
  2968       End;
  2969     End;                                                                                  { File exi sts }
  2970   End;                                                                                    { SetFileA ttributesR eadOnly }
  2971  
  2972   { procedur e TfrmMain .Applicati onEvents1M essage(var  Msg: tagM SG;
  2973     var Hand led: Boole an);
  2974   var
  2975     mousePos : TPoint;
  2976     wc: TWin Control;
  2977   begin
  2978     // mouse  wheel scr olling for  the contr ol under t he mouse
  2979     if Msg.m essage = W M_MOUSEWHE EL then
  2980     begin
  2981       mouseP os.X := Wo rd(Msg.lPa ram);
  2982       mouseP os.Y := Hi Word(Msg.l Param);
  2983       wc :=  FindVCLWin dow(mouseP os);
  2984       if wc  = nil then
  2985         Hand led := Tru e
  2986       else
  2987         if w c.Handle < > Msg.hwnd  then
  2988         begi n
  2989           Se ndMessage( wc.Handle,  WM_MOUSEW HEEL, Msg. wParam, Ms g.lParam);
  2990           Ha ndled := T rue;
  2991         end;
  2992     end;
  2993   end; }
  2994  
  2995   (* procedu re TfrmMai n.Applicat ionEvents1 Idle(Sende r: TObject ; var Done : Boolean) ;
  2996   var
  2997     ctrl: TW inControl;
  2998   begin
  2999   {$IFDEF CA PRIDEVELOP ER}
  3000     ctrl :=  FindVCLWin dow(Mouse. CursorPos) ;
  3001     if ctrl  <> nil the n
  3002     begin
  3003       Captio n := ctrl. Name;
  3004     end;
  3005   {$ENDIF}
  3006   end; *)
  3007  
  3008   {========= ========== ========== ========== ========== ========== ========== ======
  3009   CAPRI_Code CR95  - jc s - 05/20/ 2010
  3010   Made sever al changes  in relati on to the  new RPC Br oker call  wrapper.
  3011   The intent  here is t o display  additional  informati on to the  user, then
  3012   force a sh ut down of  the appli cation aft er an erro r occurs.
  3013  
  3014   Modificati on history :
  3015     02/2011   -MER v149  build 7 T his proced ure was mo dified to  terminate  the
  3016       applic ation only  when crit ical error s occurred .
  3017   ========== ========== ========== ========== ========== ========== ========== =====}
  3018  
  3019   Procedure  TfrmMain.A pplication ExceptionH andler(Sen der: TObje ct; E: Exc eption);
  3020   Var
  3021     Msg: Str ing;
  3022     MsgError : String;
  3023     LogMessa ge: String ;
  3024     CallStac k: TString List;
  3025     i: Integ er;
  3026  
  3027     Procedur e PrepareM essages(Ne edTerminat e: Boolean );                               // -MER 02 /2011
  3028     Begin
  3029       MsgErr or := E.Me ssage;
  3030       Msg :=  'An error  has been  captured a t the appl ication le vel by CAP RI. ' + CR LF;
  3031       if Nee dTerminate  then begi n                                                      // -MER 02 /2011
  3032         Msg  := Msg + ' CAPRI must  now shut  down in or der to rec over from  the error. ' + CRLF +  CRLF;
  3033         Msg  := Msg + ' Please re- launch CAP RI and ver ify the st ate of any  work that  was in pr ogress.' +  CRLF;
  3034       end;
  3035       Msg :=  Msg + CR  + LF + 'Th e followin g informat ion descri bes the er ror:' + CR LF + CRLF;
  3036     End;                                                                                  { PrepareM essages }
  3037  
  3038     Procedur e ShowUser Message;
  3039     Var
  3040       UserCa ption: Str ing;
  3041       UserMs g: String;
  3042     Begin
  3043       UserMs g := Msg +  MsgError;
  3044       UserCa ption := ' CAPRI: App lication E xception';
  3045       { filt er only fr mPNCS with  Sender <>  Nil }
  3046       Applic ation.Mess ageBox(PCh ar(UserMsg ), PChar(U serCaption ), MB_OK);
  3047     End;                                                                                  { ShowUser Message }
  3048  
  3049   Begin
  3050     Screen.c ursor := c rDefault;
  3051  
  3052     //CAPRI_ CodeCR94 -  jcs - 03/ 02/10
  3053     CallStac k := TStri ngList.Cre ate;
  3054     try                                                                                   // -MER 2/ 2011
  3055       JclLas tExceptSta ckListToSt rings(Call Stack, Fal se, True,  True, True );
  3056       LogMes sage := #1 3 + #10 +  #13 + #10  + 'Call St ack:' + #1 3 + #10;
  3057  
  3058       for i  := 0 to Ca llStack.co unt - 1 do
  3059         LogM essage :=  LogMessage  + CallSta ck[i] + #1 3 + #10;
  3060       SaveTo UsersTempD irectory(S ender, E.M essage + L ogMessage,  False);
  3061     finally
  3062       CallSt ack.Free;
  3063     end;
  3064  
  3065     // -MER  2/2011 Bra nch on the  type of e xception.   We will t erminate f or
  3066     // criti cal except ions.  For  all other  exception s that are  not class
  3067     // EPasc alScriptFa ilure, we  will show  a formatte d message
  3068     if (E is  EBrokerEr ror) or (E  is EAcces sViolation ) or (E is  EHeapExce ption) or
  3069       (E is  EInvalidOp ) or (E is  EInvalidP ointer) or  (E is EOS Error) or
  3070       (E is  EOutOfMemo ry)
  3071       then b egin
  3072       // Nee d to termi nate
  3073       if shu ttingdown  <> true th en begin
  3074         Prep areMessage s(TRUE);
  3075         Show UserMessag e;
  3076       end;
  3077       Applic ation.Term inate;
  3078     end else  if not (E  Is EPasca lScriptFai lure) then  begin
  3079       // for  EPascalSc riptFailur e, the use r has alre ady been n otified.   In all
  3080       // oth er cases,  we show th e user mes sage, but  do not ter minate
  3081       if shu ttingdown  <> true th en begin
  3082         Prep areMessage s(FALSE);
  3083         Show UserMessag e;
  3084       end;
  3085     end;
  3086   End;                                                                                    { Applicat ionExcepti onHandler  }
  3087  
  3088   Procedure  TfrmMain.F ormCreate( Sender: TO bject);
  3089   Var
  3090     Director yName: Str ing;
  3091     fStream:  TMemorySt ream;
  3092     rStream:  TResource Stream;
  3093     SOToken:  ISpeechOb jectToken;
  3094     SOTokens : ISpeechO bjectToken s;
  3095     x: integ er;
  3096     y: integ er;
  3097     lslConfi g: TString List;                                                             // CodeCR1 68 -MER 04 /2011
  3098     OrigHelp File: Stri ng;                                                               // CodeCR3 81 - LMS 2 012-11-15
  3099     NewHelpF ile: Strin g;                                                                // CodeCR3 81 - LMS 2 012-11-15
  3100     ChangeHe lp: Boolea n;                                                                // CodeCR3 81 - LMS 2 012-11-15
  3101  
  3102     //sColor  should be  in XXXXXX  format
  3103     //(X bei ng a hex d igit)
  3104     Function  HexToTCol or(sColor:  String):  TColor;
  3105     Begin
  3106       Result  :=
  3107         RGB(
  3108         { ge t red valu e }
  3109         StrT oInt('$' +  Copy(sCol or, 1, 2)) ,
  3110         { ge t green va lue }
  3111         StrT oInt('$' +  Copy(sCol or, 3, 2)) ,
  3112         { ge t blue val ue }
  3113         StrT oInt('$' +  Copy(sCol or, 5, 2))
  3114         );
  3115     End;
  3116  
  3117   Begin
  3118     Applicat ion.HelpFi le := Extr actFilePat h(Applicat ion.ExeNam e) + 'CAPR I_Help.CHM '; // Code CR381 -MER  6/2012
  3119  
  3120     OrigHelp File := Ap plication. HelpFile;
  3121     CAPRIHel pMgr.Chang eApplicati onHelpFile ToLocal(Or igHelpFile , NewHelpF ile, Chang eHelp); //  CodeCR381  - LMS 201 2-11-15
  3122     If Chang eHelp then  Applicati on.HelpFil e := NewHe lpFile;
  3123  
  3124     Reflecti onWrapper  := TReflec tionWrappe r.Create;                                   // CodeCR1 85 -MER 04 /2011
  3125     WaitForm  := TWaitF orm.Create (Applicati on);
  3126  
  3127     dtpDODSt artDate.Da te := NOW;                                                        //CodeCR10 2 - rpm 4/ 12/10
  3128     dtpDODEn dDate.Date  := NOW;                                                          //CodeCR10 2 - rpm 4/ 12/10
  3129     dtpDODSt artDate.Mi nDate := E ncodeDate( 1988, 01,  01) {01/01 /1988};               //CodeCR10 2 - rpm 4/ 12/10, Cod eCR165 - r pm 2/24/11
  3130     dtpDODEn dDate.MinD ate := Enc odeDate(19 88, 01, 01 ) {01/01/1 988};                 //CodeCR10 2 - rpm 4/ 12/10, Cod eCR165 - r pm 2/24/11
  3131  
  3132     VistAHos t := '';                                                                     // This wi ll be used  for telne t, if the  user defin es a comma nd line ar gument.
  3133  
  3134     VersionU ser := Get VersionUse r;
  3135  
  3136     Applicat ion.OnExce ption := A pplication ExceptionH andler;                          //zzz rlm
  3137     Randomiz e;
  3138     TempDir  := GetTemp Dir;                                                              // Set/Fin d this mac hines temp orary dire ctory
  3139     RecordAu dit('Start ing CAPRI' , 'Audit') ;
  3140  
  3141     frmWindo wsProcesse s := TfrmW indowsProc esses.Crea te(frmMain );
  3142     If frmWi ndowsProce sses.proce ssListBox. Items.Coun t > 0 Then
  3143       frmWin dowsProces ses.ShowMo dal;
  3144     frmWindo wsProcesse s.Release;
  3145  
  3146     PNCSTime outValue : = 7200;
  3147  
  3148     UserHasN ewStyleRes trictedLis t := -1;
  3149  
  3150     frmBroke rHistoryBu ffer := Tf rmBrokerHi storyBuffe r.Create(f rmMain);
  3151     frm508Me ssages :=  Tfrm508Mes sages.Crea te(frmMain );
  3152     frmMacro Editor :=  TfrmMacroE ditor.Crea te(frmMain );
  3153  
  3154     loggermo deforCPEP  := false;
  3155  
  3156  
  3157     noprinti ng := fals e;
  3158     Try
  3159       formPr intConfirm  := tformP rintConfir m.Create(f rmMain);
  3160       formPr int := Tfo rmPrint.Cr eate(frmMa in);
  3161     Except
  3162       noprin ting := tr ue;
  3163     End;
  3164  
  3165     formNews  := TformN ews.Create (frmMain);
  3166     formNews .RichEditN ews.Lines. Clear;
  3167  
  3168     UserHome PrimaryMen u := '';
  3169     TelnetCa ptureFile  := '';
  3170     SwitchTo Site := '' ;
  3171  
  3172     //applic ation.OnEx ception:=M yTempExcep tionHandle r;
  3173     CCOWInit ialized :=  False;
  3174  
  3175     // Next  line force s CCOW off  for now.   Remove it  to activa te CCOW.
  3176     // CCOWM ode:=true;
  3177     // 1/20/ 2006, SPH
  3178  
  3179     essovers ion := fal se;
  3180     //essove rsion:=tru e;
  3181     //If ESS OVersion=T rue then b egin
  3182       //    RPCBroker1 .Server:=' forum. DNS     ';
  3183       //    RPCBroker1 .ListenerP ort:= PORT ;
  3184     //end;
  3185  
  3186     //If Ess oVersion=t rue then
  3187       //BitB tnVistA.Vi sible:=Tru e else Bit BtnVistA.V isible:=Fa lse;
  3188  
  3189     //If ESS OVersion=T rue then C COWMode:=F alse;
  3190  
  3191     AppStart ed := Fals e;
  3192     //TempDi r := GetTe mpDir; //  Set/Find t his machin es tempora ry directo ry
  3193     Applicat ion.OnMess age := App Message;
  3194     PNCSEven t := False ;
  3195  
  3196     //  temp FormObject List := TL ist.Create ;
  3197     //  temp MergeScrip ts := TLis t.Create;
  3198  
  3199     LabelICN .Caption : = '';
  3200     LabelDOB .Caption : = '';
  3201     TabCPWor ksheets.Ta bVisible : = False;
  3202     // rpm 1 2/10/09 -  disabling  C&P Worksh eets tab w hile not v isible cau ses a
  3203     // visib le DOD tab  to appear  ghosted ( disabled)  when it oc cupies the  same spac e.
  3204     // TabCP Worksheets .Enabled : = False;
  3205     actTools UnsignedWo rkSheets.V isible :=  False;
  3206     Cancella tionReason  := '';
  3207  
  3208     RPCBroke r1.ANUUser Specs := ' ';
  3209     ReadOnly Mode := Fa lse;
  3210     SurgeryR eports :=  TStringLis t.Create;
  3211  
  3212     uLocalRe portData : = TStringL ist.Create ;
  3213     uHSCompo nents := T StringList .Create;
  3214  
  3215     TempHSMe mo := TStr ingList.Cr eate;
  3216  
  3217     frmPrope rties := T frmPropert ies.Create (frmMain);
  3218     frmROFin der := Tfr mROFinder. Create(frm Main);
  3219  
  3220     //////// ////////// //////////  Section 5 08 Speech  Engine Che ck /////// ////////// //////////
  3221  
  3222     //Jaws u ses the Mi crosoft Sp eech API.
  3223  
  3224     //Lots o f info:
  3225     //http:/ /support.m icrosoft.c om/default .aspx?scid =kb;en-us; 306902
  3226  
  3227     //How to  know if M S Speech i s installe d:
  3228     //When y ou install  on of the  SAPI SDK  distributi ons you wi ll find sp chapi.exe  in the  "\ Program Fi les\Micros oft Speech  SDK\REDIS T\API" dir ectory.
  3229  
  3230     // Nice  explanatio n:
  3231     //http:/ /bdn.borla nd.com/art icle/0,141 0,29583,00 .html
  3232  
  3233     Try
  3234       Speech APIInstall ed := True ;
  3235     Except
  3236       Speech APIInstall ed := Fals e;
  3237     End;
  3238  
  3239     // Turn  off speech  in V105
  3240     SpeechAP IInstalled  := False;
  3241  
  3242     If Speec hAPIInstal led = True  Then
  3243     Begin
  3244       SPVoic e1.Connect ;
  3245       For x  := 1 To 10 0 Do
  3246       Begin
  3247         For  y := 1 To  1000 Do
  3248           ap plication. processmes sages;
  3249         slee p(1);
  3250       End;
  3251       //SPVo ice1.Speak ('<speak>T his is the  default v oice, whic h should a lso be the  <voice ge nder="male ">default  voice</voi ce></speak >',0 );
  3252       // Giv e speech t he time to  set up
  3253       frmPro perties.Co mboBoxVoic e.Items.Cl ear;
  3254       frmPro perties.Co mboBoxVoic e.ItemInde x := -1;
  3255  
  3256       frmPro perties.gr oupBoxSpee ch.enabled  := true;
  3257       // Enu merate voi ces
  3258       //Ensu re all eve nts fire
  3259       SPVoic e1.EventIn terests :=  SVEAllEve nts;
  3260       SOToke ns := SPVo ice1.GetVo ices('', ' ');
  3261       For x  := 0 To SO Tokens.Cou nt - 1 Do
  3262       Begin
  3263         //Fo r each voi ce, store  the descri ptor in th e TStrings  list
  3264         SOTo ken := SOT okens.Item (x);
  3265         frmP roperties. ComboBoxVo ice.Items. AddObject( SOToken.Ge tDescripti on(0), TOb ject(SOTok en));
  3266         //In crement de scriptor r eference c ount to en sure it's  not destro yed
  3267         SOTo ken._AddRe f;
  3268       End;
  3269  
  3270       frmPro perties.Co mboBoxVoic e.ItemInde x := 0;
  3271       frmPro perties.Co mboBoxVoic eChange(Ap plication) ;
  3272  
  3273     End
  3274     Else
  3275     Begin
  3276       frmPro perties.gr oupBoxSpee ch.enabled  := false;
  3277     End;
  3278  
  3279     //////// ////////// //// End o f Section  508 Speech  Engine Ch eck ////// ////////// ////////// /
  3280  
  3281     frmZipCo des := Tfr mZipCodes. Create(frm Main);
  3282     rStream  := TResour ceStream.C reate(hIns tance, 'Zi pcodes', R T_RCDATA);
  3283     Try
  3284       fStrea m := TMemo ryStream.C reate;
  3285       Try
  3286         fStr eam.CopyFr om(rStream , 0);
  3287         fStr eam.Positi on := 0;
  3288         frmZ ipCodes.Ri chEdit1.Li nes.LoadFr omStream(f Stream);
  3289         //fr mZipCodes. richedit1. lines.save tofile('c: \temp\temp .txt');
  3290       Finall y fStream. Free;
  3291       End;
  3292     Finally  rStream.Fr ee;
  3293     End;
  3294     //  frmZ ipCodes.Sh ow;
  3295  
  3296     If ESSOV ersion = t rue Then
  3297     Begin
  3298       // Don 't allow c hange veri fy code
  3299       //Chan geVerifyCo de1.Visibl e:=False;
  3300       Button RDV.Enable d := False ;
  3301       //Mail ManHome1.V isible:=Tr ue;
  3302     End;
  3303  
  3304     BrokerFi rstLogin : = True;
  3305  
  3306     NumberCl inDocsToRe trieve :=  100;
  3307     buttonCl inDocDateR ange.Capti on := '100  Documents ';
  3308  
  3309     RPCBroke r1.Server  := '';
  3310  
  3311     TimeOutV al := 0;
  3312     Applicat ion.OnMess age := App Message;
  3313  
  3314     DateTime Picker1.Da te := Now;
  3315     DateTime Picker2.Da te := Now;
  3316  
  3317     frmLabGr aph := Tfr mLabGraph. Create(frm Main);
  3318     //frmNHE :=TfrmNHE. Create(frm Main);
  3319    //formVit alsGraph:= TformVital sGraph.Cre ate(frmMai n);
  3320     ProgramN ameCaption  := frmMai n.Caption;
  3321     ReportMe mo.ReadOnl y := True;
  3322     HSMemo.R eadOnly :=  True;
  3323     MemoDocs .ReadOnly  := True;
  3324     MemoAppo intments.R eadOnly :=  True;
  3325  
  3326     Insuffic ientExam : = False;                                                          // Set fla g
  3327     {Store d irectory o f .exe for  reference  later}
  3328     Director yName := A pplication .ExeName;
  3329     IPRDirec tory := '' ;
  3330     If Pos(' \', Direct oryName) >  0 Then
  3331       Repeat
  3332         Begi n
  3333           IP RDirectory  := IPRDir ectory + C opy(Direct oryName, 1 , Pos('\',  Directory Name));
  3334           De lete(Direc toryName,  1, Pos('\' , Director yName));
  3335       End Un til Pos('\ ', Directo ryName) =  0;
  3336     listMedi calCenterD ivision :=  TStringLi st.Create;
  3337     listlabT estNames : = TStringL ist.Create ;
  3338     UserKeys  := TStrin gList.Crea te;
  3339     listDocs  := TStrin gList.Crea te;
  3340     listExam s := TStri ngList.Cre ate;
  3341     ListRest rictedPati ents := TS tringList. Create;
  3342  
  3343     //Center  on screen
  3344     frmMain. Left := (S creen.Widt h Div 2) -  (frmMain. Width Div  2);
  3345     frmMain. Top := (Sc reen.Heigh t Div 2) -  (frmmain. Height Div  2);
  3346  
  3347     // Set s ome defaul ts, just i n case the y're neede d
  3348     ipc_Term BufForeCol or := clBl ack;
  3349     ipc_Term BufBackCol or := clWh ite;
  3350  
  3351     //Load s ettings fr om previou s session
  3352     if FileE xists('c:\ capri.cfg' ) then beg in
  3353       // Cod eCR168 -ME R 04/2011   Previousl y, a memoB ox was use d to load  the config
  3354       // inf ormation.   This resu lted in pr oblems whe n the line  width was  greater
  3355       // tha n what the  control c ould conta in.  The m emoBox has  been repl aced with
  3356       // a s tringlist
  3357       lslCon fig := TSt ringList.C reate;
  3358       try
  3359         try
  3360           ls lConfig.Lo adFromFile ('c:\capri .cfg')
  3361         exce pt
  3362           //  eat the e xception
  3363         end;
  3364         If l slConfig.C ount > 27  Then
  3365         Begi n
  3366           If  lslConfig .Count > 1  Then
  3367           Be gin
  3368              //Put in c ode to del ete config  file if i t's not th e
  3369              //right le ngth.  Thi s means it 's old or  been modif ied
  3370              //Then exi t.
  3371              Try frmMai n.Top := S trToInt(ls lConfig[0] )Except En d;
  3372              Try frmMai n.Left :=  StrToInt(l slConfig[1 ])Except E nd;
  3373              Try frmMai n.Width :=  StrToInt( lslConfig[ 2])Except  End;
  3374              Try frmMai n.Height : = StrToInt (lslConfig [3])Except  End;
  3375              If lslConf ig[4] = 'W SMAXIMIZED ' Then
  3376                frmMain. WindowStat e := wsMax imized
  3377              Else
  3378                frmMain. WindowStat e := wsNor mal;
  3379              Try
  3380              lstDocs.Wi dth := Str ToInt(lslC onfig[5])E xcept
  3381              End;
  3382              If lstDocs .Width > f rmMain.Wid th - 100 T hen
  3383                lstDocs. Width := f rmMain.Wid th - 100;
  3384              Try
  3385              ORHealthSu mmaryUserL ist.Width  := StrToIn t(lslConfi g[6])Excep t
  3386              End;
  3387              If ORHealt hSummaryUs erList.Wid th > frmMa in.Width -  100 Then
  3388                ORHealth SummaryUse rList.Widt h := frmMa in.Width -  100;
  3389              Try
  3390              ORReportsA vailable.W idth := St rToInt(lsl Config[7]) Except
  3391              End;
  3392              If ORRepor tsAvailabl e.Width >  frmMain.Wi dth - 100  Then
  3393                ORReport sAvailable .Width :=  frmMain.Wi dth - 100;
  3394              FontDialog 1.Font.Nam e := lslCo nfig[8];
  3395              FontDialog 1.Font.Siz e := StrTo Int(lslCon fig[9]);
  3396              If lslConf ig[10] = ' TRUE' Then
  3397                FontDial og1.font.s tyle := Fo ntDialog1. font.style  + [fsbold ];
  3398              If lslConf ig[11] = ' TRUE' Then
  3399                FontDial og1.font.s tyle := Fo ntDialog1. font.style  + [fsItal ic];
  3400              If lslConf ig[12] = ' TRUE' Then
  3401                FontDial og1.font.s tyle := Fo ntDialog1. font.style  + [fsUnde rline];
  3402              If lslConf ig[13] = ' TRUE' Then
  3403                FontDial og1.font.s tyle := Fo ntDialog1. font.style  + [fsStri keout];
  3404              Try
  3405              frmPropert ies.Scroll BarKeyboar dSensitivi ty.Positio n := strto int(lslCon fig[14])Ex cept
  3406              End;
  3407              Try
  3408              RemoteSite Name := ls lConfig[15 ]Except
  3409              End;
  3410              x := 16;
  3411              //Address  Info
  3412              MemoNameAd dressHolde r.Lines.Cl ear;
  3413              Try
  3414                If ((lsl Config[x]  <> '^NONE^ ') And (ls lConfig[x]  <> '')) T hen
  3415                Begin
  3416                  Repeat
  3417                    Begi n
  3418                      Me moNameAddr essHolder. Lines.Add( Copy(lslCo nfig[x], 2 , length(l slConfig[x ]) - 1));
  3419                      in c(x);
  3420                  End Un til (x > l slConfig.c ount - 1)  Or (copy(l slConfig[x ], 1, 1) < > '~');
  3421                End
  3422                Else
  3423                  inc(x) ;
  3424              Except
  3425              End;
  3426              TelnetConf igX := x;
  3427              If TelnetC onfigX > 0  Then
  3428              Begin
  3429                Try
  3430                  ipc_Te rmBufForeC olor := He xToTColor( lslConfig[ x + 6]);
  3431                Except
  3432                  ipc_Te rmBufForeC olor := cl Black;
  3433                End;
  3434                Try
  3435                  ipc_Te rmBufBackC olor := He xToTColor( lslConfig[ x + 7]);
  3436                Except
  3437                  ipc_Te rmBufBackC olor := cl White;
  3438                End;
  3439                frmTelne t := TfrmT elnet.Crea te(frmMain );
  3440                Try
  3441                  frmTel net.Width  := strtoin t(lslConfi g[x]);
  3442                Except
  3443                End;
  3444                inc(x);
  3445                Try
  3446                  frmTel net.Height  := strtoi nt(lslConf ig[x]);
  3447                Except
  3448                End;
  3449                inc(x);
  3450                Try
  3451                  frmTel net.Left : = strtoint (lslConfig [x]);
  3452                Except
  3453                End;
  3454                inc(x);
  3455                Try
  3456                  frmTel net.Top :=  strtoint( lslConfig[ x]);
  3457                Except
  3458                End;
  3459                inc(x);
  3460                Try
  3461                  frmTel net.IPTerm inal1.Font .Size := s trtoint(ls lConfig[x] );
  3462                Except
  3463                End;
  3464                inc(x);
  3465                Try
  3466                  frmTel net.IPTerm inal1.Font .Name := l slConfig[x ];
  3467                Except
  3468                End;
  3469                inc(x);
  3470                inc(x);
  3471                inc(x);
  3472  
  3473                //showme ssage(intt ostr(frmTe lnet.IPTer minal1.Fon t.Size)+'  : '+frmTel net.IPTerm inal1.Font .Name);
  3474                telnetCo nfigX := - 1;
  3475              End
  3476              Else
  3477              Begin
  3478                // Telne t data not  there yet
  3479                frmTelne t := TfrmT elnet.Crea te(frmMain );
  3480                frmTelne t.Width :=  589;
  3481                frmTelne t.Height : = 509;
  3482                frmTelne t.IPTermin al1.Font.S ize := 11;
  3483                frmTelne t.IPTermin al1.Font.N ame := 'Te rminal';
  3484              End;
  3485  
  3486              // Speech  Settings
  3487              If frmProp erties.Com boboxVoice .Items.Cou nt > 0 The n
  3488                For y :=  0 To frmP roperties. ComboBoxVo ice.Items. Count - 1  Do
  3489                  If frm Properties .ComboboxV oice.Items [y] = lslC onfig[x] T hen
  3490                    frmP roperties. ComboboxVo ice.ItemIn dex := y;
  3491              inc(x);
  3492              Try
  3493              frmPropert ies.TrackB arSpeechRa te.Positio n := strto int(lslCon fig[x])Exc ept
  3494              End;
  3495              inc(x);
  3496              Try
  3497              frmPropert ies.TrackB arSpeechVo lume.Posit ion := str toint(lslC onfig[x])E xcept
  3498              End;
  3499              inc(x);
  3500              Try
  3501                If lslCo nfig[x] =  'TRUE' The n
  3502                  frmPro perties.Ch eckBoxActi vateSpeech Prompts.Ch ecked := T rue
  3503                Else
  3504                  frmPro perties.Ch eckBoxActi vateSpeech Prompts.Ch ecked := F alse;
  3505              Except
  3506              End;
  3507              If SpeechA PIInstalle d = True T hen
  3508                frmPrope rties.Comb oBoxVoiceC hange(Appl ication);
  3509              If SpeechA PIInstalle d = False  Then
  3510                frmPrope rties.Chec kBoxActiva teSpeechPr ompts.Chec ked := Fal se;
  3511              If frmProp erties.Che ckBoxActiv ateSpeechP rompts.Che cked Then
  3512              Begin
  3513                //frmMai n.SPVoice1 .Rate:=0;
  3514                //frmMai n.SPVoice1 .Volume:=1 00;
  3515                SPVoice1 .Speak('<s peak>check ing networ k connecti ons</speak >', 0);
  3516              End;
  3517              //frmPrope rties.Trac kBarSpeech RateChange (Applicati on);
  3518              //frmPrope rties.Trac kBarSpeech VolumeChan ge(Applica tion);
  3519  
  3520              SetFont;
  3521           En d;
  3522         End
  3523         Else
  3524         Begi n
  3525           //  No config  file foun d
  3526           fr mTelnet :=  TfrmTelne t.Create(f rmMain);
  3527           fr mTelnet.Wi dth := 589 ;
  3528           fr mTelnet.He ight := 50 9;
  3529           fr mTelnet.IP Terminal1. Font.Size  := 11;
  3530           fr mTelnet.IP Terminal1. Font.Name  := 'Termin al';
  3531         End;
  3532       finall y
  3533         lslC onfig.Free ;
  3534       end;
  3535     end else  begin
  3536       // No  config fil e found
  3537       frmTel net := Tfr mTelnet.Cr eate(frmMa in);
  3538       frmTel net.Width  := 589;
  3539       frmTel net.Height  := 509;
  3540       frmTel net.IPTerm inal1.Font .Size := 1 1;
  3541       frmTel net.IPTerm inal1.Font .Name := ' Terminal';
  3542     end;                                                                                  // if File Exists('c: \capri.cfg ') then be gin
  3543     // Make  sure not o ff the bou ndaries of  the scree n if resol ution chan ged
  3544     If frmma in.Left +  frmMain.Wi dth > scre en.width T hen
  3545       frmMai n.Left :=  Screen.Wid th - frmMa in.Width;
  3546     If frmMa in.Left <  0 Then
  3547       frmMai n.Left :=  0;
  3548     If frmMa in.Width >  Screen.Wi dth Then
  3549       frmMai n.Width :=  Screen.Wi dth;
  3550     If frmma in.Top + f rmMain.Hei ght > scre en.height  Then
  3551       frmMai n.Top := S creen.Heig ht - frmMa in.Height;
  3552     If frmMa in.Top < 0  Then
  3553       frmmai n.Top := 0 ;
  3554     If frmMa in.Height  > Screen.H eight Then
  3555       frmMai n.Height : = Screen.H eight;
  3556  
  3557     If ESSOV ersion = F alse Then
  3558     Begin
  3559       // Con textorCont rol is use d for CCOW .
  3560  
  3561       RPCBro ker1.Conte xtor := Ni l;
  3562       // Thi s needs to  be re-act ivated in  order for  CCOW to fu nction
  3563       // It' s beeing t aken out f rom V71 fo r now.
  3564  
  3565       If CCO WMode = Tr ue Then
  3566       Try
  3567         Begi n
  3568           Co ntextorCon trol := TC ontextorCo ntrol.Crea te(frmMain );
  3569           Co ntextorCon trol.OnPen ding := Co ntextorCon trolPendin g;
  3570           Co ntextorCon trol.OnCan celed := C ontextorCo ntrolCance led;
  3571           Co ntextorCon trol.OnCom mitted :=  ContextorC ontrolComm itted;
  3572           RP CBroker1.C ontextor : = Contexto rControl;
  3573       End Ex cept
  3574         Begi n
  3575           CC OWMode :=  False;
  3576              // Context or compone nt not ins talled
  3577         End
  3578       End;
  3579  
  3580       Try
  3581         If C ontextorCo ntrol <> N il Then
  3582         Begi n
  3583           Co ntextorCon trol.Run(A PP_NAME +  '#'                                         // The pou nd sign al lows multi ple instan ces to run  in CCOW m ode
  3584              , ''
  3585              , TRUE                                                                       // VARIANT _TRUE == - 1 in COM
  3586              , '*');
  3587  
  3588           (*
  3589                Contexto rControl.R un( 'Broke rLoginModu le' + '#'
  3590                                , ' kqdQ8siyn1 _XwshtOYUJ U6orRQVV_P WhKWK9TVbR GG3AnVlKoS HPTRbS-KP3 MLAYq5wcmk KIDZUaLWEL N0uiAbseTl qwK0ARhZEP qoJzyn9r31 9qvp_kWP1_ dGE'+
  3591                                  ' IQmnoB4pKs VrVqCMEXMN ZdQ0KCp5Qe X7nHqg1oQw xHRlH1MpMw nUBFTqAZgs _wfDwDgitY 3sDyAM3fKn QtXQBSUaH2 a5ZfFajnJx CERavwh3aW OgsHoKwyTm DSssHupUjn Py7'
  3592                                , T RUE  // VA RIANT_TRUE  == -1 in  COM
  3593                                , ' *');
  3594           *)
  3595  
  3596           If  Contextor Control.St ate = 2 Th en
  3597              CCOWMode : = True
  3598           El se
  3599           Be gin
  3600              CCOWMode : = False;
  3601              Showmessag eCAPRI('CC OW mode co uldn''t be  activated .  The app lication w ill run, b ut CCOW fu nctionalit y will be  unavailabl e.');
  3602              RPCBroker1 .Contextor  := Nil;
  3603           En d;
  3604         End;
  3605       Except
  3606         CCOW Mode := Fa lse;
  3607       End;                                                                                // Some pr oblem with  CCOW vaul t
  3608     End;
  3609  
  3610     If CCOWM ode = True  Then
  3611     Begin
  3612       bitbtn CCOWLink.B ringToFron t;
  3613       bitbtn CCOWLink.V isible :=  True;
  3614       BitBtn CCOWLinkBr oken.Visib le := Fals e;
  3615       BitBtn CCOWLinkCh anging.Vis ible := fa lse;
  3616     End
  3617     Else
  3618     Begin
  3619       bitbtn CCOWLink.V isible :=  false;
  3620       bitbtn CCOWLinkBr oken.Visib le := fals e;
  3621       bitbtn CCOWLinkCh anging.Vis ible := fa lse;
  3622     End;
  3623  
  3624     // Check  news
  3625     TimerNew sTimer(RPC Broker1);                                                         // Need so me control  here to f orce pop u p at start up but not  other tim es.
  3626  
  3627     actFileC onnect.Exe cute;
  3628  
  3629     If EssoV ersion = F alse Then
  3630       Button OtherSites .Visible : = False;
  3631     frmMain. Show;
  3632     frmMain. Repaint;
  3633  
  3634     actFileS electPatie nt.Execute ;
  3635  
  3636   //  FPatie ntInfoBuck et := nil;
  3637     if Assig ned(FPatie ntInfoBuck et) then                                               // rpk 2/1 2/2015
  3638       FreeAn dNil(FPati entInfoBuc ket);                                                  // rpk 2/1 2/2015
  3639   End;                                                                                    // FormCre ate
  3640  
  3641   { procedur e TfrmMain .FormMouse Wheel(Send er: TObjec t; Shift:  TShiftStat e;           // CodeC R700 rpk 3 /5/2015
  3642     WheelDel ta: Intege r; MousePo s: TPoint;  var Handl ed: Boolea n);
  3643   var
  3644     tbool: B oolean;
  3645     wc: TWin Control;
  3646   begin
  3647     if Page9 5Control1. ActivePage  = TabCPWo rksheets t hen begin
  3648       wc :=  ListBoxIPR 1;
  3649       if wc  <> nil the n begin
  3650         tboo l := Scrol lBox(wc, M ousePos, W heelDelta) ;
  3651         Hand led := tbo ol;
  3652       end;
  3653     end;
  3654                                                                                    end; } // FormMou seWheel
  3655  
  3656   // use in  appointmen ts lists;  btnAllClic k, btnPast Click, btn FutureClic k
  3657  
  3658   { function  SortAppoi ntmentsByD ate(List:  TStringLis t; Index1,  Index2: I nteger): I nteger; //  CodeCR708  rpk 5/19/ 2015
  3659   var
  3660     iret: In teger;
  3661     DT1, DT2 : TDateTim e;
  3662     dtstr1,  dtstr2: St ring;
  3663  
  3664     function  GetDateAp pt(inStr:  String): S tring;
  3665     var
  3666       str1:  String;
  3667       pos1:  Integer;
  3668     begin
  3669       Result  := '';
  3670       pos1 : = Pos('     ', inStr) ;
  3671       if pos 1 > 0 then  begin
  3672         str1  := Copy(i nstr, 34,  17);
  3673         Resu lt := str1 ;
  3674       end;
  3675     end;                                                                                  // GetDate Appt
  3676  
  3677     // NOTE:  ShortMont hNames are  initializ ed in Pati ent unit
  3678     function  CvtMonStr ToMonth(in Monthstr:  String): I nteger;
  3679     var
  3680       i: Int eger;
  3681     begin
  3682       Result  := 0;
  3683       for I  := 1 to 12  do
  3684         if S ameText(in Monthstr,  ShortMonth Names[i])  then begin
  3685           Re sult := i;
  3686           br eak;
  3687         end;
  3688     end;                                                                                  // CvtMonS trToMonth
  3689  
  3690     function  CvtFMExtD ateToDateT ime(instr:  String):  TDateTime;
  3691     var
  3692       yearst r, monthst r, datestr , hourstr,  minutestr : String;
  3693       iyear,  imonth, i day, ihour , iminute:  Integer;
  3694       atpos:  Integer;
  3695       avalue : TDateTim e;
  3696       bres:  Boolean;
  3697  
  3698     begin                                                                                 // CvtFMEx tDateToDat eTime
  3699       // DEC  15,2000@0 8:00 or DE C 1,2000@0 8:00
  3700       Result  := 0;
  3701       iyear  := 0;
  3702       imonth  := 0;
  3703       iday : = 0;
  3704       ihour  := 0;
  3705       iminut e := 0;
  3706  
  3707       atpos  := Pos('@' , instr);
  3708       if atp os > 0 the n begin
  3709         mont hstr := Co py(instr,  1, 3);
  3710         date str := Cop y(instr, a tpos - 7,  2);
  3711         year str := Cop y(instr, a tpos - 4,  4);
  3712         hour str := Cop y(instr, a tpos + 1,  2);
  3713         minu testr := C opy(instr,  atpos + 4 , 2);
  3714         iyea r := StrTo IntDef(yea rstr, 0);
  3715         imon th := CvtM onStrToMon th(monthst r);
  3716         iday  := StrToI ntDef(date str, 0);
  3717         ihou r := StrTo IntDef(hou rstr, 0);
  3718         imin ute := Str ToIntDef(m inutestr,  0);
  3719  
  3720         bres  := TryEnc odeDateTim e(iyear, i month, ida y, ihour,  iminute, 0 , 0, avalu e);
  3721         if b res then
  3722           Re sult := av alue;
  3723       end;
  3724     end;                                                                                  // CvtFMEx tDateToDat eTime
  3725  
  3726   begin                                                                                   // SortApp ointmentsB yDate
  3727     Result : = 0;
  3728     DT1 := 0 ;
  3729     DT2 := 0 ;
  3730  
  3731     dtstr1 : = GetDateA ppt(List[I ndex1]);
  3732     dtstr2 : = GetDateA ppt(List[I ndex2]);
  3733  
  3734     DT1 := C vtFMExtDat eToDateTim e(dtstr1);
  3735     DT2 := C vtFMExtDat eToDateTim e(dtstr2);
  3736  
  3737     iret :=  CompareDat eTime(DT1,  DT2);
  3738  
  3739   //  if Rev erseAdminS ortOrder t hen                                                      // CodeC R708 rpk 8 /27/2015
  3740     // rever se the sor t order; m ake it new est to old est
  3741       iret : = -iret;
  3742  
  3743     Result : = iret;
  3744                                                                                    end;   }// SortAp pointments ByDate
  3745  
  3746   Procedure  TfrmMain.b tnPastClic k(Sender:  TObject);
  3747   //var
  3748   //  strLis t: TString List;
  3749   Begin
  3750     If ANURe moteProced ureCallInP rogress =  True Then
  3751       exit;
  3752  
  3753     AnimateL ogo(True);
  3754     StatusBa rLoadPt.Ca ption := ' Downloadin g past app ointments. ';
  3755     StatusBa rLoadPt.Re paint;
  3756     Applicat ion.Proces smessages;
  3757  
  3758     lblApptS tatus.Capt ion := 'Pa st Appoint ments';
  3759     frmMain. RPCBroker1 .Results.C lear;
  3760     RPCBroke r1.RemoteP rocedure : = 'DVBAB A PPOINTMENT  LIST';
  3761     RPCBroke r1.Param[0 ].Value :=  PatientIE N;
  3762     RPCBroke r1.Param[0 ].PType :=  literal;
  3763     RPCBroke r1.Param[1 ].Value :=  'P';                                                  //A=All ap pt. F=Futu re appt. P =Past appt .
  3764     RPCBroke r1.Param[1 ].PType :=  literal;
  3765     RPCBroke rCall;
  3766     Try
  3767       RPCBro ker1.Call;
  3768     Except
  3769       On EBr okerError  Do
  3770       Begin
  3771         ANUR emoteProce dureCallIn Progress : = False;
  3772         Anim ateLogo(Fa lse);
  3773         Stat usBarLoadP t.Caption  := 'RPC DV BAB APPOIN TMENT LIST  could not  be access ed!';
  3774         Stat usBarLoadP t.Repaint;
  3775         Appl ication.Pr ocessmessa ges;
  3776         Show MessageCAP RI('DVBAB  APPOINTMEN T LIST cou ld not be  accessed!' );
  3777       End;
  3778     End;
  3779     //Begin  Build Repo rt
  3780     ANURemot eProcedure CallInProg ress := tr ue;
  3781     MemoAppo intments.L ines.Clear ;
  3782     screen.c ursor := c rHourglass ;
  3783  
  3784     MemoAppo intments.S etSelTextB uf(RPCBrok er1.Result s.GetText) ;
  3785     { strLis t := TStri ngList.Cre ate;                                                     // CodeC R708 rpk 5 /19/2015
  3786     try                                                                                   // CodeCR7 08 rpk 5/1 9/2015
  3787       strLis t.Assign(R PCBroker1. Results);                                              // CodeCR7 08 rpk 5/1 9/2015
  3788       strLis t.CustomSo rt(@SortAp pointments ByDate);                                    // CodeCR7 08 rpk 5/1 9/2015
  3789       MemoAp pointments .Lines.Ass ign(strLis t);                                         // CodeCR7 08 rpk 5/1 9/2015
  3790     finally                                                                               // CodeCR7 08 rpk 5/1 9/2015
  3791       strLis t.Free;                                                                      // CodeCR7 08 rpk 5/1 9/2015
  3792     end; }//  CodeCR708  rpk 5/19/ 2015
  3793  
  3794     screen.c ursor := c rDefault;
  3795     MemoAppo intments.V isible :=  True;
  3796     MemoAppo intments.S elStart :=  0;
  3797     MemoAppo intments.S elLength : = 0;
  3798     Try
  3799     MemoAppo intments.S etFocus Ex cept
  3800     End;
  3801     ANURemot eProcedure CallinProg ress := Fa lse;
  3802     AnimateL ogo(False) ;
  3803     StatusBa rLoadPt.Ca ption := ' Ready.';
  3804     StatusBa rLoadPt.Re paint;
  3805     Invalida te;                                                                          // CodeCR7 08 rpk 7/1 0/2015
  3806     Applicat ion.Proces smessages;
  3807     //End Of  Build Rep ort
  3808  
  3809   End;                                                                                    // btnPast Click
  3810  
  3811  
  3812   Procedure  TfrmMain.E xamRequest RefreshCli ck(Sender:  TObject);
  3813   Var
  3814     x: integ er;
  3815     date1, d ate2, date 3: String;
  3816     strList:  TStringLi st;
  3817  
  3818     function  GetDateRe q(inStr: S tring): St ring;
  3819     var
  3820       str1:  String;
  3821       pos1,  pos2, ilen : Integer;
  3822     begin
  3823       Result  := '';
  3824       pos1 : = Pos('  ' , inStr);
  3825       if pos 1 > 0 then  begin
  3826         pos2  := PosEx( '  ', inSt r, pos1 +  4);
  3827         if p os2 > 0 th en begin
  3828           il en := pos2  - pos1 -  4;
  3829           st r1 := Copy (instr, po s1 + 4, il en);
  3830           Re sult := st r1;
  3831         end;
  3832       end;
  3833     end;                                                                                  // GetDate Req
  3834  
  3835     function  SortExamR equestByDa te(List: T StringList ; Index1,  Index2: In teger): In teger; //  CodeCR708  rpk 5/19/2 015
  3836     var
  3837       iret:  Integer;
  3838       FMDT1,  FMDT2: TF MDateTime;
  3839       DT1, D T2: TDateT ime;
  3840       dtstr1 , dtstr2:  String;
  3841  
  3842  
  3843     begin
  3844       Result  := 0;
  3845       DT1 :=  0;
  3846       DT2 :=  0;
  3847  
  3848       dtstr1  := GetDat eReq(List[ Index1]);
  3849       dtstr2  := GetDat eReq(List[ Index2]);
  3850  
  3851       FMDT1  := CAPRISu pport.Make FMDateTime (dtstr1);
  3852       FMDT2  := CAPRISu pport.Make FMDateTime (dtstr2);
  3853  
  3854       if FMD T1 > -1 th en
  3855         DT1  := CAPRISu pport.FMDa teTimetoDa teTime(FMD T1);
  3856       if FMD T2 > -1 th en
  3857         DT2  := CAPRISu pport.FMDa teTimetoDa teTime(FMD T2);
  3858  
  3859       iret : = CompareD ateTime(DT 1, DT2);
  3860       if Rev erseExamRe questSortO rder then                                              // CodeCR7 08 rpk 8/2 7/2015
  3861         // r everse the  sort orde r; make it  newest to  oldest
  3862         iret  := -iret;
  3863  
  3864       Result  := iret;
  3865     end;                                                                                  // SortExa mRequestBy Date
  3866  
  3867   Begin                                                                                   // ExamReq uestRefres hClick
  3868     FMExamRe questListB ox.Items.B eginUpdate ;                                           // CodeCR7 08 rpk 7/1 0/2015
  3869     strList  := TString List.Creat e;                                                     // CodeCR7 08 rpk 5/1 9/2015
  3870     try                                                                                   // CodeCR7 08 rpk 5/1 9/2015
  3871       // Get  C&P Exam  Dates
  3872       FMExam RequestLis ter1.PartL ist.Clear;
  3873       FMExam RequestLis ter1.PartL ist.Add(Pa tientIEN);
  3874   //  FMExam RequestLis tbox.GetLi st;
  3875       FMExam RequestLis ter1.GetLi st(strList );                                          // CodeCR7 08 rpk 5/1 9/2015
  3876       if FME xamRequest Lister1.Er rorList.Co unt > 0 th en                               // CodeCR7 08 rpk 5/1 9/2015
  3877         FMEx amRequestL ister1.Dis playErrors ;                                           // CodeCR7 08 rpk 5/1 9/2015
  3878  
  3879       strLis t.CustomSo rt(@SortEx amRequestB yDate);                                     // CodeCR7 08 rpk 5/1 9/2015
  3880       FMExam RequestLis tbox.Items .Assign(st rList);                                     // CodeCR7 08 rpk 5/1 9/2015
  3881       FMExam RequestLis tbox.ItemI ndex := 0;                                             // CodeCR7 08 rpk 6/1 1/2015
  3882       if FME xamRequest Listbox.Ca nFocus the n                                           // CodeCR7 08 rpk 7/7 /2015
  3883         FMEx amRequestL istbox.Set Focus;                                                 // CodeCR7 08 rpk 7/7 /2015
  3884     finally                                                                               // CodeCR7 08 rpk 5/1 9/2015
  3885       strLis t.Free;                                                                      // CodeCR7 08 rpk 5/1 9/2015
  3886     end;                                                                                  // CodeCR7 08 rpk 5/1 9/2015
  3887     // Make  sure data  is correct  for Patie ntIEN
  3888     If FMExa mRequestLi stbox.Item s.Count >  0 Then
  3889       For x  := FMExamR equestList box.Items. Count - 1  Downto 0 D o
  3890       Begin
  3891         If P os(Patient IEN + '  ' , FMExamRe questListb ox.Items[x ]) <> 1 Th en
  3892           FM ExamReques tListbox.I tems.Delet e(x);
  3893       End;
  3894     // Refor mat data
  3895     If FMExa mRequestLi stbox.Item s.Count >  0 Then
  3896       For x  := 0 To FM ExamReques tListbox.I tems.Count  - 1 Do
  3897       Begin
  3898         FMEx amRequestL istbox.Ite ms[x] := C opy(FMExam RequestLis tbox.Items [x], Pos('   ', FMExa mRequestLi stbox.Item s[x]) + 4,  255); //  Strip pati ent IEN;
  3899         Date 1 := Copy( FMExamRequ estListbox .Items[x],  1, Pos('   ', FMExam RequestLis tbox.Items [x]) - 1);
  3900         FMEx amRequestL istbox.Ite ms[x] := C opy(FMExam RequestLis tbox.Items [x], Pos('   ', FMExa mRequestLi stbox.Item s[x]) + 4,  500);
  3901         Date 2 := Copy( FMExamRequ estListbox .Items[x],  1, Pos('   ', FMExam RequestLis tbox.Items [x]) - 1);
  3902         FMEx amRequestL istbox.Ite ms[x] := C opy(FMExam RequestLis tbox.Items [x], Pos('   ', FMExa mRequestLi stbox.Item s[x]) + 4,  500);
  3903         Date 3 := Copy( FMExamRequ estListbox .Items[x],  1, 254);
  3904         If D ate2 <> ''  Then
  3905           FM ExamReques tListbox.I tems[x] :=  Copy(FMDa teTimeConv ert(Date1)  + '                      ', 1,  20) + '  |   ' + FMDa teTimeConv ert(Date2)
  3906         Else
  3907           If  Date3 <>  '' Then
  3908              FMExamRequ estListbox .Items[x]  := Copy(FM DateTimeCo nvert(Date 1) + '                      ', 1 , 20) + '   |  ' + FM DateTimeCo nvert(Date 3) + ' [EX AM CANCELE D]'
  3909           El se
  3910              FMExamRequ estListbox .Items[x]  := Copy(FM DateTimeCo nvert(Date 1) + '                      ', 1 , 20) + '   |  ';
  3911         //Fi x single d igit date  and move o ver
  3912         If C opy(FMExam RequestLis tbox.Items [x], 6, 1)  = ',' The n
  3913           FM ExamReques tListbox.I tems[x] :=  Copy(FMEx amRequestL istbox.Ite ms[x], 1,  4) + ' ' +  Copy(FMEx amRequestL istbox.Ite ms[x], 5,  15) + Copy (FMExamReq uestListbo x.Items[x] , 21, 99);
  3914       End;
  3915     FMExamRe questListB ox.Items.E ndUpdate;                                              // CodeCR7 08 rpk 7/1 0/2015
  3916     Invalida te;                                                                          // CodeCR7 08 rpk 7/1 0/2015
  3917   End;                                                                                    // ExamReq uestRefres hClick
  3918  
  3919   Procedure  TfrmMain.b tnRefreshA ddressClic k(Sender:  TObject);
  3920   Var
  3921     x: integ er;
  3922   Begin
  3923     AnimateL ogo(True);
  3924     StatusBa rLoadPt.Ca ption := ' Refreshing  Address.' ;
  3925     StatusBa rLoadPt.Re paint;
  3926     Applicat ion.Proces smessages;
  3927  
  3928     FMEditZi p.Visible  := True;
  3929  
  3930     FMStates List.Visib le := Fals e;
  3931     ButtonSt ateAccept. Visible :=  False;
  3932  
  3933     FMGetsPt Address.IE NS := Pati entIEN;
  3934     FMGetsPt Address.Ge tAndFill;
  3935  
  3936     //rpm 9/ 28/09 - Co rrected ca rryover fr om previou s patient  address
  3937     if FMEdi tCounty.Te xt = '' th en
  3938       County Fake.Text  := '';
  3939     if FMEdi tState.Tex t = '' the n
  3940       StateF ake.Text : = '';
  3941     //rpm 9/ 17/09 - Fo reign Addr ess: Repla ce Country  and TempC ountry .01  value wit h Postal N ame
  3942     FMEditCo untry.Text  := GetCou ntryName(F MEditCount ry.FMDBInt ernal);
  3943     FMEditTe mpCountry. Text := Ge tCountryNa me(FMEditT empCountry .FMDBInter nal);
  3944  
  3945     FMEditSt reet1.Colo r := clSil ver;
  3946     FMEditSt reet2.Colo r := clSil ver;
  3947     FMEditSt reet3.Colo r := clSil ver;
  3948     FMEditCi ty.Color : = clSilver ;
  3949     FMEditSt ate.Color  := clSilve r;
  3950     FMEditZi p.Color :=  clSilver;
  3951     CountyFa ke.Color : = clSilver ;
  3952     FMEditPh one.Color  := clSilve r;
  3953     FMEditOf fice.Color  := clSilv er;
  3954     FMEditCo untry.Colo r := clSil ver;                                                   //Country
  3955     FMEditPr ovince.Col or := clSi lver;                                                  //Province
  3956     FMEditPo stalCode.C olor := cl Silver;                                                //Postal C ode
  3957     FMEditLa stUpdate.C olor := cl Silver;                                                //Last Upd ate
  3958     FMEditUp dateSite.C olor := cl Silver;                                                //Update S ite
  3959  
  3960     FMEditSt reet1.enab led := Tru e;
  3961     FMEditSt reet2.enab led := Tru e;
  3962     FMEditSt reet3.enab led := Tru e;
  3963     FMEditCi ty.enabled  := True;
  3964     FMEditSt ate.enable d := True;
  3965     FMEditZi p.enabled  := True;
  3966     CountyFa ke.enabled  := True;
  3967     StateFak e.enabled  := True;
  3968     FMEditPh one.enable d := True;
  3969     FMEditOf fice.enabl ed := True ;
  3970     FMEditCo untry.Enab led := Tru e;                                                     //Country
  3971     FMEditPr ovince.Ena bled := Tr ue;                                                    //Province
  3972     FMEditPo stalCode.E nabled :=  True;                                                  //Postal C ode
  3973     FMEditLa stUpdate.E nabled :=  True;                                                  //Last Upd ate
  3974     FMEditUp dateSite.E nabled :=  True;                                                  //Update S ite
  3975  
  3976     FMEditSt reet1.Read Only := Tr ue;
  3977     FMEditSt reet2.Read Only := Tr ue;
  3978     FMEditSt reet3.Read Only := Tr ue;
  3979     FMEditCi ty.ReadOnl y := True;
  3980     FMEditSt ate.ReadOn ly := True ;
  3981     FMEditZi p.ReadOnly  := True;
  3982     CountyFa ke.ReadOnl y := True;
  3983     StateFak e.ReadOnly  := True;
  3984     FMEditPh one.ReadOn ly := True ;
  3985     FMEditOf fice.ReadO nly := Tru e;
  3986     FMEditCo untry.Read Only := Tr ue;                                                    //Country
  3987     FMEditPr ovince.Rea dOnly := T rue;                                                   //Province
  3988     FMEditPo stalCode.R eadOnly :=  True;                                                 //Postal C ode
  3989     FMEditLa stUpdate.R eadOnly :=  True;                                                 //Last Upd ate
  3990     FMEditUp dateSite.R eadOnly :=  True;                                                 //Update S ite
  3991  
  3992     lblZip.V isible :=  True;
  3993     lblCount y.Visible  := True;
  3994     FMEditZi p.Visible  := True;
  3995     CountyFa ke.Visible  := True;
  3996     CountyFa ke.BringTo Front;
  3997  
  3998     StateFak e.SendToBa ck;
  3999  
  4000     btnSaveA ddress.Ena bled := Fa lse;
  4001     // btnEd itAddress. Enabled:=T rue;  // D isabled to  turn off  address ed iting
  4002     If ReadO nlyMode =  true Then
  4003       btnEdi tAddress.E nabled :=  False;
  4004  
  4005     fmLister States.Get List(FMSta tesList.It ems);
  4006     If FMEdi tState.Tex t <> '' Th en
  4007     Begin
  4008       For x  := 0 To FM StatesList .Items.Cou nt - 1 Do                                   // Find Se lected Sta te
  4009         If F MStatesLis t.Items[x]  = FMEditS tate.Text  Then
  4010           FM StatesList .ItemIndex  := x;
  4011       //Now  find selec ted county
  4012       County Fake.Text  := '';
  4013       If FMS tatesList. ItemIndex  > -1 Then
  4014       Begin
  4015         FMLi sterCounti es.IENS :=  ',' + FMS tatesList. GetSelecte dRecord.IE N;
  4016         fmLi sterCounti es.GetList (FMCountie sList.Item s);
  4017         If F MEditCount y.Text <>  '' Then
  4018         Begi n
  4019           Fo r x := 0 T o FMCounti esList.Ite ms.Count -  1 Do
  4020           Be gin
  4021              If Copy(FM CountiesLi st.Items[x ], Pos('   ', FMCount iesList.It ems[x]) +  4, 128) =  FMEditCoun ty.Text Th en
  4022              Begin
  4023                FMCounti esList.Ite mIndex :=  x;
  4024                CountyFa ke.Text :=  FMCountie sList.Item s[x];
  4025                AnimateL ogo(False) ;
  4026                StatusBa rLoadPt.Ca ption := ' Ready.';
  4027                StatusBa rLoadPt.Re paint;
  4028                Applicat ion.Proces smessages;
  4029                Exit;
  4030              End;
  4031           En d;
  4032         End;
  4033       End;
  4034     End;
  4035     StateFak eChange(Ap plication) ;
  4036     AnimateL ogo(False) ;
  4037     StatusBa rLoadPt.Ca ption := ' Ready.';
  4038     StatusBa rLoadPt.Re paint;
  4039     Applicat ion.Proces smessages;
  4040   End;
  4041  
  4042   Procedure  TfrmMain.b tnRefreshP tDemograph icsClick(S ender: TOb ject);
  4043   Begin
  4044     If ANURe moteProced ureCallInP rogress =  True Then
  4045       exit;
  4046  
  4047     StatusBa rLoadPt.Ca ption := ' Downloadin g Demograp hics.';
  4048     StatusBa rLoadPt.Re paint;
  4049     Applicat ion.Proces smessages;
  4050     AnimateL ogo(True);
  4051  
  4052     frmMain. RPCBroker1 .Results.C lear;
  4053     RPCBroke r1.RemoteP rocedure : = 'DVBAB P TINQ';
  4054     RPCBroke r1.Param[0 ].Value :=  PatientIE N;
  4055     RPCBroke r1.Param[0 ].PType :=  literal;
  4056     RPCBroke rCall;
  4057     Try
  4058       RPCBro ker1.Call;
  4059     Except
  4060       On EBr okerError  Do
  4061       Begin
  4062         ANUR emoteProce dureCallIn Progress : = False;
  4063         Anim ateLogo(Fa lse);
  4064         Stat usBarLoadP t.Caption  := 'RPC DV BAB PTINQ  could not  be accesse d!';
  4065         Stat usBarLoadP t.Repaint;
  4066         Appl ication.Pr ocessmessa ges;
  4067         Show MessageCAP RI('RPC DV BAB PTINQ  could not  be accesse d!');
  4068       End
  4069     End;
  4070     ReportMe mo.Lines.C lear;
  4071     screen.c ursor := c rHourglass ;
  4072  
  4073     //Build  Report
  4074     ANURemot eProcedure CallInProg ress := tr ue;
  4075     ReportMe mo.SetSelT extBuf(RPC Broker1.Re sults.GetT ext);
  4076     screen.c ursor := c rDefault;
  4077     ReportMe mo.Visible  := True;
  4078     ReportMe mo.SelStar t := 1;
  4079     ReportMe mo.SelLeng th := 1;
  4080  
  4081     If IsSet FocusValid (ReportMem o) then
  4082       Report Memo.SetFo cus;
  4083  
  4084     ReportMe mo.SelStar t := 0;
  4085     ReportMe mo.SelLeng th := 0;
  4086  
  4087     If IsSet FocusValid (ReportMem o) then
  4088       Report Memo.SetFo cus;
  4089  
  4090     ANURemot eProcedure CallinProg ress := Fa lse;
  4091     AnimateL ogo(False) ;
  4092     StatusBa rLoadPt.Ca ption := ' Ready.';
  4093     StatusBa rLoadPt.Re paint;
  4094     Applicat ion.Proces smessages;
  4095     //End Of  Build Rep ort
  4096  
  4097   End;
  4098  
  4099   Procedure  TfrmMain.b tnSaveAddr essClick(S ender: TOb ject);
  4100   Var
  4101     Save_Cur sor: TCurs or;
  4102     x: integ er;
  4103   Begin
  4104     If (Stat eFake.Text  <> 'CANAD A') And (S tateFake.T ext <> 'PH ILIPPINES' ) And
  4105       (State Fake.Text  <> 'QUEBEC ') And
  4106       (Upper case(Trim( StateFake. Text)) <>  'NEWFOUNDL AND') And  (Uppercase (Trim(Stat eFake.text )) <> 'LAB RADOR') An d (Upperca se(Trim(St ateFake.te xt)) <> 'N OVA SCOTIA ') And
  4107       (Upper case(Trim( StateFake. Text)) <>  'PRINCE ED WARD ISLAN D') And (U ppercase(T rim(StateF ake.text))  <> 'NEW B RUNSWICK')  And (Uppe rcase(Trim (StateFake .text)) <>  'ONTARIO' ) And
  4108       (Upper case(Trim( StateFake. Text)) <>  'MANITOBA' ) And (Upp ercase(Tri m(StateFak e.text)) < > 'SASKATC HEWAN') An d (Upperca se(Trim(St ateFake.te xt)) <> 'A LBERTA') A nd
  4109       (Upper case(Trim( StateFake. text)) <>  'BRITISH C OLUMBIA')  And (Upper case(Trim( StateFake. text)) <>  'YUKON TER RITORY') A nd (Upperc ase(Trim(S tateFake.t ext)) <> ' NORTHWEST  TERRITORIE S') And
  4110       (Upper case(Trim( StateFake. text)) <>  'NUNAVUT')  Then
  4111       If (Le ngth(FMEdi tZip.Text)  <> 4) And  ((Length( FMEditZip. Text) < 5)  And (Leng th(FMEditZ ip.Text) <  9)) Then
  4112       Begin
  4113         Show messageCAP RI('Zip co de appears  to be inc orrectly e ntered.');
  4114         exit ;
  4115       End;
  4116     //
  4117  
  4118     If (Stat eFake.Text  <> 'CANAD A') And (S tateFake.T ext <> 'PH ILIPPINES' ) And
  4119       (State Fake.Text  <> 'QUEBEC ') And
  4120       (Upper case(Trim( StateFake. Text)) <>  'NEWFOUNDL AND') And  (Uppercase (Trim(Stat eFake.text )) <> 'LAB RADOR') An d (Upperca se(Trim(St ateFake.te xt)) <> 'N OVA SCOTIA ') And
  4121       (Upper case(Trim( StateFake. Text)) <>  'PRINCE ED WARD ISLAN D') And (U ppercase(T rim(StateF ake.text))  <> 'NEW B RUNSWICK')  And (Uppe rcase(Trim (StateFake .text)) <>  'ONTARIO' ) And
  4122       (Upper case(Trim( StateFake. Text)) <>  'MANITOBA' ) And (Upp ercase(Tri m(StateFak e.text)) < > 'SASKATC HEWAN') An d (Upperca se(Trim(St ateFake.te xt)) <> 'A LBERTA') A nd
  4123       (Upper case(Trim( StateFake. text)) <>  'BRITISH C OLUMBIA')  And (Upper case(Trim( StateFake. text)) <>  'YUKON TER RITORY') A nd (Upperc ase(Trim(S tateFake.t ext)) <> ' NORTHWEST  TERRITORIE S') And
  4124       (Upper case(Trim( StateFake. text)) <>  'NUNAVUT')  Then
  4125       If FME ditZip.Tex t = '' The n
  4126       Begin
  4127         Show messageCAP RI('You mu st enter a  zipcode.' );
  4128         exit ;
  4129       End;
  4130     If (Stat eFake.Text  <> 'CANAD A') And (S tateFake.T ext <> 'PH ILIPPINES' ) And
  4131       (State Fake.Text  <> 'QUEBEC ') And
  4132       (Upper case(Trim( StateFake. Text)) <>  'NEWFOUNDL AND') And  (Uppercase (Trim(Stat eFake.text )) <> 'LAB RADOR') An d (Upperca se(Trim(St ateFake.te xt)) <> 'N OVA SCOTIA ') And
  4133       (Upper case(Trim( StateFake. Text)) <>  'PRINCE ED WARD ISLAN D') And (U ppercase(T rim(StateF ake.text))  <> 'NEW B RUNSWICK')  And (Uppe rcase(Trim (StateFake .text)) <>  'ONTARIO' ) And
  4134       (Upper case(Trim( StateFake. Text)) <>  'MANITOBA' ) And (Upp ercase(Tri m(StateFak e.text)) < > 'SASKATC HEWAN') An d (Upperca se(Trim(St ateFake.te xt)) <> 'A LBERTA') A nd
  4135       (Upper case(Trim( StateFake. text)) <>  'BRITISH C OLUMBIA')  And (Upper case(Trim( StateFake. text)) <>  'YUKON TER RITORY') A nd (Upperc ase(Trim(S tateFake.t ext)) <> ' NORTHWEST  TERRITORIE S') And
  4136       (Upper case(Trim( StateFake. text)) <>  'NUNAVUT')  Then
  4137       If Cou ntyFake.Te xt = '' Th en
  4138       Begin
  4139         Show MessageCAP RI('You mu st enter a  county.') ;
  4140         exit ;
  4141       End;
  4142     //
  4143     If (FMEd itStreet1. Text <> '' ) And (Len gth(FMEdit Street1.Te xt) < 3) T hen
  4144     Begin
  4145       ShowMe ssageCAPRI ('Street A ddress Lin e 1 is too  short.');
  4146       exit;
  4147     End;
  4148     If (FMEd itStreet2. Text <> '' ) And (Len gth(FMEdit Street2.Te xt) < 3) T hen
  4149     Begin
  4150       ShowMe ssageCAPRI ('Street A ddress Lin e 2 is too  short.');
  4151       exit;
  4152     End;
  4153     If (FMEd itStreet3. Text <> '' ) And (Len gth(FMEdit Street3.Te xt) < 3) T hen
  4154     Begin
  4155       ShowMe ssageCAPRI ('Street A ddress Lin e 2 is too  short.');
  4156       exit;
  4157     End;
  4158     If (FMEd itCity.Tex t <> '') A nd (Length (FMEditCit y.Text) <  2) Then
  4159     Begin
  4160       ShowMe ssageCAPRI ('City is  too short. ');
  4161       exit;
  4162     End;
  4163     If Appli cation.Mes sageBox('A re you sur e you want  to update  the addre ss in Vist A?', 'Upda te Address ', 4) = 6  Then
  4164     Begin
  4165       TimeSi nceLastBro kerCall :=  0;                                                    // Prevent  event
  4166       If ANU RemoteProc edureCallI nProgress  = True The n
  4167         Repe at applica tion.proce ssmessages  Until ANU RemoteProc edureCallI nProgress  = False;
  4168       Save_C ursor := S creen.Curs or;
  4169       Screen .Cursor :=  crHourgla ss;                                                    { Show hou rglass cur sor }
  4170       If FME ditStreet1 .FMModifie d Then
  4171         If F MEditStree t1.Validat e Then
  4172         Begi n
  4173           fm filer2.Add ChgdContro l(FMEditSt reet1);
  4174           FM EditStreet 1.Text :=  FMEditStre et1.FMCtrl External;
  4175         End
  4176         Else
  4177         Begi n
  4178           FM Validator1 .DisplayEr rors;
  4179           FM EditStreet 1.Text :=  FMEditStre et1.FMTag;
  4180         End;
  4181       If FME ditStreet2 .FMModifie d Then
  4182         If F MEditStree t2.Validat e Then
  4183         Begi n
  4184           fm filer2.Add ChgdContro l(FMEditSt reet2);
  4185           FM EditStreet 2.Text :=  FMEditStre et2.FMCtrl External;
  4186         End
  4187         Else
  4188         Begi n
  4189           FM Validator1 .DisplayEr rors;
  4190           FM EditStreet 2.Text :=  FMEditStre et2.FMTag;
  4191         End;
  4192       If FME ditStreet3 .FMModifie d Then
  4193         If F MEditStree t3.Validat e Then
  4194         Begi n
  4195           fm filer2.Add ChgdContro l(FMEditSt reet3);
  4196           FM EditStreet 3.Text :=  FMEditStre et3.FMCtrl External;
  4197         End
  4198         Else
  4199         Begi n
  4200           FM Validator1 .DisplayEr rors;
  4201           FM EditStreet 3.Text :=  FMEditStre et3.FMTag;
  4202         End;
  4203       If FME ditCity.FM Modified T hen
  4204         If F MEditCity. Validate T hen
  4205         Begi n
  4206           fm filer2.Add ChgdContro l(FMEditCi ty);
  4207           FM EditCity.T ext := FME ditCity.FM CtrlExtern al;
  4208         End
  4209         Else
  4210         Begi n
  4211           FM Validator1 .DisplayEr rors;
  4212           FM EditCity.T ext := FME ditCity.FM Tag;
  4213         End;
  4214       If FME ditState.F MModified  Then
  4215         If F MEditState .Validate  Then
  4216         Begi n
  4217           fm filer2.Add ChgdContro l(FMEditSt ate);
  4218           FM EditState. Text := FM EditState. FMCtrlExte rnal;
  4219         End
  4220         Else
  4221         Begi n
  4222           FM Validator1 .DisplayEr rors;
  4223           FM EditState. Text := FM EditState. FMTag;
  4224         End;
  4225       If FME ditZip.FMM odified Th en
  4226         If F MEditZip.V alidate Th en
  4227         Begi n
  4228           fm filer2.Add ChgdContro l(FMEditZi p);
  4229           FM EditZip.Te xt := FMEd itZip.FMCt rlExternal ;
  4230         End
  4231         Else
  4232         Begi n
  4233           FM Validator1 .DisplayEr rors;
  4234           FM EditZip.Te xt := FMEd itZip.FMTa g;
  4235         End;
  4236       If FME ditPhone.F MModified  Then
  4237         If F MEditPhone .Validate  Then
  4238         Begi n
  4239           fm filer2.Add ChgdContro l(FMEditPh one);
  4240           FM EditPhone. Text := FM EditPhone. FMCtrlExte rnal;
  4241         End
  4242         Else
  4243         Begi n
  4244           FM Validator1 .DisplayEr rors;
  4245           FM EditPhone. Text := FM EditPhone. FMTag;
  4246         End;
  4247       If FME ditOffice. FMModified  Then
  4248         If F MEditOffic e.Validate  Then
  4249         Begi n
  4250           fm filer2.Add ChgdContro l(FMEditOf fice);
  4251           FM EditOffice .Text := F MEditOffic e.FMCtrlEx ternal;
  4252         End
  4253         Else
  4254         Begi n
  4255           FM Validator1 .DisplayEr rors;
  4256           FM EditOffice .Text := F MEditOffic e.FMTag;
  4257         End;
  4258       For x  := 0 To 10  Do
  4259       Begin
  4260       End;                                                                                // Not sur e why, but  it bombs  if I don't  have a li ne of code  here.
  4261       //Show MessageCAP RI('ok');
  4262       If fmf iler2.Anyt hingToFile  Then
  4263         If f mfiler2.Da taProblemC heck Then
  4264           fm filer2.Pro cessDataPr oblemList
  4265         Else
  4266         Begi n
  4267           If  fmfiler2. Update The n
  4268           Be gin
  4269              // Only up date count y if there  is a chan ge and the  IEN
  4270              // is in t he box.
  4271              If FMEditC ounty.Text  <> '' The n
  4272                If Copy( FMEditCoun ty.Text, 1 , 1) = '`'  Then
  4273                Begin
  4274                  If FME ditCounty. FMModified  Then
  4275                    If F MEditCount y.Validate  Then
  4276                    Begi n
  4277                      fm filer2.Add ChgdContro l(FMEditCo unty);
  4278                      FM EditCounty .Text := F MEditCount y.FMCtrlEx ternal;
  4279                    End
  4280                    Else
  4281                    Begi n
  4282                      FM Validator1 .DisplayEr rors;
  4283                      FM EditCounty .Text := F MEditCount y.FMTag;
  4284                    End;
  4285                  If fmf iler2.Anyt hingToFile  Then
  4286                    If f mfiler2.Da taProblemC heck Then
  4287                      fm filer2.Pro cessDataPr oblemList
  4288                    Else
  4289                      // if
  4290                      fm filer2.Upd ate
  4291                      // then begin  end;
  4292                End;
  4293              btnRefresh PtDemograp hicsClick( Applicatio n);
  4294              btnRefresh AddressCli ck(Applica tion);
  4295              //FMGetsPt Address.Ge tAndFill;
  4296           En d;
  4297         End
  4298       Else
  4299         Show MessageCAP RI('No cha nges to fi le!');
  4300       Screen .Cursor :=  Save_Curs or;                                                    { Always r estore to  normal }
  4301     End;
  4302   End;
  4303  
  4304   { procedur e TfrmMain .btnSortAd mincmtClic k(Sender:  TObject);                             // Co deCR708 rp k 8/27/201 5
  4305   begin
  4306     ReverseA dminSortOr der := not  ReverseAd minSortOrd er;
  4307     if Rever seAdminSor tOrder the n
  4308       btnSor tAdmin.Cap tion := 'S ort Newest  on top v'
  4309     else
  4310       btnSor tAdmin.Cap tion := 'S ort Oldest  on top ^' ;
  4311     btnSortA dmin.Inval idate;
  4312   end; }
  4313  
  4314   Procedure  TfrmMain.b tnEditAddr essClick(S ender: TOb ject);
  4315   Begin
  4316     If ANURe moteProced ureCallInP rogress =  True Then
  4317       exit;
  4318  
  4319     frmMain. RPCBroker1 .Results.C lear;
  4320     RPCBroke r1.RemoteP rocedure : = 'DVBAB C HECK CREDE NTIALS';
  4321     RPCBroke rCall;
  4322     Try
  4323       RPCBro ker1.Call;
  4324     Except
  4325       On EBr okerError  Do
  4326       Begin
  4327         ANUR emoteProce dureCallIn Progress : = False;
  4328         Anim ateLogo(Fa lse);
  4329         Stat usBarLoadP t.Caption  := 'RPC DV BAB CHECK  CREDENTIAL S could no t be acces sed!';
  4330         Stat usBarLoadP t.Repaint;
  4331         Appl ication.Pr ocessmessa ges;
  4332         Show MessageCAP RI('RPC DV BAB CHECK  CREDENTIAL S could no t be acces sed!');
  4333       End;
  4334     End;
  4335     If RPCBr oker1.Resu lts[0] <>  '[OK]' The n
  4336     Begin
  4337       ShowMe ssageCAPRI (RPCBroker 1.Results[ 0]);
  4338       applic ation.term inate;
  4339       Exit;
  4340     End;
  4341     // If cr edentials  are ok, th en continu e
  4342     Contexto rChangeMes sage := 'Y ou are edi ting an ad dress. If  you contin ue, your c hanges may  be lost.' ;
  4343     CCOWBrea kLink := T rue;
  4344  
  4345     btnEditA ddress.Ena bled := Fa lse;
  4346     btnSaveA ddress.Ena bled := Tr ue;
  4347  
  4348     StateFak e.Text :=  FMEditStat e.Text;
  4349  
  4350     btnSaveA ddress.Ena bled := Tr ue;
  4351  
  4352     FMEditSt reet1.Colo r := clYel low;
  4353     FMEditSt reet2.Colo r := clYel low;
  4354     FMEditSt reet3.Colo r := clYel low;
  4355     FMEditCi ty.Color : = clYellow ;
  4356     FMEditSt ate.Color  := clYello w;
  4357     FMEditZi p.Color :=  clYellow;
  4358     CountyFa ke.Color : = clYellow ;
  4359     FMEditPh one.Color  := clYello w;
  4360     FMEditOf fice.Color  := clYell ow;
  4361  
  4362     FMEditSt reet1.enab led := Tru e;
  4363     FMEditSt reet2.enab led := Tru e;
  4364     FMEditSt reet3.enab led := Tru e;
  4365     FMEditCi ty.enabled  := True;
  4366     FMEditSt ate.enable d := True;
  4367     FMEditZi p.enabled  := True;
  4368     CountyFa ke.enabled  := True;
  4369     StateFak e.Enabled  := True;
  4370     FMEditPh one.enable d := True;
  4371     FMEditOf fice.enabl ed := True ;
  4372  
  4373     StateFak e.BringToF ront;
  4374     btnEditA ddress.Ena bled := Fa lse;
  4375  
  4376     If (Stat eFake.Text  = 'CANADA ') Or (Sta teFake.Tex t = 'PHILI PPINES') O r
  4377       (State Fake.Text  = 'QUEBEC' ) Or
  4378       (Upper case(Trim( StateFake. Text)) = ' NEWFOUNDLA ND') Or (U ppercase(T rim(StateF ake.text))  = 'LABRAD OR') Or (U ppercase(T rim(StateF ake.text))  = 'NOVA S COTIA') Or
  4379       (Upper case(Trim( StateFake. Text)) = ' PRINCE EDW ARD ISLAND ') Or (Upp ercase(Tri m(StateFak e.text)) =  'NEW BRUN SWICK') Or  (Uppercas e(Trim(Sta teFake.tex t)) = 'ONT ARIO') Or
  4380       (Upper case(Trim( StateFake. Text)) = ' MANITOBA')  Or (Upper case(Trim( StateFake. text)) = ' SASKATCHEW AN') Or (U ppercase(T rim(StateF ake.text))  = 'ALBERT A') Or
  4381       (Upper case(Trim( StateFake. text)) = ' BRITISH CO LUMBIA') O r (Upperca se(Trim(St ateFake.te xt)) = 'YU KON TERRIT ORY') Or ( Uppercase( Trim(State Fake.text) ) = 'NORTH WEST TERRI TORIES') O r
  4382       (Upper case(Trim( StateFake. text)) = ' NUNAVUT')  Then
  4383     Begin
  4384       FMEdit Zip.Text : = '@';
  4385       FMEdit Zip.Visibl e := False ;
  4386     End
  4387     Else
  4388     Begin
  4389       FMEdit Zip.Visibl e := True;
  4390       If FME ditZip.Tex t = '@' Th en
  4391         FMEd itZip.Text  := '';
  4392     End;
  4393   End;
  4394  
  4395   Procedure  TfrmMain.F MStatesLis tExit(Send er: TObjec t);
  4396   Begin
  4397     //FMStat esList.Vis ible:=Fals e;
  4398     //Button StateAccep t.Visible: =False;
  4399   End;
  4400  
  4401   Procedure  TfrmMain.S tateFakeEn ter(Sender : TObject) ;
  4402   Begin
  4403  
  4404     exit;
  4405  
  4406     FMStates List.Bring ToFront;
  4407     ButtonSt ateAccept. BringToFro nt;
  4408     FMStates List.Visib le := True ;
  4409     ButtonSt ateAccept. Visible :=  True;
  4410     Try
  4411     FMStates List.SetFo cus Except
  4412     End;
  4413     If FMSta tesList.It emIndex >  -1 Then
  4414     Begin
  4415       TempIE N := FMSta tesList.Ge tSelectedR ecord.IEN;
  4416     End
  4417     Else
  4418       TempIE N := '';
  4419   End;
  4420  
  4421   Procedure  TfrmMain.F MCountiesL istExit(Se nder: TObj ect);
  4422   Begin
  4423     //FMCoun tiesList.V isible:=Fa lse;
  4424     //Button CountyAcce pt.Visible :=False;
  4425   End;
  4426  
  4427   Procedure  TfrmMain.C ountyFakeE nter(Sende r: TObject );
  4428   Begin
  4429  
  4430     exit;
  4431  
  4432     FMCounti esList.Bri ngToFront;
  4433     ButtonCo untyAccept .BringToFr ont;
  4434     FMCounti esList.Vis ible := Tr ue;
  4435     ButtonCo untyAccept .Visible : = True;
  4436     Try
  4437     FMCounti esList.Set Focus Exce pt
  4438     End;
  4439   End;
  4440  
  4441   Procedure  TfrmMain.F MEditCityE xit(Sender : TObject) ;
  4442   Begin
  4443     FMEditCi ty.Text :=  Uppercase (FMEditCit y.Text);
  4444   End;
  4445  
  4446   Procedure  TfrmMain.b tnLoadHSNa mesClick(S ender: TOb ject);
  4447   Var
  4448     x: integ er;
  4449     deletefl ag: intege r;
  4450   Begin
  4451     If ANURe moteProced ureCallInP rogress =  True Then
  4452       exit;
  4453  
  4454     HSMemo.L ines.Clear ;
  4455     frmMain. RPCBroker1 .Results.C lear;
  4456  
  4457     {Get HEA LTH SUMMAR Y TYPES us ing ORWRP  REPORT LIS TS CPRS Br oker Call}
  4458     RPCBroke r1.RemoteP rocedure : = 'ORWRP R EPORT LIST S';
  4459     Try
  4460     RPCBroke r1.Call Ex cept On EB rokerError  Do
  4461       Try
  4462       RPCBro ker1.Call  Except On  EBrokerErr or Do
  4463         Try
  4464         RPCB roker1.Cal l Except O n EBrokerE rror Do
  4465           Be gin
  4466              ANURemoteP rocedureCa llInProgre ss := Fals e;
  4467              frmMain.Sh ow;
  4468              Applicatio n.BringToF ront;
  4469              ShowMessag eCAPRI('RP C Broker c onnection  error!');
  4470           En d;
  4471         End;
  4472       End;
  4473     End;
  4474  
  4475     Repeat
  4476       RPCBro ker1.Resul ts.Delete( 0);
  4477     Until RP CBroker1.R esults[0]  = '[HEALTH  SUMMARY T YPES]';
  4478     RPCBroke r1.Results .Delete(0) ;
  4479     DeleteFl ag := -1;
  4480     If RPCBr oker1.Resu lts.Count  > 0 Then
  4481     Begin
  4482       For x  := 0 To RP CBroker1.R esults.Cou nt - 1 Do
  4483       Begin
  4484         If ( RPCBroker1 .Results[x ] = '$$END ') And (De leteFlag =  -1) Then
  4485           De leteFlag : = x;
  4486       End;
  4487       For x  := RPCBrok er1.Result s.Count -  1 Downto D eleteFlag  Do
  4488         RPCB roker1.Res ults.Delet e(x);
  4489  
  4490       ORHeal thSummaryU serList.It ems.Clear;
  4491       lbHeal thSummaryL ist.Items. Clear;
  4492       If RPC Broker1.Re sults.Coun t > 0 Then
  4493         For  x := 0 To  RPCBroker1 .Results.C ount - 1 D o
  4494         Begi n
  4495           If  Pos('ADHO C REPORT',  UpperCase (Piece(RPC Broker1.Re sults[x],  '^', 2)))  <> 1 Then
  4496              If Pos('RE MOTE', Upp erCase(Pie ce(RPCBrok er1.Result s[x], '^',  2))) <> 1  Then
  4497              Begin
  4498                lbHealth SummaryLis t.Items.Ad d(Copy(Pie ce(RPCBrok er1.Result s[x], '^',  1), 2, 99 )); // Str ip off the  first cha racter of  "h"
  4499                ORHealth SummaryUse rList.Item s.Add(Piec e(RPCBroke r1.Results [x], '^',  2));
  4500                //ShowMe ssageCAPRI (RPCBroker 1.Results[ x]+'  '+(C opy(Piece( RPCBroker1 .Results[x ],'^',1),2 ,99))+'  ' +(Piece(RP CBroker1.R esults[x], '^',2)));
  4501              End;
  4502         End;
  4503     End;
  4504  
  4505   End;
  4506  
  4507   Procedure  TfrmMain.O RHealthSum maryUserLi stClick(Se nder: TObj ect);
  4508   Var
  4509     Z: Strin g;
  4510     x, y: in teger;
  4511  
  4512   Begin
  4513     If ANURe moteProced ureCallInP rogress =  True Then
  4514       exit;
  4515     ComboBox HSSections .Text := ' ';
  4516     ComboBox HSSections .Repaint;
  4517     AnimateL ogo(True);
  4518     StatusBa rLoadPt.Ca ption := ' Generating  Health Su mmary.';
  4519     StatusBa rLoadPt.Re paint;
  4520     Applicat ion.Proces smessages;
  4521     Tab95Con trol2.TabI ndex := 0;
  4522     TimerRem oteData.En abled := F alse;
  4523     ListBoxR emoteDataP ending.Ite ms.Clear;
  4524     //Clear  off previo us transac tion messa ges just i n case
  4525     //some h ave alread y been don e.  Grab f irst 5 pie ces
  4526     //piece  6 is the t ransaction  message
  4527     //piece  7 is the d one messag e
  4528     If ListB oxRemoteDa ta.Items.C ount > 0 T hen
  4529       For y  := 0 To li stboxremot edata.item s.count -  1 Do
  4530       Begin
  4531         List BoxRemoteD ata.Items[ y] := Piec e(ListBoxR emoteData. Items[y],  '^', 1) +  '^' +
  4532           Pi ece(ListBo xRemoteDat a.Items[y] , '^', 2)  + '^' +
  4533           Pi ece(ListBo xRemoteDat a.Items[y] , '^', 3)  + '^' +
  4534           Pi ece(ListBo xRemoteDat a.Items[y] , '^', 4)  + '^' +
  4535           Pi ece(ListBo xRemoteDat a.Items[y] , '^', 5);
  4536       End;
  4537     // Get M PI ID
  4538    // RPCBro ker1.Remot eProcedure  := 'ORWPT  SELECT';
  4539    // RPCBro ker1.Param [1].Value  := Patient IEN;
  4540    // RPCBro ker1.Param [1].PType  := literal ;
  4541    // RPCBro kerCall; t ry RPCBrok er1.Call;
  4542    //   exce pt
  4543    // On EBr okerError  do
  4544    //   Show MessageCAP RI('RPC OR WPT SELECT  PATIENT c ould not b e accessed !');
  4545    // end;
  4546    // Remote DataPtID:= Piece(RPCB roker1.Res ults[0],'^ ',14);
  4547    //RemoteD ataPtID:=' ';
  4548     Z := lbH ealthSumma ryList.Ite ms[ORHealt hSummaryUs erList.Ite mIndex];
  4549  
  4550     // Remot e Sites Se lected
  4551     If Tab95 Control2.T abs.Count  > 1 Then
  4552       For x  := 1 To Ta b95Control 2.Tabs.Cou nt - 1 Do
  4553         For  y := 0 To  listboxrem otedata.it ems.count  - 1 Do
  4554           If  Tab95Cont rol2.Tabs[ x] = Piece (ListBoxRe moteData.I tems[y], ' ^', 2) The n
  4555              If Piece(L istBoxRemo teData.Ite ms[y], '^' , 6) = ''  Then
  4556              Begin
  4557                // Found  match not  retrieved  yet.  Que ry remote  site
  4558                Applicat ion.Proces sMessages;
  4559                RPCBroke r1.RemoteP rocedure : = 'XWB REM OTE RPC';
  4560                RPCBroke r1.Param[1 ].Value :=  Piece(Lis tBoxRemote Data.Items [y], '^',  1); // Sit e Location
  4561                RPCBroke r1.Param[1 ].PType :=  literal;
  4562                RPCBroke r1.Param[2 ].Value :=  'ORWRP RE PORT TEXT' ;                     // RPC to  Call
  4563                RPCBroke r1.Param[2 ].PType :=  literal;
  4564                RPCBroke r1.Param[3 ].Value :=  '0';
  4565                RPCBroke r1.Param[3 ].PType :=  literal;
  4566                RPCBroke r1.Param[4 ].Value :=  PatientIE N + ';' +  RemoteData PtID;
  4567                RPCBroke r1.Param[4 ].PType :=  literal;
  4568                RPCBroke r1.Param[5 ].Value :=  '1;1';
  4569                RPCBroke r1.Param[5 ].PType :=  literal;
  4570                RPCBroke r1.Param[6 ].Value :=  Z + ';' +  ORHealthS ummaryUser List.Items [ORHealthS ummaryUser List.ItemI ndex]; //  HS IEN
  4571                RPCBroke r1.Param[6 ].PType :=  literal;
  4572                RPCBroke r1.Param[7 ].Value :=  '';
  4573                RPCBroke r1.Param[7 ].PType :=  literal;
  4574                RPCBroke r1.Param[8 ].Value :=  '';
  4575                RPCBroke r1.Param[8 ].PType :=  literal;
  4576                RPCBroke r1.Param[9 ].Value :=  '0';                                       // Start D ate
  4577                RPCBroke r1.Param[9 ].PType :=  literal;
  4578                RPCBroke r1.Param[1 0].Value : = '0';                                      // End Dat e
  4579                RPCBroke r1.Param[1 0].PType : = literal;
  4580                //ShowMe ssageCAPRI (RPCBroker 1.Param[1] .Value+CR+ RPCBroker1 .Param[2]. Value+CR+R PCBroker1. Param[3].V alue+CR+RP CBroker1.P aram[4].Va lue+CR+RPC Broker1.Pa ram[5].Val ue+CR
  4581                //+RPCBr oker1.Para m[6].Value +CR+RPCBro ker1.Param [7].Value+ CR+RPCBrok er1.Param[ 8].Value+C R+RPCBroke r1.Param[9 ].Value+CR +RPCBroker 1.Param[10 ].Value+CR );
  4582                RPCBroke rCall;
  4583                Try
  4584                  RPCBro ker1.Call;
  4585                Except
  4586                  On EBr okerError  Do
  4587                  Begin
  4588                    ANUR emoteProce dureCallIn Progress : = False;
  4589                    Anim ateLogo(Fa lse);
  4590                    Stat usBarLoadP t.Caption  := 'RPC XW B REMOTE R PC could n ot be acce ssed!';
  4591                    Stat usBarLoadP t.Repaint;
  4592                    Appl ication.Pr ocessmessa ges;
  4593                    Show MessageCAP RI('RPC XW B REMOTE R PC could n ot be acce ssed!');
  4594                    ANUR emoteProce dureCallIn Progress : = False;
  4595                    exit ;
  4596                  End;
  4597                End;
  4598                If RPCBr oker1.Resu lts[0] <>  '' Then
  4599                Begin
  4600                  ListBo xRemoteDat aPending.I tems.Add(R PCBroker1. Results[0] );
  4601                End
  4602                Else
  4603                Begin
  4604                  ListBo xRemoteDat a.Items[y]  := ListBo xRemoteDat a.Items[y]  + '^*';
  4605                  ListBo xRemoteDat aPending.I tems.Add(' *');                             // * = Com munication  Problems
  4606                  //Show messageCAP RI('There  was a comm unication  problem re questing t his report  from '+Pi ece(ListBo xRemoteDat a.Items[y] ,'^',2)+'.   Data wil l not be r eturned fo r this sit e.');
  4607                End;
  4608                //Showme ssageCAPRI (RPCBroker 1.Results[ 0]);
  4609                // Keep  track of m essage id
  4610                ListBoxR emoteData. Items[y] : = ListBoxR emoteData. Items[y] +  '^' + RPC Broker1.Re sults[0];
  4611              End;
  4612  
  4613     // Get H S from loc al site
  4614     HSMemoLo cal.Lines. Clear;
  4615     frmMain. RPCBroker1 .Results.C lear;
  4616     RPCBroke r1.RemoteP rocedure : = 'ORWRP R EPORT TEXT ';
  4617     RPCBroke r1.Param[1 ].Value :=  PatientIE N;
  4618     RPCBroke r1.Param[1 ].PType :=  literal;
  4619     RPCBroke r1.Param[2 ].Value :=  '1';                                                  // HS Repo rt Type
  4620     RPCBroke r1.Param[2 ].PType :=  literal;
  4621     RPCBroke r1.Param[3 ].Value :=  Z + ';' +  ORHealthS ummaryUser List.Items [ORHealthS ummaryUser List.ItemI ndex]; //  HS IEN
  4622     RPCBroke r1.Param[3 ].PType :=  literal;
  4623     RPCBroke r1.Param[4 ].Value :=  '';
  4624     RPCBroke r1.Param[4 ].PType :=  literal;
  4625     RPCBroke r1.Param[5 ].Value :=  '';
  4626     RPCBroke r1.Param[5 ].PType :=  literal;
  4627     RPCBroke r1.Param[6 ].Value :=  '0';                                                  // Begin D ate
  4628     RPCBroke r1.Param[6 ].PType :=  literal;
  4629     RPCBroke r1.Param[7 ].Value :=  '0';                                                  // End Dat e
  4630     RPCBroke r1.Param[7 ].PType :=  literal;
  4631  
  4632     RPCBroke rCall;
  4633     Try
  4634       RPCBro ker1.Call;
  4635     Except
  4636       On EBr okerError  Do
  4637       Begin
  4638         ANUR emoteProce dureCallIn Progress : = False;
  4639         Anim ateLogo(Fa lse);
  4640         Stat usBarLoadP t.Caption  := 'RPC OR WRP REPORT  TEXT coul d not be a ccessed!';
  4641         Stat usBarLoadP t.Repaint;
  4642         Appl ication.Pr ocessmessa ges;
  4643         Show MessageCAP RI('RPC OR WRP REPORT  TEXT coul d not be a ccessed!') ;
  4644         ANUR emoteProce dureCallIn Progress : = false;
  4645         exit ;
  4646       End;
  4647     End;
  4648  
  4649     ANURemot eProcedure CallInProg ress := tr ue;
  4650     HSMemoLo cal.Lines. Clear;
  4651     ComboBox HSSections .Items.Cle ar;
  4652     screen.c ursor := c rHourglass ;
  4653  
  4654     HSMemoLo cal.SetSel TextBuf(RP CBroker1.R esults.Get Text);
  4655  
  4656     screen.c ursor := c rDefault;
  4657     HSMemoLo cal.BringT oFront;
  4658     HSMemoLo cal.Visibl e := True;
  4659     HSMemoLo cal.SelSta rt := 0;
  4660     HSMemoLo cal.SelLen gth := 0;
  4661     Try
  4662     HSMemoLo cal.SetFoc us Except
  4663     End;
  4664  
  4665     If ListB oxRemoteDa taPending. Items.Coun t > 0 Then
  4666       TimerR emoteData. Enabled :=  True;
  4667     Tab95Con trol2Chang e(Applicat ion);
  4668     ANURemot eProcedure CallinProg ress := Fa lse;
  4669     AnimateL ogo(False) ;
  4670     StatusBa rLoadPt.Ca ption := ' Ready.';
  4671     StatusBa rLoadPt.Re paint;
  4672     Applicat ion.Proces smessages;
  4673   End;
  4674  
  4675   Procedure  TfrmMain.b tnAddExamC lick(Sende r: TObject );
  4676   Begin
  4677     If ANURe moteProced ureCallInP rogress =  True Then
  4678       exit;
  4679  
  4680     frmMain. RPCBroker1 .Results.C lear;
  4681     RPCBroke r1.RemoteP rocedure : = 'DVBAB C HECK CREDE NTIALS';
  4682     RPCBroke rCall;
  4683     Try
  4684       RPCBro ker1.Call;
  4685     Except
  4686       On EBr okerError  Do
  4687       Begin
  4688         ANUR emoteProce dureCallIn Progress : = False;
  4689         Anim ateLogo(Fa lse);
  4690         Stat usBarLoadP t.Caption  := 'RPC DV BAB CHECK  CREDENTIAL S could no t be acces sed!';
  4691         Stat usBarLoadP t.Repaint;
  4692         Appl ication.Pr ocessmessa ges;
  4693         Show MessageCAP RI('RPC DV BAB CHECK  CREDENTIAL S could no t be acces sed!');
  4694       End;
  4695     End;
  4696     If RPCBr oker1.Resu lts[0] <>  '[OK]' The n
  4697     Begin
  4698       ShowMe ssageCAPRI (RPCBroker 1.Results[ 0]);
  4699       applic ation.term inate;
  4700       Exit;
  4701     End;
  4702     // If cr edentials  are ok, th en continu e
  4703  
  4704   End;
  4705  
  4706   Procedure  TfrmMain.b tnAddReque stClick(Se nder: TObj ect);
  4707   Var
  4708     x, y: in teger;
  4709     MyTreeNo de: Array[ 0..50000]  Of TTreeNo de;
  4710     NodeCoun t: LongInt ;
  4711     temptext z: String;
  4712   Begin
  4713     If frmRO Finder.ORL istBoxSite s.Items.Co unt = 0 Th en
  4714       LoadIn stitutions ;
  4715  
  4716     frmAddre ss := Tfrm Address.Cr eate(frmMa in);
  4717     frmAddre ss.CountyF ake.Text : = '';
  4718     frmAddre ss.Top :=  7 + frmMai n.Top + (( frmMain.He ight - frm Address.He ight) Div  2);
  4719     frmAddre ss.Left :=  frmMain.L eft + ((fr mMain.Widt h - frmAdd ress.Width ) Div 2);
  4720     frmAddre ss.FMGetsP tAddress.I ENS := Pat ientIEN;
  4721     frmAddre ss.FMGetsP tAddress.G etAndFill;
  4722     frmAddre ss.Populat eCountry;
  4723     If frmAd dress.FMEd itCounty.T ext <> ''  Then
  4724     Begin
  4725       For x  := 0 To FM CountiesLi st.Items.C ount - 1 D o
  4726       Begin
  4727         If C opy(FMCoun tiesList.I tems[x], P os('  ', F MCountiesL ist.Items[ x]) + 4, 1 28) = frmA ddress.FME ditCounty. Text Then
  4728         Begi n
  4729           FM CountiesLi st.ItemInd ex := x;
  4730           fr mAddress.C ountyFake. Text := FM CountiesLi st.Items[x ];
  4731         End;
  4732       End;
  4733     End;
  4734  
  4735     fmLister States.Get List(frmAd dress.FMSt atesList.I tems);
  4736     If FMEdi tState.Tex t <> '' Th en
  4737     Begin
  4738       For x  := 0 To fr mAddress.F MStatesLis t.Items.Co unt - 1 Do                       // Find Se lected Sta te
  4739         If f rmAddress. FMStatesLi st.Items[x ] = FMEdit State.Text  Then
  4740           fr mAddress.F MStatesLis t.ItemInde x := x;
  4741       //Now  find selec ted county
  4742       FMList erCounties .IENS := ' ,' + frmAd dress.FMSt atesList.G etSelected Record.IEN ;
  4743       fmList erCounties .GetList(f rmAddress. FMCounties List.Items );
  4744       If FME ditCounty. Text <> ''  Then
  4745       Begin
  4746         For  x := 0 To  frmAddress .FMCountie sList.Item s.Count -  1 Do
  4747         Begi n
  4748           If  Copy(frmA ddress.FMC ountiesLis t.Items[x] , Pos('  ' , frmAddre ss.FMCount iesList.It ems[x]) +  4, 128) =  FMEditCoun ty.Text Th en
  4749           Be gin
  4750              frmAddress .FMCountie sList.Item Index := x ;
  4751              CountyFake .Text := f rmAddress. FMCounties List.Items [x];
  4752              AnimateLog o(False);
  4753              StatusBarL oadPt.Capt ion := 'Re ady.';
  4754              StatusBarL oadPt.Repa int;
  4755              Applicatio n.Processm essages;
  4756           En d;
  4757         End;
  4758       End;
  4759     End;
  4760  
  4761     Contexto rChangeMes sage := 'Y ou are edi ting an ad dress. If  you contin ue, CAPRI  will drop  out of the  clinical  context.';
  4762     CCOWBrea kLink := T rue;
  4763  
  4764     addressi nfo := '';
  4765     If frmAd dress.Show Modal = mr OK Then
  4766     Begin
  4767       tempte xtz := 'Ad dress:        ';
  4768       If (fr mAddress.F MEditStree t1.Text <>  '') And ( frmAddress .FMEditStr eet1.Text  <> '@') Th en
  4769         addr essinfo :=  addressin fo + tempt extz + frm Address.FM EditStreet 1.Text + C R + LF;
  4770       If (fr mAddress.F MEditStree t1.Text <>  '') And ( frmAddress .FMEditStr eet1.Text  <> '@') Th en
  4771         temp textz := '                 ';
  4772       If (fr mAddress.F MEditStree t2.Text <>  '') And ( frmAddress .FMEditStr eet2.Text  <> '@') Th en
  4773         addr essinfo :=  addressin fo + tempt extz + frm Address.FM EditStreet 2.Text + C R + LF;
  4774       If (fr mAddress.F MEditStree t2.Text <>  '') And ( frmAddress .FMEditStr eet2.Text  <> '@') Th en
  4775         temp textz := '                 ';
  4776       If (fr mAddress.F MEditStree t3.Text <>  '') And ( frmAddress .FMEditStr eet3.Text  <> '@') Th en
  4777         addr essinfo :=  addressin fo + tempt extz + frm Address.FM EditStreet 3.Text + C R + LF;
  4778       If (fr mAddress.F MEditCity. Text <> '' ) And (frm Address.FM EditCity.T ext <> '@' ) Then
  4779         addr essinfo :=  addressin fo + 'City :           ' + frmAd dress.FMEd itCity.Tex t + CR + L F;
  4780       If (fr mAddress.S tateFake.T ext <> '')  and (frmA ddress.Sta teFake.Tex t <> '@')  then
  4781         addr essinfo :=  addressin fo + 'Stat e:          ' + frmAd dress.Stat eFake.Text  + CR + LF ;
  4782       If (fr mAddress.F MEditZip.T ext <> '')  And (frmA ddress.FME ditZip.Tex t <> '@')  Then
  4783         addr essinfo :=  addressin fo + 'Zip:             ' + frmAd dress.FMEd itZip.Text  + CR + LF ;
  4784       If (fr mAddress.C ountyFake. Text <> '' ) and (frm Address.Co untyFake.T ext <> '@' ) Then
  4785         addr essinfo :=  addressin fo + 'Coun ty:         ' + frmAd dress.Coun tyFake.Tex t + CR + L F;
  4786       if (fr mAddress.F MEditProvi nce.Text < > '') and  (frmAddres s.FMEditPr ovince.Tex t <> '@')  then
  4787         addr essinfo :=  addressin fo + 'Prov ince:       ' + frmAd dress.FMEd itProvince .Text + CR  + LF;
  4788       if (fr mAddress.F MEditPosta lCode.Text  <> '') an d (frmAddr ess.FMEdit PostalCode .Text <> ' @') then
  4789         addr essinfo :=  addressin fo + 'Post al Code:    ' + frmAd dress.FMEd itPostalCo de.Text +  CR + LF;
  4790       if (fr mAddress.c boCountry. Text <> '' ) then
  4791         addr essinfo :=  addressin fo + 'Coun try:        ' + frmAd dress.cboC ountry.Tex t + CR + L F;
  4792       If (fr mAddress.F MEditPhone .Text <> ' ') And (fr mAddress.F MEditPhone .Text <> ' @') Then
  4793         addr essinfo :=  addressin fo + 'Phon e:          ' + frmAd dress.FMEd itPhone.Te xt + CR +  LF;
  4794       If (fr mAddress.F MEditOffic e.Text <>  '') And (f rmAddress. FMEditOffi ce.Text <>  '@') Then
  4795         addr essinfo :=  addressin fo + 'Offi ce Phone:   ' + frmAd dress.FMEd itOffice.T ext + CR +  LF;
  4796       If IsP atchInstal led('DVBA* 2.7*190')  then                                        // CodeCR6 94 JRL 3/2 7/15
  4797       begin                                                                               // CodeCR6 94 JRL 3/2 7/15
  4798         If ( frmAddress .FMEditCel l.Text <>  '') And (f rmAddress. FMEditCell .Text <> ' @') Then / / CodeCR69 4 JRL 3/13 /15
  4799           ad dressinfo  := address info + 'Ce ll Phone:   ' + frmAd dress.FMEd itCell.Tex t + CR + L F; // Code CR694 JRL  3/13/15
  4800         If ( frmAddress .FMEditEma il.Text <>  '') And ( frmAddress .FMEditEma il.Text <>  '@') Then  // CodeCR 694 JRL 3/ 13/15
  4801           ad dressinfo  := address info + 'Em ail:  ' +  frmAddress .FMEditEma il.Text +  CR + LF; / / CodeCR69 4 JRL 3/13 /15
  4802       end;                                                                                // CodeCR6 94 JRL 3/2 7/15
  4803  
  4804       If (fr mAddress.A ddressDate .Text <> ' ') Then
  4805   //      ad dressinfo  := address info + CR  + LF + frm Address.La bel12.Capt ion + '  '  + frmAddr ess.Addres sDate.Text  + CR + LF ;
  4806         addr essinfo :=  addressin fo + CR +  LF + frmAd dress.lblA ddressDate .Caption +  '  ' + fr mAddress.A ddressDate .Text + CR  + LF; //  rpk 4/20/2 015
  4807     End;
  4808     (*
  4809        If fr mAddress.S howmodal=m rCancel th en begin
  4810          Pag e95Control 1.ActivePa ge:=AdminD ocuments;
  4811          Tab 95Control3 .Tabs[Tab9 5Control3. TabIndex]: ='Address' ;
  4812          Scr ollBoxAddr ess.VertSc rollBar.Po sition:=0;
  4813          frm Address.re lease; frm Address :=  nil;
  4814          Con textorChan geMessage: ='';
  4815          CCO WBreakLink :=False;
  4816          exi t;
  4817        end;
  4818        *)
  4819  
  4820     frmAddre ss.release ;
  4821     frmAddre ss := Nil;
  4822     AddReque stIEN := ' +1';
  4823     frmMain. RPCBroker1 .Results.C lear;
  4824     RPCBroke r1.RemoteP rocedure : = 'DVBAB C HECK CREDE NTIALS';
  4825     RPCBroke rCall;
  4826     Try
  4827       RPCBro ker1.Call;
  4828     Except
  4829       On EBr okerError  Do
  4830       Begin
  4831         ANUR emoteProce dureCallIn Progress : = False;
  4832         Anim ateLogo(Fa lse);
  4833         Stat usBarLoadP t.Caption  := 'RPC DV BAB CHECK  CREDENTIAL S could no t be acces sed!';
  4834         Stat usBarLoadP t.Repaint;
  4835         Appl ication.Pr ocessmessa ges;
  4836         Show MessageCAP RI('RPC DV BAB CHECK  CREDENTIAL S could no t be acces sed!');
  4837       End
  4838     End;
  4839     If RPCBr oker1.Resu lts[0] <>  '[OK]' The n
  4840     Begin
  4841       ShowMe ssageCAPRI (RPCBroker 1.Results[ 0]);
  4842       applic ation.term inate;
  4843       Exit;
  4844     End;
  4845     btnAddRe quest.Enab led := Fal se;
  4846     btnViewE xam.Enable d := False ;
  4847     btnExamF inalReport .Enabled : = False;
  4848     btnGener ateReport. Enabled :=  False;
  4849     btnGener ate7131Rep ort.enable d := False ;
  4850     frmNewEx am := Tfrm NewExam.Cr eate(frmMa in);
  4851     // If cr edentials  are ok, th en continu e
  4852     // Popul ate lists  and contro ls
  4853     //FMList erExams.Ge tList(frmN ewExam.FME xamsList.I tems);
  4854     //frmNew Exam := Tf rmNewExam. Create(frm Main);
  4855     frmNewEx am.FMExams List.Items  := ListEx ams;
  4856     frmNewEx am.CheckBo xExamsToCo mplete.Ite ms.Clear;
  4857     GetActiv eCapriDivi sions(list MedicalCen terDivisio n, frmNewE xam.FMRout ingLocatio n.Items);  //CodeCR17 3 - rpm 4/ 18/11
  4858     frmNewEx am.FMListB oxBodySyst ems.GetLis t;
  4859  
  4860     frmNewEx am.TreeVie wExams.Ite ms.Clear;
  4861     nodecoun t := 0;
  4862     If frmNe wExam.FMLi stBoxBodyS ystems.Ite ms.Count >  0 Then
  4863       For x  := 0 To fr mNewExam.F MListBoxBo dySystems. Items.Coun t - 1 Do
  4864       Begin
  4865         MyTr eeNode[x]  := frmNewE xam.TreeVi ewExams.It ems.Add(Ni l, frmNewE xam.FMList BoxBodySys tems.Items [x]);
  4866         node count := n odecount +  1;
  4867         frmN ewExam.FML istBoxBody Systems.It emIndex :=  x;
  4868         For  y := 0 To  frmNewExam .FMExamsLi st.Items.C ount - 1 D o
  4869           If  Pos('  I   ', frmNew Exam.FMExa msList.Ite ms[y]) = 0  Then
  4870              If Pos('   ' + frmNew Exam.FMLis tBoxBodySy stems.GetS electedRec ord.IEN +  '  ', frmN ewExam.FME xamsList.I tems[y] +  '  ') > 0  Then
  4871              Begin
  4872                MyTreeNo de[NodeCou nt] := frm NewExam.Tr eeViewExam s.Items.Ad dChild(MyT reeNode[x] , Copy(frm NewExam.FM ExamsList. Items[y],  1, Pos('   A', frmNew Exam.FMExa msList.Ite ms[y]) - 3 ));
  4873                inc(node count);
  4874              End;
  4875         If M yTreeNode[ x].getFirs tChild = N il Then
  4876           My TreeNode[x ].Delete;
  4877       End;
  4878  
  4879     //FMList erInstitut ionFile.Ge tList(frmN ewExam.FMR egionalOff iceNumber. Items);
  4880     frmNewEx am.FMRegio nalOfficeN umber.Item s.Clear;
  4881  
  4882     (*
  4883     If lstIn stitutions .Items.Cou nt>0 then
  4884       For x: =0 to lstI nstitution s.Items.Co unt-1 do
  4885           fr mNewExam.F MRegionalO fficeNumbe r.Items.Ad d(Copy(lst Institutio ns.Items[x ],1,Pos('^ ',lstInsti tutions.It ems[x])-1) );
  4886       *)
  4887   (*
  4888     frmNewEx am.FMRegio nalOfficeN umber.Item s:=lstInst itutions.I tems;
  4889     If frmNe wExam.FMRe gionalOffi ceNumber.I tems.Count >0 then
  4890       For x: =frmNewExa m.FMRegion alOfficeNu mber.Items .Count-1 d ownto 0 do
  4891         If P os('-RO ', frmNewExam .FMRegiona lOfficeNum ber.Items[ x])=0 then
  4892           fr mNewExam.F MRegionalO fficeNumbe r.Items.De lete(x) el se
  4893              frmNewExam .FMRegiona lOfficeNum ber.Items[ x]:=Copy(f rmNewExam. FMRegional OfficeNumb er.Items[x ],1,Pos('   ',frmNewE xam.FMRegi onalOffice Number.Ite ms[x])-1);
  4894   *)
  4895     frmNewEx am.FMPatie ntName.Tex t := Copy( Panel1.Cap tion, 1, P os('  SSN# ', Panel1. Caption));
  4896     frmNewEx am.FMPatie ntNameIEN. Text := '` ' + Patien tIEN;
  4897     frmNewEx am.FMReque stedBy.Tex t := FMUse rName.Capt ion;
  4898     frmNewEx am.FMReque stedByIEN. Text := '` ' + Author IEN;
  4899     frmNewEx am.FMReque stDate.Tex t := 'NOW' ;
  4900     frmNewEx am.FMReque stedByIEN. Text := '` ' + Author IEN;
  4901     if IsPat chInstalle d('DVBA*2. 7*193') th en         // Patch 1 93 JRL 4/2 1/16 NEW R EQUEST STA TUS FIELD  UPDATE
  4902       frmNew Exam.FMReq uestStatus .Text := ' NEW'       // Patch 1 93 JRL 4/2 1/16 NEW R EQUEST STA TUS FIELD  UPDATE
  4903     else                                                 // Patch 1 93 JRL 4/2 1/16 NEW R EQUEST STA TUS FIELD  UPDATE
  4904       frmNew Exam.FMReq uestStatus .Text := ' N';
  4905     frmNewEx am.FMClaim FolderRequ ired.Text  := '';
  4906     If IsPat chInstalle d('DVBA*2. 7*190') th en                                          // CodeCR7 04 JRL 3/2 6/15
  4907       frmNew Exam.FMEle ctronicCla imFolder.T ext := '';                                  // CodeCR7 04 JRL 3/1 6/15
  4908     frmNewEx am.FMOther DocumentsR equired.Te xt := '';
  4909     frmNewEx am.FMRegio nalOfficeN umber.Text  := '';
  4910     frmNewEx am.FMRegio nalOfficeN umber.Enab led := Tru e;
  4911     frmNewEx am.FMPrior ityOfExam. Text := '' ;
  4912     frmNewEx am.FMPrior ityOfExam. Enabled :=  True;                                      // In case  insuffici ent exam a ction turn ed it off
  4913     frmNewEx am.FMOther Disabiliti es1.Text : = '';
  4914     frmNewEx am.FMOther Disabiliti es2.Text : = '';
  4915     frmNewEx am.FMOther Disabiliti es3.Text : = '';
  4916     frmNewEx am.FMRouti ngLocation .Text := ' ';
  4917     frmNewEx am.FMLastR atingExamD ate.Text : = '';
  4918     frmNewEx am.FMComme ntsMemo.Li nes.Clear;
  4919     //Setup  for new en try
  4920     frmNewEx am.FMPatie ntNameIEN. IENS := '+ 1';
  4921     frmNewEx am.FMReque stDate.IEN S := '+1';
  4922     frmNewEx am.FMClaim FolderRequ iredFake.I ENS := '+1 ';
  4923     If IsPat chInstalle d('DVBA*2. 7*190') th en                                          // CodeCR7 04 JRL 3/2 6/15
  4924       frmNew Exam.FMEle ctronicCla imFolderFa ke.IENS :=  '+1';                           // CodeCR7 04 JRL 3/1 6/15
  4925     frmNewEx am.FMOther DocumentsR equiredFak e.IENS :=  '+1';
  4926     frmNewEx am.FMRegio nalOfficeN umberIEN.I ENS := '+1 ';
  4927     frmNewEx am.FMReque stedByIEN. IENS := '+ 1';
  4928     frmNewEx am.FMReque stStatus.I ENS := '+1 ';
  4929     frmNewEx am.FMPrior ityOfExamF ake.IENS : = '+1';
  4930     frmNewEx am.FMOther Disabiliti es1.IENS : = '+1';
  4931     frmNewEx am.FMOther Disabiliti es2.IENS : = '+1';
  4932     frmNewEx am.FMOther Disabiliti es3.IENS : = '+1';
  4933     frmNewEx am.FMRouti ngLocation Fake.IENS  := '+1';
  4934     frmNewEx am.FMLastR atingExamD ate.IENS : = '+1';
  4935     frmNewEx am.FMComme ntsMemo.IE NS := '+1' ;
  4936     frmNewEx am.FMOrigi nal2507Req uest.IENS  := '+1';
  4937     frmNewEx am.FMOrigi nal2507Pro cessingTim e.IENS :=  '+1';
  4938     frmNewEx am.FMOrigi nal2507Req uest.Text  := '';
  4939     frmNewEx am.FMOrigi nal2507Pro cessingTim e.Text :=  '';
  4940  
  4941     //Enter  request
  4942     frmNewEx am.Height  := frmMain .Height -  32;
  4943     If frmNe wExam.Heig ht > 698 T hen
  4944       frmNew Exam.Heigh t := 698;
  4945     frmNewEx am.Top :=  7 + frmMai n.Top + (( frmMain.He ight - frm NewExam.He ight) Div  2);
  4946     frmNewEx am.Left :=  frmMain.L eft + ((fr mMain.Widt h - frmNew Exam.Width ) Div 2);
  4947     frmNewEx am.btnSend Request.To p := frmNe wExam.Heig ht - 81;                         //73
  4948     frmNewEx am.btnCanc el.Top :=  frmNewExam .Height -  81;                              //73
  4949     frmNewEx am.Scrollb ox1.Height  := frmNew Exam.Heigh t - 82;                          //-74
  4950     //frmMai n.BorderIc ons:=frmMa in.BorderI cons-[biSy stemMenu];
  4951     frmNewEx am.Scrollb ox1.VertSc rollBar.Po sition :=  0;
  4952  
  4953     frmNewEx am.FMListe rCustomExa mListDivis ionsListBo x.GetList;
  4954     //Check  for inacti ve divisio ns
  4955     If frmNe wExam.FMLi sterCustom ExamListDi visionsLis tBox.Items .Count > 0  Then
  4956       For x  := 0 To fr mNewExam.F MListerCus tomExamLis tDivisions ListBox.It ems.Count  - 1 Do
  4957       Begin
  4958         frmN ewExam.FML isterCusto mExamListD ivisionsLi stBox.Item Index := x ;
  4959         frmN ewExam.Cus tomExamLis tDivisions .IENS := f rmNewExam. FMListerCu stomExamLi stDivision sListBox.G etSelected Record.IEN ;
  4960         frmN ewExam.Cus tomExamLis tDivisions .GetAndFil l;
  4961       End;
  4962     frmNewEx am.FMRouti ngLocation .ItemIndex  := -1;
  4963  
  4964     //rra 97 0009 - set  Routing L ocation In formation  to null un til a Rout ing Locati on is sele cted
  4965     frmNewEx am.FMMemoD ivisionCom ments.text  := '';
  4966  
  4967     // Set u p division ...
  4968     searchfo rstring :=  UserDivis ion;
  4969     frmNewEx am.FMRegio nalOfficeN umberEnter (Applicati on);
  4970     searchfo rstring :=  '';
  4971     If frmNe wExam.FMRe gionalOffi ceNumberIE N.Text <>  '' Then
  4972       frmNew Exam.FMReg ionalOffic eNumber.En abled := F alse;
  4973  
  4974     (*
  4975     frmNewEx am.FMRegio nalOfficeN umber.Enab led:=False ;
  4976     frmNewEx am.FMRegio nalOfficeN umber.Text :=UserDivi sion;
  4977     frmNewEx am.FMRegio nalOfficeN umberExit( Applicatio n);
  4978     *)
  4979     frmNewEx am.Panel1. Visible :=  False;
  4980     Contexto rChangeMes sage := 'Y ou are add ing an exa m request.  If you co ntinue, yo u will los e this wor k.';
  4981     CCOWBrea kLink := T rue;
  4982     frmNewEx am.ShowMod al;
  4983     Contexto rChangeMes sage := '' ;
  4984     CCOWBrea kLink := F alse;
  4985     frmNewEx am.release ;
  4986     frmNewEx am := Nil;
  4987     Try
  4988       frmROF inder.Hide ;
  4989     Except
  4990     End;
  4991  
  4992     //frmMai n.BorderIc ons:=frmMa in.BorderI cons+[biSy stemMenu];
  4993     ExamRequ estRefresh Click(Appl ication);
  4994     If ReadO nlyMode =  False Then
  4995       btnAdd Request.En abled := T rue;
  4996     If FMExa mRequestLi stbox.Item Index > -1  Then
  4997     Begin
  4998       btnVie wExam.Enab led := Tru e;
  4999       btnExa mFinalRepo rt.Enabled  := True;
  5000       btnGen erateRepor t.Enabled  := True;
  5001     End;
  5002   End;
  5003  
  5004   Procedure  TfrmMain.b tnViewExam Click(Send er: TObjec t);
  5005   Var
  5006     x, y: in teger;
  5007     MyTreeNo de: Array[ 0..50000]  Of TTreeNo de;
  5008     NodeCoun t: LongInt ;
  5009   Begin
  5010     If ANURe moteProced ureCallInP rogress =  True Then
  5011       exit;
  5012  
  5013     NodeCoun t := 0;
  5014  
  5015     If frmRO Finder.ORL istBoxSite s.Items.Co unt = 0 Th en
  5016       LoadIn stitutions ;
  5017  
  5018     For x :=  0 To 1000  Do
  5019       Cancel It[x] := F alse;
  5020     For x :=  0 To 1000  Do
  5021       Cancel Reason[x]  := '';
  5022     If FMExa mRequestLi stbox.Item Index = -1  Then
  5023       exit;
  5024     frmMain. RPCBroker1 .Results.C lear;
  5025     RPCBroke r1.RemoteP rocedure : = 'DVBAB C HECK CREDE NTIALS';
  5026     RPCBroke rCall;
  5027     Try
  5028       RPCBro ker1.Call;
  5029     Except
  5030       On EBr okerError  Do
  5031       Begin
  5032         ANUR emoteProce dureCallIn Progress : = False;
  5033         Anim ateLogo(Fa lse);
  5034         Stat usBarLoadP t.Caption  := 'RPC DV BAB CHECK  CREDENTIAL S could no t be acces sed!';
  5035         Stat usBarLoadP t.Repaint;
  5036         Appl ication.Pr ocessmessa ges;
  5037         Show MessageCAP RI('RPC DV BAB CHECK  CREDENTIAL S could no t be acces sed!');
  5038       End;
  5039     End;
  5040     If RPCBr oker1.Resu lts[0] <>  '[OK]' The n
  5041     Begin
  5042       ShowMe ssageCAPRI (RPCBroker 1.Results[ 0]);
  5043       applic ation.term inate;
  5044       Exit;
  5045     End;
  5046  
  5047     btnAddRe quest.Enab led := Fal se;
  5048     BitBtnVi stA.enable d := False ;
  5049     btnViewE xam.Enable d := False ;
  5050     btnExamF inalReport .Enabled : = False;
  5051     btnGener ateReport. Enabled :=  False;
  5052     // Set u p form
  5053     frmViewE xam := Tfr mViewExam. Create(frm Main);
  5054     If ReadO nlyMode =  True Then
  5055     Begin
  5056       frmVie wExam.btnC ancelAllEx ams.Enable d := False ;
  5057       frmVie wExam.btnA ddExam.Ena bled := Fa lse;
  5058     End;
  5059     frmViewE xam.FMGets ExamReques t.IENS :=  FMExamRequ estListbox .GetSelect edRecord.I EN;
  5060     frmViewE xam.FMGets ExamReques t.GetAndFi ll;
  5061     //FMList erExams.Ge tList(frmV iewExam.FM ExamsList. Items);
  5062     //frmVie wExam.FMLi sterReRout e.
  5063     
  5064     frmViewE xam.FMExam sList.Item s := listE xams;
  5065     GetActiv eCapriDivi sions(list MedicalCen terDivisio n, frmView Exam.FMRou tingLocati on.Items);  //CodeCR1 73 - rpm 4 /18/11
  5066     frmViewE xam.FMList BoxBodySys tems.GetLi st;
  5067  
  5068     frmViewE xam.TreeVi ewExams.It ems.Clear;
  5069     If frmVi ewExam.FML istBoxBody Systems.It ems.Count  > 0 Then
  5070       For x  := 0 To fr mViewExam. FMListBoxB odySystems .Items.Cou nt - 1 Do
  5071       Begin
  5072         MyTr eeNode[x]  := frmView Exam.TreeV iewExams.I tems.Add(N il, frmVie wExam.FMLi stBoxBodyS ystems.Ite ms[x]);
  5073         node count := n odecount +  1;
  5074         frmV iewExam.FM ListBoxBod ySystems.I temIndex : = x;
  5075         For  y := 0 To  frmViewExa m.FMExamsL ist.Items. Count - 1  Do
  5076           If  Pos('  I   ', frmVie wExam.FMEx amsList.It ems[y]) =  0 Then
  5077              If Pos('   ' + frmVie wExam.FMLi stBoxBodyS ystems.Get SelectedRe cord.IEN +  '  ', frm ViewExam.F MExamsList .Items[y]  + '  ') >  0 Then
  5078              Begin
  5079                MyTreeNo de[NodeCou nt] := frm ViewExam.T reeViewExa ms.Items.A ddChild(My TreeNode[x ], Copy(fr mViewExam. FMExamsLis t.Items[y] , 1, Pos('   A', frmV iewExam.FM ExamsList. Items[y])  - 3));
  5080                inc(node count);
  5081              End;
  5082         If M yTreeNode[ x].getFirs tChild = N il Then
  5083           My TreeNode[x ].Delete;
  5084       End;
  5085  
  5086     //FMList erInstitut ionFile.Ge tList(frmV iewExam.FM RegionalOf ficeNumber .Items);
  5087   (*
  5088     frmViewE xam.FMRegi onalOffice Number.Ite ms.Clear;
  5089     If lstIn stitutions .Items.Cou nt>0 then
  5090       For x: =0 to lstI nstitution s.Items.Co unt-1 do
  5091           fr mViewExam. FMRegional OfficeNumb er.Items.A dd(Copy(ls tInstituti ons.Items[ x],1,Pos(' ^',lstInst itutions.I tems[x])-1 ));
  5092   *)
  5093   (*
  5094     frmViewE xam.FMRegi onalOffice Number.Ite ms:=lstIns titutions. Items;
  5095     If frmVi ewExam.FMR egionalOff iceNumber. Items.Coun t>0 then
  5096       For x: =frmViewEx am.FMRegio nalOfficeN umber.Item s.Count-1  downto 0 d o
  5097         If P os('-RO ', frmViewExa m.FMRegion alOfficeNu mber.Items [x])=0 the n
  5098           fr mViewExam. FMRegional OfficeNumb er.Items.D elete(x) e lse
  5099              frmViewExa m.FMRegion alOfficeNu mber.Items [x]:=Copy( frmViewExa m.FMRegion alOfficeNu mber.Items [x],1,Pos( '  ',frmVi ewExam.FMR egionalOff iceNumber. Items[x])- 1);
  5100   *)
  5101     // If cr edentials  are ok, th en continu e
  5102     frmViewE xam.Height  := frmMai n.Height -  32;
  5103     If frmVi ewExam.Hei ght > 1020  Then
  5104       frmVie wExam.Heig ht := 1020 ;
  5105     frmViewE xam.btnIns ufficientE xam.Top :=  frmViewEx am.Height  - 81;
  5106     frmViewE xam.btnRer outeReques t.Top := f rmViewExam .Height -  81;                   // Patch 1 93 JRL 5/1 2/16
  5107   //  frmVie wExam.btnC ancel.Top  := frmView Exam.Heigh t - 81;
  5108     frmViewE xam.btnClo se.Top :=  frmViewExa m.Height -  81;                             // rpk 11/ 17/2014
  5109     frmViewE xam.Scroll box1.Heigh t := frmVi ewExam.Hei ght - 82;
  5110     frmViewE xam.Top :=  7 + frmMa in.Top + ( (frmMain.H eight - fr mViewExam. Height) Di v 2);
  5111     frmViewE xam.Left : = frmMain. Left + ((f rmMain.Wid th - frmVi ewExam.Wid th) Div 2) ;
  5112     frmViewE xam.edExam ReferenceN umber.Text  := '';                                     //Force Sa ve Flag to  be trippe d
  5113     frmViewE xam.edExam ReferenceN umber.Text  := FMExam RequestLis tbox.GetSe lectedReco rd.IEN;
  5114     // Find  Exams
  5115     frmMain. RPCBroker1 .Results.C lear;
  5116     RPCBroke r1.RemoteP rocedure : = 'DVBAB F IND EXAMS' ;
  5117     RPCBroke r1.Param[0 ].Value :=  FMExamReq uestListbo x.GetSelec tedRecord. IEN;
  5118     RPCBroke r1.Param[0 ].PType :=  literal;
  5119     RPCBroke rCall;
  5120     Try
  5121       RPCBro ker1.Call;
  5122     Except
  5123       On EBr okerError  Do
  5124       Begin
  5125         ANUR emoteProce dureCallIn Progress : = False;
  5126         Anim ateLogo(Fa lse);
  5127         Stat usBarLoadP t.Caption  := 'RPC DV BAB FIND E XAMS could  not be ac cessed!';
  5128         Stat usBarLoadP t.Repaint;
  5129         Appl ication.Pr ocessmessa ges;
  5130         Show MessageCAP RI('RPC DV BAB FIND E XAMS could  not be ac cessed!');
  5131       End;
  5132     End;
  5133     frmViewE xam.lstExa msRequeste dHidden.It ems := RPC Broker1.Re sults;
  5134     frmViewE xam.lstExa msRequeste d.Clear;
  5135     If frmVi ewExam.lst ExamsReque stedHidden .Items.Cou nt > 0 The n
  5136       For x  := 0 To fr mViewExam. lstExamsRe questedHid den.Items. Count - 1  Do
  5137         frmV iewExam.ls tExamsRequ ested.Item s.Add(Copy (frmViewEx am.lstExam sRequested Hidden.Ite ms[x], Pos ('^', frmV iewExam.ls tExamsRequ estedHidde n.Items[x] ) + 1, 254 ));
  5138     //
  5139     frmViewE xam.btnVie wSelectedE xam.Enable d := False ;                                // Reset t his button  on reload
  5140     //frmMai n.BorderIc ons:=frmMa in.BorderI cons-[biSy stemMenu];
  5141     frmViewE xam.Scroll Box1.VertS crollBar.P osition :=  0;
  5142  
  5143     frmViewE xam.FMRegi onalOffice Number.Ena bled := Fa lse;
  5144  
  5145     Contexto rChangeMes sage := 'Y ou are vie wing/chang ing an exa m request.  If you co ntinue, CA PRI will d rop out of  the clini cal contex t.';
  5146     CCOWBrea kLink := T rue;
  5147     frmViewE xam.ShowMo dal;
  5148     Contexto rChangeMes sage := '' ;
  5149     CCOWBrea kLink := F alse;
  5150  
  5151     //frmMai n.BorderIc ons:=frmMa in.BorderI cons+[biSy stemMenu];
  5152     frmViewE xam.releas e;
  5153     frmViewE xam := Nil ;
  5154     ExamRequ estRefresh Click(Appl ication);
  5155  
  5156     if ESSOV ersion the n
  5157       BitBtn VistA.enab led := Tru e;                                                     //only rem ote connec tions - rp m 3/17/09
  5158     If ReadO nlyMode =  False Then
  5159       btnAdd Request.En abled := T rue;
  5160     If fmExa mRequestLi stbox.Item Index > -1  Then
  5161     Begin
  5162       btnVie wExam.Enab led := Tru e;
  5163       btnExa mFinalRepo rt.Enabled  := True;
  5164       btnGen erateRepor t.Enabled  := True;
  5165     End;
  5166   End;
  5167  
  5168   Procedure  TfrmMain.F MExamReque stListboxC lick(Sende r: TObject );
  5169   Begin
  5170     btnViewE xam.Enable d := True;
  5171     btnExamF inalReport .Enabled : = True;
  5172     btnGener ateReport. Enabled :=  True;
  5173   End;
  5174  
  5175   Procedure  TfrmMain.F MExamReque stListboxD rawItem(Co ntrol: TWi nControl;
  5176     Index: I nteger; Re ct: TRect;  State: TO wnerDrawSt ate);
  5177   Begin
  5178     If FMExa mRequestLi stbox.Item Index > -1  Then
  5179     Begin
  5180       btnVie wExam.Enab led := Tru e;
  5181       btnExa mFinalRepo rt.Enabled  := True;
  5182     End
  5183     Else
  5184     Begin
  5185       btnVie wExam.Enab led := Fal se;
  5186       btnExa mFinalRepo rt.Enabled  := False;
  5187     End;
  5188  
  5189     If FMExa mRequestLi stbox.Item Index > -1  Then
  5190       btnGen erateRepor t.Enabled  := True
  5191     Else
  5192       btnGen erateRepor t.Enabled  := False;
  5193   End;
  5194  
  5195   Procedure  TfrmMain.F ormResize( Sender: TO bject);
  5196   Var
  5197     x: integ er;
  5198     CenterWi dth : Inte ger;
  5199   Begin
  5200   \x0006  //Butto ns
  5201     btnAddRe quest.font  := Panel1 .Font;
  5202     btnGener ateReport. font := Pa nel1.Font;
  5203     btnViewE xam.font : = Panel1.F ont;
  5204     btnAdd71 31.font :=  Panel1.Fo nt;
  5205     btnGener ate7131Rep ort.font : = Panel1.F ont;
  5206     btnView7 131.font : = Panel1.F ont;
  5207  
  5208     //Report Tab
  5209     panelrep ortchoice. left := pa ge95contro l1.Left +  (frmMain.w idth Div 2 ) - (panel reportchoi ce.width D iv 2);
  5210     panelrep ortchoice. top := pag e95control 1.top + (f rmMain.hei ght Div 2)  - (panelr eportchoic e.height D iv 2) - 40 ;
  5211     panelrep ortchoice2 .left := p age95contr ol1.Left +  (frmMain. width Div  2) - (pane lreportcho ice2.width  Div 2);
  5212     panelrep ortchoice2 .top := pa ge95contro l1.top + ( frmMain.he ight Div 2 ) - (panel reportchoi ce2.height  Div 2) -  40;
  5213     panelsur geryreport s.left :=  page95cont rol1.Left  + (frmMain .width Div  2) - (pan elsurgeryr eports.wid th Div 2);
  5214     panelsur geryreport s.top := p age95contr ol1.top +  (frmMain.h eight Div  2) - (pane lsurgeryre ports.heig ht Div 2)  - 40;
  5215  
  5216     //Clinic al Documen ts Tab
  5217     btnGraph VS.Height  := Panel1. Height;
  5218     panelGra phVS.Width  := panelD ocs.Width  - 2;
  5219     panelGra phVS.Heigh t := btnGr aphVS.heig ht + 8;
  5220     btnGraph VS.Width : = PanelGra phVS.Width  - 16;
  5221     buttonCl inDocDateR ange.Font  := Panel1. Font;
  5222     buttonCl inDocDateR ange.Heigh t := Panel 1.Height;
  5223     buttonCl inDocDateR ange.Left  := Round(T ab95Contro l1.Width *  0.63);
  5224     ButtonCl inDocDateR ange.Width  := PanelD ocs.Width  + PanelDoc s.Left - B uttonClinD ocDateRang e.Left;
  5225     btnMulti .Height :=  (Panel1.F ont.Height  * -1) + 8 ;
  5226     btnMulti 2.Height : = (Panel1. Font.Heigh t * -1) +  8;
  5227     btnMulti .font := P anel1.Font ;
  5228     btnMulti 2.font :=  Panel1.Fon t;
  5229     label15. caption :=  '0000000  Items';
  5230     btnMulti .Left := L abelDocsFo und.Left +  Label15.W idth + 16;
  5231     btnMulti 2.Left :=  btnMulti.L eft + btnM ulti.Width  + 1;
  5232     label15. caption :=  'Find:';
  5233     btnMulti .Height :=  Panel1.He ight;
  5234     btnMulti 2.Height : = Panel1.H eight;
  5235     label15. caption :=  btnMulti. Caption;
  5236     btnMulti .Width :=  Label15.Wi dth + 40;
  5237     label15. caption :=  btnMulti2 .Caption;
  5238     btnMulti 2.Width :=  Label15.W idth + 40;
  5239     label15. caption :=  'Find:';
  5240     paneldoc s.top := b tnMulti.To p + btnMul ti.Height  + 4;
  5241     paneldoc s.height : = tab95con trol1.Disp layRect.Bo ttomRight. y - tab95c ontrol1.Di splayRect. TopLeft.y  - 1 - pane lDocs.Top;
  5242     PanelDoc s.Width :=  Page95Con trol1.Widt h - 32;
  5243     LabelCur rentView.L eft := but tonClinDoc DateRange. Left - Lab elCurrentV iew.width  - 8;
  5244     btndivis ions.heigh t := Panel 1.Height;
  5245     btnGraph VS.height  := Panel1. Height;
  5246     panelcou nt.top :=  paneldocs. top + pane ldocs.heig ht - panel count.heig ht * 2 - 8 ;
  5247     //panelG raphVS.top :=paneldoc s.top+pane ldocs.heig ht-panelGr aphVS.heig ht*2-8;
  5248     panelsea rch.top :=  panelcoun t.top;
  5249     label15. caption :=  btnDivisi ons.Captio n;
  5250     btnDivis ions.Width  := Label1 5.Width +  8;
  5251     btnDivis ions.Heigh t := Panel 1.Height;
  5252     label15. caption :=  btnGraphV S.Caption;
  5253     btnGraph VS.Width : = Label15. Width + 8;
  5254     btnGraph VS.Height  := Panel1. Height;
  5255     label15. caption :=  buttonSea rch.Captio n;
  5256     buttonSe arch.Width  := Label1 5.Width +  8;
  5257     buttonSe arch.Heigh t := Panel 1.Height -  2;
  5258     Label15. Caption :=  'Search t erms here' ;
  5259     EditSear chPN.Width  := label1 5.width;
  5260     label15. caption :=  'Find:';
  5261     PanelCou nt.Height  := btnDivi sions.Heig ht + btnDi visions.to p;
  5262     PanelCou nt.Width : = btnDivis ions.Width  + 8;
  5263     //PanelG raphVS.Hei ght:=btnGr aphVS.Heig ht+btnGrap hVS.top;
  5264     //PanelG raphVS.Wid th:=btnGra phVS.Width +8;
  5265     panelSea rch.Height  := editse archPN.Hei ght + 3;
  5266     splitter 2.height : = panelcou nt.height  + 6;
  5267     Panelsea rch.Width  := Label15 .Width + 8  + EditSea rchPN.Widt h + 8 + bu ttonsearch .width + 8 ;
  5268     Label15. Left := 4;
  5269     EditSear chPN.Left  := Label15 .Left + La bel15.Widt h + 8;
  5270     ButtonSe arch.Left  := EditSea rchPN.Left  + EditSea rchPN.Widt h + 8;
  5271     PanelSea rch.Left : = PanelDoc s.Width -  PanelSearc h.Width -  8;
  5272  
  5273     //Addres s tab
  5274     FMEditSt reet2.Top  := FMEditS treet1.Top  + FMEditS treet1.Hei ght + 4;
  5275     FMEditSt reet3.Top  := FMEditS treet2.Top  + FMEditS treet2.Hei ght + 4;
  5276     FMEditCi ty.Top :=  FMEditStre et3.Top +  FMEditStre et3.Height  + 4;
  5277     StateFak e.Top := F MEditCity. Top + FMEd itCity.Hei ght + 4;
  5278     FMStates List.Top : = StateFak e.Top;
  5279     ButtonSt ateAccept. Top := FMS tatesList. Top + FMSt atesList.H eight + 1;
  5280     FMEditSt ate.Top :=  FMEditCit y.Top + FM EditCity.H eight + 4;
  5281     FMEditZi p.Top := F MEditState .Top + FME ditState.H eight + 4;
  5282     CountyFa ke.Top :=  FMEditZip. Top + FMEd itZip.Heig ht + 4;
  5283     FMCounti esList.Top  := County Fake.Top;
  5284     ButtonCo untyAccept .Top := FM CountiesLi st.Top + F MCountiesL ist.Height  + 1;
  5285     FMEditCo unty.Top : = FMEditZi p.Top + FM EditZip.He ight + 4;
  5286     FMEditPh one.Top :=  FMEditCou nty.Top +  FMEditCoun ty.Height  + 4;
  5287     FMEditOf fice.Top : = FMEditPh one.Top +  FMEditPhon e.Height +  4;
  5288     FMEditCo untry.Top  := FMEditC ity.Top;                                               //Country
  5289     FMEditPr ovince.Top  := FMEdit State.Top;                                             //Province
  5290     FMEditPo stalCode.T op := FMEd itZip.Top;                                             //Postal C ode
  5291     FMEditLa stUpdate.T op := FMEd itCounty.T op;                                         //Last Upd ate
  5292     FMEditUp dateSite.T op := FMEd itPhone.To p;                                          //Update S ite
  5293  
  5294     lblAddre ss.Top :=  FMEditStre et1.Top +  3;
  5295     lblCity. Top := FME ditCity.To p + 3;
  5296     lblState .Top := FM EditState. Top + 3;
  5297     lblZip.T op := FMEd itZip.Top  + 3;
  5298     lblCount y.Top := F MEditCount y.Top + 3;
  5299     lblPhone .Top := FM EditPhone. Top + 3;
  5300     lblOffic e.Top := F MEditOffic e.Top + 3;
  5301     lblCount ry.Top :=  lblCity.To p;                                                     //Country
  5302     lblProvi nce.Top :=  lblState. Top;                                                   //Province
  5303     lblPosta lCode.Top  := lblZip. Top;                                                   //Postal C ode
  5304     lblLastU pdate.Top  := lblCoun ty.Top;                                                //Last Upd ate
  5305     lblUpdat eSite.Top  := lblPhon e.Top;                                                 //Update S ite
  5306  
  5307     FMEditSt reet1.Left  := lblOff ice.Width  + lblOffic e.Left + 3 0;
  5308     FMEditSt reet2.Left  := lblOff ice.Width  + lblOffic e.Left + 3 0;
  5309     FMEditSt reet3.Left  := lblOff ice.Width  + lblOffic e.Left + 3 0;
  5310     FMEditCi ty.Left :=  lblOffice .Width + l blOffice.L eft + 30;
  5311     StateFak e.Left :=  lblOffice. Width + lb lOffice.Le ft + 30;
  5312     FMEditSt ate.Left : = lblOffic e.Width +  lblOffice. Left + 30;
  5313     FMEditZi p.Left :=  lblOffice. Width + lb lOffice.Le ft + 30;
  5314     CountyFa ke.Left :=  lblOffice .Width + l blOffice.L eft + 30;
  5315     FMEditCo unty.Left  := lblOffi ce.Width +  lblOffice .Left + 30 ;
  5316     FMEditPh one.Left : = lblOffic e.Width +  lblOffice. Left + 30;
  5317     FMEditOf fice.Left  := lblOffi ce.Width +  lblOffice .Left + 30 ;
  5318     FMStates List.Left  := lblOffi ce.Width +  lblOffice .Left + 30 ;
  5319     ButtonSt ateAccept. Left := lb lOffice.Wi dth + lblO ffice.Left  + 30;
  5320     FMCounti esList.Lef t := lblOf fice.Width  + lblOffi ce.Left +  30;
  5321     ButtonCo untyAccept .Left := l blOffice.W idth + lbl Office.Lef t + 30;
  5322     lblCount ry.Left :=  FMEditCit y.Left + F MEditCity. Width + 30 ;                     //Country
  5323     FMEditCo untry.Left  := lblCou ntry.Left  + lblCount ry.Width +  30;
  5324     lblProvi nce.Left : = lblCount ry.Left;                                               //Province
  5325     FMEditPr ovince.Lef t := FMEdi tCountry.L eft;
  5326     lblPosta lCode.Left  := lblCou ntry.Left;                                             //Postal C ode
  5327     FMEditPo stalCode.L eft := FME ditCountry .Left;
  5328     lblLastU pdate.Left  := lblCou ntry.Left;                                             //LastUpda te
  5329     FMEditLa stUpdate.L eft := FME ditCountry .Left;
  5330     lblUpdat eSite.Left  := lblCou ntry.Left;                                             //UpdateSi te
  5331     FMEditUp datesite.L eft := FME ditCountry .Left;
  5332  
  5333     x := Scr ollBoxAddr ess.Width  - FMEditSt reet1.Left  - FMEditS treet1.Wid th - lblAd dress.Left  - lblAddr ess.Left;
  5334     FMEditSt reet1.Widt h := FMEdi tStreet1.W idth + x;
  5335     FMEditSt reet2.Widt h := FMEdi tStreet1.W idth;
  5336     FMEditSt reet3.Widt h := FMEdi tStreet1.W idth;
  5337     FMEditCi ty.Width : = FMEditCi ty.Width +  x Div 2;
  5338     StateFak e.Width :=  StateFake .Width + x  Div 2;
  5339     FMStates List.Width  := StateF ake.Width;
  5340     ButtonSt ateAccept. Width := S tateFake.W idth;
  5341     FMEditSt ate.Width  := StateFa ke.Width;
  5342     FMEditZi p.Width :=  StateFake .Width;
  5343     CountyFa ke.Width : = StateFak e.Width;
  5344     FMCounti esList.Wid th := Stat eFake.Widt h;
  5345     ButtonCo untyAccept .Width :=  StateFake. Width;
  5346     FMEditCo unty.Width  := StateF ake.Width;
  5347     FMEditPh one.Width  := StateFa ke.Width;
  5348     FMEditOf fice.Width  := StateF ake.Width;
  5349     FMEditCo untry.Widt h := State Fake.Width ;                                           //Country
  5350     FMEditPr ovince.Wid th := Stat eFake.Widt h;                                          //Province
  5351     FMEditPo stalCode.W idth := St ateFake.Wi dth;                                        //Postal C ode
  5352     FMEditLa stUpdate.W idth := St ateFake.Wi dth;                                        //Last Upd ate
  5353     FMEditUp dateSite.W idth := St ateFake.Wi dth;                                        //Update S ite
  5354  
  5355     btnEditA ddress.Hei ght := Pan el1.Height ;
  5356     btnRefre shAddress. Height :=  btnEditAdd ress.Heigh t;
  5357     btnSaveA ddress.Hei ght := btn EditAddres s.Height;
  5358     buttonSt ateAccept. Height :=  btnEditAdd ress.Heigh t;
  5359     buttonCo untyAccept .Height :=  btnEditAd dress.Heig ht;
  5360  
  5361     btnEditA ddress.Top  := FMEdit Office.Top  + FMEditO ffice.Heig ht + 8;
  5362     btnRefre shAddress. Top := btn EditAddres s.Top;
  5363     btnSaveA ddress.Top  := btnEdi tAddress.T op;
  5364     Shape1.T op := btnE ditAddress .Top + btn EditAddres s.Height +  8;
  5365  
  5366     Label1.F ont := Pan el1.Font;
  5367     Label1.F ont.Style  := [fsbold ];
  5368     Label1.T op := Shap e1.Top + S hape1.Heig ht + 8;
  5369     FMEdit1. Top := Lab el1.Top +  Label1.Hei ght + 4;
  5370     FMEdit10 .Top := FM Edit1.Top  + FMEdit1. Height + 4 ;
  5371     FMEdit11 .Top := FM Edit10.Top ;
  5372     FMEdit2. Top := FME dit10.Top  + FMEdit10 .Height +  4;
  5373     FMEdit3. Top := FME dit2.Top +  FMEdit2.H eight + 4;
  5374     FMEdit4. Top := FME dit3.Top +  FMEdit3.H eight + 4;
  5375     FMEdit5. Top := FME dit4.Top +  FMEdit4.H eight + 4;
  5376     FMEdit6. Top := FME dit5.Top +  FMEdit5.H eight + 4;
  5377     FMEdit7. Top := FME dit6.Top +  FMEdit6.H eight + 4;
  5378     FMEdit8. Top := FME dit7.Top +  FMEdit7.H eight + 4;
  5379     FMEdit9. Top := FME dit8.Top +  FMEdit8.H eight + 4;
  5380     FMEditTe mpCountry. Top := FME dit5.Top;                                              //Temp Cou ntry
  5381     FMEditTe mpProvince .Top := FM Edit6.Top;                                             //Temp Pro vince
  5382     FMEditTe mpPostalCo de.Top :=  FMEdit7.To p;                                          //Temp Pos tal Code
  5383     FMEditTe mpLastUpda te.Top :=  FMEdit8.To p;                                          //Temp Las t Update
  5384     FMEditTe mpUpdateSi te.Top :=  FMEdit9.To p;                                          //Temp Upd ate Site
  5385  
  5386     Label3.T op := FMEd it1.Top +  3;
  5387     Label10. Top := FME dit10.Top  + 3;
  5388     Label11. Top := Lab el10.Top;
  5389     Label4.T op := FMEd it2.Top +  3;
  5390     Label7.T op := FMEd it5.Top +  3;
  5391     Label5.T op := FMEd it6.Top +  3;
  5392     Label6.T op := FMEd it7.Top +  3;
  5393     Label8.T op := FMEd it8.Top +  3;
  5394     Label9.T op := FMEd it9.Top +  3;
  5395     lblTempC ountry.Top  := Label7 .Top;                                                  //Temp Cou ntry
  5396     lblTempP rovince.To p := Label 5.Top;                                                 //Temp Pro vince
  5397     lblTempP ostalCode. Top := Lab el6.Top;                                               //Temp Pos tal Code
  5398     lblTempL astUpdate. Top := Lab el8.Top;                                               //Temp Las t Update
  5399     lblTempU pdateSite. Top := Lab el9.Top;                                               //Temp Upd ate Site
  5400  
  5401     FMEdit1. Left := La bel3.Left  + Label3.W idth + 30;
  5402     FMEdit10 .Left := l blOffice.W idth + lbl Office.Lef t + 30;
  5403     Label11. Left := FM Edit10.Lef t + FMEdit 10.Width +  30;
  5404     FMEdit11 .Left := L abel11.Lef t + Label1 1.Width +  30;
  5405     FMEdit2. Left := FM Edit10.Lef t;
  5406     FMEdit3. Left := FM Edit10.Lef t;
  5407     FMEdit4. Left := FM Edit10.Lef t;
  5408     FMEdit5. Left := FM Edit10.Lef t;
  5409     FMEdit6. Left := FM Edit10.Lef t;
  5410     FMEdit7. Left := FM Edit10.Lef t;
  5411     FMEdit8. Left := FM Edit10.Lef t;
  5412     FMEdit9. Left := FM Edit10.Lef t;
  5413     lblTempC ountry.Lef t := FMEdi t5.Left +  FMEdit5.Wi dth + 30;                        //TempCoun try
  5414     FMEditTe mpCountry. Left := lb lTempCount ry.Left +  lblTempCou ntry.Width  + 30;
  5415     lblTempP rovince.Le ft := lblT empCountry .Left;                                      //TempProv ince
  5416     FMEditTe mpProvince .Left := F MEditTempC ountry.Lef t;
  5417     lblTempP ostalCode. Left := lb lTempCount ry.Left;                                    //TempPost alCode
  5418     FMEditTe mpPostalCo de.Left :=  FMEditTem pCountry.L eft;
  5419     lblTempL astUpdate. Left := lb lTempCount ry.Left;                                    //TempLast Update
  5420     FMEditTe mpLastUpda te.Left :=  FMEditTem pCountry.L eft;
  5421     lblTempU pdateSite. Left := lb lTempCount ry.Left;                                    //TempUpda teSite
  5422     FMEditTe mpUpdateSi te.Left :=  FMEditTem pCountry.L eft;
  5423  
  5424     x := Scr ollBoxAddr ess.Width  - FMEdit2. Left - FME dit2.Width  - label4. Left - Lab el4.Left;
  5425     FMEdit1. Width := F MEdit1.Wid th + x;
  5426     FMEdit2. Width := F MEdit2.Wid th + x;
  5427     FMEdit3. Width := F MEdit3.Wid th + x;
  5428     FMEdit4. Width := F MEdit4.Wid th + x;
  5429     FMEdit5. Width := F MEdit5.Wid th + x Div  2;
  5430     FMEdit6. Width := F MEdit5.Wid th;
  5431     FMEdit7. Width := F MEdit5.Wid th;
  5432     FMEdit8. Width := F MEdit5.Wid th;
  5433     FMEdit9. Width := F MEdit5.Wid th;
  5434     FMEditTe mpCountry. Width := F MEdit5.Wid th;                                         //TempCoun try
  5435     FMEditTe mpProvince .Width :=  FMEdit5.Wi dth;                                        //TempProv ince
  5436     FMEditTe mpPostalCo de.Width : = FMEdit5. Width;                                      //TempPost alCode
  5437     FMEditTe mpLastUpda te.Width : = FMEdit5. Width;                                      //TempLast Update
  5438     FMEditTe mpUpdateSi te.Width : = FMEdit5. Width;                                      //TempUpda teSite
  5439  
  5440     x := Scr ollBoxAddr ess.Width  - FMEdit11 .Left - FM Edit11.Wid th - label 10.Left -  Label10.Le ft - Label 11.Width;
  5441     FMEdit10 .Width :=  FMEdit10.W idth + x D iv 2;
  5442     FMEdit11 .Width :=  FMEdit11.W idth + x D iv 2;
  5443  
  5444     ScrollBo xAddress.V ertScrollB ar.Range : = FMEditSt reet1.Heig ht * 28;
  5445     ScrollBo xAddress.H orzScrollB ar.Range : = FMEditSt reet1.Left  + FMEditS treet1.Wid th;
  5446     Shape1.W idth := Sc rollBoxAdd ress.HorzS crollBar.R ange - Sha pe1.Left;
  5447     btnEditA ddress.Wid th := Shap e1.Width D iv 3;
  5448     btnRefre shAddress. Width := b tnEditAddr ess.Width;
  5449     btnSaveA ddress.Wid th := Shap e1.Width -  btnRefres hAddress.W idth - btn EditAddres s.Width;
  5450     btnEditA ddress.Lef t := Shape 1.Left;
  5451     btnRefre shAddress. Left := bt nEditAddre ss.Left +  btnEditAdd ress.Width ;
  5452     btnSaveA ddress.Lef t := btnRe freshAddre ss.Left +  btnRefresh Address.Wi dth;
  5453  
  5454     //Main F older, Pat ient Capti on Bar, St atus Bar a t bottom
  5455     Panel1.W idth := fr mMain.Widt h - 13;
  5456     Panel1.H eight := ( Panel1.Fon t.Height *  -1) + 8 +  3;
  5457     Page95Co ntrol1.Top  := Panel1 .Height +  Panel1.Top  + 1;
  5458     Page95Co ntrol1.Hei ght := frm Main.Clien theight -  Panel2.hei ght - Pane l1.Height  -
  5459       Action MainMenuBa r1.Height  - 4;
  5460  
  5461     //Exam R equest Pan el and but tons
  5462     GroupBox 1.Height : = TabCPExa ms.Height  - GroupBox 1.Top - 30 ;
  5463     GroupBox 1.Left :=  56;
  5464     GroupBox 1.Width :=  Page95Con trol1.Widt h - 56 * 2 ;
  5465     Label2.T op := (Pan el1.Font.H eight * -1 ) + 8;
  5466     btnExamF inalReport .height :=  (Panel1.F ont.Height  * -1) + 8 ;
  5467     btnAddRe quest.heig ht := (Pan el1.Font.H eight * -1 ) + 8;
  5468     btnAddRe quest.widt h := Group Box1.Width  - (FMExam RequestLis tbox.Left  * 2);
  5469     btnGener ateReport. height :=  (Panel1.Fo nt.Height  * -1) + 8;
  5470     btnViewE xam.height  := (Panel 1.Font.Hei ght * -1)  + 8;
  5471   //  btnExa mFinalRepo rt.top :=  GroupBox1. Height - ( Panel1.Fon t.Height *  -1) - 20;
  5472     btnExamF inalReport .top := Gr oupBox1.He ight - (Pa nel1.Font. Height * - 1) - 15;
  5473     btnAddRe quest.Top  := btnExam FinalRepor t.Top - bt nAddReques t.Height -  0;
  5474   //  btnGen erateRepor t.top := G roupBox1.H eight - (P anel1.Font .Height *  -1) - 20;
  5475     btnGener ateReport. top := Gro upBox1.Hei ght - (Pan el1.Font.H eight * -1 ) - 15;
  5476   //  btnVie wExam.top  := GroupBo x1.Height  - (Panel1. Font.Heigh t * -1) -  20;
  5477     btnViewE xam.top :=  GroupBox1 .Height -  (Panel1.Fo nt.Height  * -1) - 15 ;
  5478   //  FMExam RequestLis tbox.Top : = Panel1.F ont.Height  * -2 + 16 ;
  5479     FMExamRe questListb ox.Top :=  Panel1.Fon t.Height *  -2 + 21;
  5480     FMExamRe questListb ox.Height  := btnAddR equest.Top  - FMExamR equestList box.Top -  2;
  5481     FMExamRe questListb ox.Width : = GroupBox 1.Width -  (FMExamReq uestListbo x.Left * 2 );
  5482     btnAddRe quest.widt h := Group Box1.Width  - (FMExam RequestLis tbox.Left  * 2);
  5483     btnExamF inalReport .width :=  FMExamRequ estListbox .Width Div  3;
  5484     btnGener ateReport. width := F MExamReque stListbox. Width Div  3;
  5485     btnViewE xam.Width  := FMExamR equestList box.Width  - btnGener ateReport. width - bt nExamFinal Report.wid th;
  5486     btnGener ateReport. Left := bt nExamFinal Report.Lef t + btnExa mFinalRepo rt.width +  1;
  5487     btnViewE xam.Left : = btnGener ateReport. Left + btn GenerateRe port.Width  + 1;
  5488     btnAddRe quest.widt h := btnEx amFinalRep ort.width  + btnGener ateReport. width + bt nViewExam. Width + 2;
  5489     lblSortD ir.Top :=  16;                                                               // CodeCR7 08 rpk 8/2 8/2015
  5490     cbxSortE xamReq.Top  := 13;                                                           // CodeCR7 08 rpk 8/2 7/2015
  5491   //  cbxSor tExamReq.L eft := Gro upBox1.Wid th - cbxSo rtExamReq. Width - 10 ;            // CodeC R708 rpk 8 /28/2015
  5492     cbxSortE xamReq.Lef t := Group Box1.Width  - cbxSort ExamReq.Wi dth - 40;             // CodeCR7 08 rpk 8/2 8/2015
  5493     lblSortD ir.Left :=  cbxSortEx amReq.Left  - lblSort Dir.Width  - 10;                 // CodeCR7 08 rpk 8/2 8/2015
  5494  
  5495     //7131 R equest Pan el and but tons
  5496     GroupBox 2.Height : = TabCPExa ms.Height  - GroupBox 2.Top - 30 ;
  5497     GroupBox 2.Left :=  56;
  5498     GroupBox 2.Width :=  Page95Con trol1.Widt h - 56 * 2 ;
  5499     Label12. Top := (Pa nel1.Font. Height * - 1) + 8;
  5500     btnAdd71 31.height  := (Panel1 .Font.Heig ht * -1) +  8;
  5501     btnGener ate7131Rep ort.height  := (Panel 1.Font.Hei ght * -1)  + 8;
  5502     btnView7 131.height  := (Panel 1.Font.Hei ght * -1)  + 8;
  5503     btnAdd71 31.top :=  GroupBox2. Height - ( Panel1.Fon t.Height *  -1) - 20;
  5504     btnGener ate7131Rep ort.top :=  GroupBox2 .Height -  (Panel1.Fo nt.Height  * -1) - 20 ;
  5505     btnView7 131.top :=  GroupBox2 .Height -  (Panel1.Fo nt.Height  * -1) - 20 ;
  5506     FMSevent yOne31Requ estListbox .Top := Pa nel1.Font. Height * - 2 + 16;
  5507     FMSevent yOne31Requ estListbox .Height :=  btnView71 31.Top - F MSeventyOn e31Request Listbox.To p - 2;
  5508     FMSevent yOne31Requ estListbox .Width :=  GroupBox2. Width - (F MSeventyOn e31Request Listbox.Le ft * 2);
  5509     btnAdd71 31.width : = FMSevent yOne31Requ estListbox .Width Div  3;
  5510     btnGener ate7131Rep ort.width  := FMSeven tyOne31Req uestListbo x.Width Di v 3;
  5511     btnView7 131.Width  := FMSeven tyOne31Req uestListbo x.Width -  btnGenerat e7131Repor t.width -  btnAdd7131 .width;
  5512     btnGener ate7131Rep ort.Left : = btnAdd71 31.Left +  btnAdd7131 .width + 1 ;
  5513     btnView7 131.Left : = btnGener ate7131Rep ort.Left +  btnGenera te7131Repo rt.Width +  1;
  5514  
  5515     //Report  Tab
  5516     //PanelR eportChoic e.Top:=(Re portMemo.H eight div  2)-(PanelR eportChoic e.Height d iv 2);
  5517     //PanelR eportChoic e.Width:=f rmMain.wid th div 2;
  5518     //PanelR eportChoic e.Left:=(f rmMain.Wid th div 2)- (PanelRepo rtChoice.W idth div 2 );
  5519     labelRep ortChoice. Font := Pa nel1.Font;
  5520     labelRep ortChoice. Height :=  (LabelRepo rtChoice.F ont.Height  * -1) + 2 ;
  5521     buttonCa ncelReport Admission. Height :=  (Panel1.Fo nt.Height  * -1) + 8;
  5522     buttonOK ReportAdmi ssion.Heig ht := (Pan el1.Font.H eight * -1 ) + 8;
  5523     buttonCa ncelReport Admission. Top := Pan elReportCh oice.Heigh t - button CancelRepo rtAdmissio n.Height -  12;
  5524     buttonOK ReportAdmi ssion.Top  := PanelRe portChoice .Height -  buttonCanc elReportAd mission.He ight - 12;
  5525     FMListBo xAdmission .Top := La belReportC hoice.Top  + LabelRep ortChoice. Height + 8 ;
  5526     FMListBo xAdmission .Height :=  buttonCan celReportA dmission.T op - FMLis tBoxAdmiss ion.Top -  8;
  5527     FMListBo xAdmission .Width :=  PanelRepor tChoice.Wi dth - (FML istBoxAdmi ssion.Left  * 2);
  5528     labelRep ortChoice. Width := F MListBoxAd mission.Wi dth;
  5529     buttonOK ReportAdmi ssion.Left  := FMList BoxAdmissi on.Left +  (fmlistbox Admission. width Div  2);
  5530     buttonOK ReportAdmi ssion.Widt h := fmlis tboxAdmiss ion.width  Div 2;
  5531     buttonCa ncelReport Admission. Width := b uttonOKRep ortAdmissi on.Left -  buttonCanc elReportAd mission.Le ft;
  5532  
  5533     //Appoin tments tab
  5534     lblApptS tatus.Font  := Panel1 .Font;
  5535     lblApptS tatus.Heig ht := (Pan el1.Font.H eight * -1 ) + 2;
  5536     MemoAppo intments.T op := lblA pptStatus. Height + l blApptStat us.top + 8 ;
  5537     btnAll.H eight := ( Panel1.Fon t.Height *  -1) + 8;
  5538     btnFutur e.Height : = (Panel1. Font.Heigh t * -1) +  8;
  5539     btnPast. Height :=  (Panel1.Fo nt.Height  * -1) + 8;
  5540     btnAdmis sions.Heig ht := (Pan el1.Font.H eight * -1 ) + 8;
  5541   //  btnSor tAdmin.Hei ght := btn All.Height ;                                             // CodeC R708 rpk 8 /27/2015
  5542     btnAll.T op := Tab9 5Control3. Height - b tnAll.Heig ht * 3 - 1 2;
  5543     btnFutur e.Top := b tnAll.Top;
  5544     btnPast. Top := btn All.top;
  5545   //  btnSor tAdmin.Top  := btnAll .Top;                                                    // CodeC R708 rpk 8 /27/2015
  5546     btnAdmis sions.Top  := btnAll. top;
  5547     MemoAppo intments.H eight := b tnAll.Top  - MemoAppo intments.T op - 12;
  5548     btnAll.W idth := Me moAppointm ents.Width  Div 5;
  5549     btnFutur e.Width :=  MemoAppoi ntments.Wi dth Div 5;
  5550     btnPast. Width := M emoAppoint ments.Widt h Div 5;
  5551     btnAdmis sions.Widt h := MemoA ppointment s.Width Di v 5;
  5552     btnFutur e.Left :=  btnAll.Lef t + btnAll .Width + 1 ;
  5553     btnPast. Left := bt nFuture.Le ft + btnFu ture.Width  + 1;
  5554     btnAdmis sions.Left  := btnPas t.Left + ( btnAdmissi ons.Width  * 2) + 1;
  5555   //  btnAdm issions.Le ft := btnP ast.Left +  btnAdmiss ions.Width  + 10;                  // CodeC R708 rpk 8 /27/2015
  5556   //  btnSor tAdmin.Lef t := btnAd missions.L eft + btnA dmissions. Width + 10 ;            // CodeC R708 rpk 8 /27/2015
  5557  
  5558     //health  Summaries
  5559     Label18. Font := Pa nel1.Font;
  5560     Label18. Height :=  (Panel1.Fo nt.Height  * -1) + 2;
  5561     ButtonRD V.Height : = (Panel1. Font.Heigh t * -1) +  8;
  5562     ButtonRD V.Top := P anelHSRepo rt.Height  - ButtonRD V.Height;
  5563     ComboBox HSSections .Font := P anel1.Font ;
  5564     ComboBox HSSections .Height :=  (Panel1.F ont.Height  * -1) + 8 ;
  5565     ComboBox HSSections .Left := L abel18.Lef t + Label1 8.Width +  8;
  5566     ComboBox HSSections .Width :=  PanelHSRep ort.Width  - ComboBox HSSections .Left - 8;
  5567     Tab95Con trol2.Top  := ComboBo xHSSection s.Top + Co mboBoxHSSe ctions.Hei ght + 8;
  5568     Tab95Con trol2.Heig ht := Butt onRDV.Top  - Tab95Con trol2.Top  - 1;
  5569     //ORHeal thSummaryU serList.He ight:=Pane l4.Height- btnAdHoc.H eight-4;
  5570     panel9.h eight := p anel4.heig ht - 26;
  5571  
  5572     //VocReh ab tab - A dded resiz ing Patch1 97 JRL 2/2 /17
  5573     CenterWi dth := pnl VocRehab.W idth div 2 ;
  5574     btnVRAdd NewRequest .Top := pn lVocRehab. Height - 5 0;
  5575     btnVRAdd NewRequest .Left := C enterWidth  - 100 - b tnVRAddNew Request.Wi dth;
  5576     btnVREdi tRequest.T op := pnlV ocRehab.He ight - 50;
  5577     btnVREdi tRequest.L eft := Cen terWidth +  100;
  5578     lbVocReh ab.Height  := pnlVocR ehab.Heigh t - 145;
  5579     edtHeade r.Left :=  CenterWidt h - (edtHe ader.Width  div 2);
  5580     lbVocReh ab.Left :=  CenterWid th - (lbVo cRehab.Wid th div 2);
  5581     edtColum nHeader.Le ft := lbVo cRehab.Lef t + 7;
  5582     
  5583     //Other  Stuff
  5584     PanelRep ortChoice2 .Top := (( frmMain.He ight - Pan elReportCh oice2.Heig ht) Div 2)  - 32;
  5585     PanelRep ortChoice2 .Left := ( frmMain.Wi dth - Pane lReportCho ice2.Width ) Div 2;
  5586  
  5587     //This w as the CAP RI logo on  the deskt op
  5588     Panel3.T op := ((fr mMain.Heig ht - Panel 3.Height)  Div 2) - 3 2;
  5589     Panel3.L eft := (fr mMain.Widt h - Panel3 .Width) Di v 2;
  5590  
  5591     PanelRem oteData.To p := ((frm Main.Heigh t - PanelR emoteData. Height) Di v 2) - 32;
  5592     PanelRem oteData.Le ft := (frm Main.Width  - PanelRe moteData.W idth) Div  2;
  5593  
  5594     //DemoGr aphicMemo. Left:=(frm Main.Width -636) div  2;
  5595     //DemoGr aphicMemo. Height:=Ta bbedNotebo ok1.Height -28;
  5596  
  5597     //Button 3.Top:=Tab bedNoteboo k1.Height- 72;
  5598     //Button 3.Top:=Pag e95Control 1.Height-8 0;
  5599     //Button 4.Top:=Pag e95Control 1.Height-8 0;
  5600     //Button 5.Top:=Pag e95Control 1.Height-8 0;
  5601     //Button 1.Top:=Pag e95Control 1.Height-8 0;
  5602     //Button 6.Top:=Pag e95Control 1.Height-8 0;
  5603     //Button 11.Top:=Pa ge95Contro l1.Height- 80;
  5604     //Button 12.Top:=Pa ge95Contro l1.Height- 80;
  5605     //PanelD ocs.Height :=Page95Co ntrol1.Hei ght-104;
  5606     //Button 10.Top:=Pa ge95Contro l1.Height- 56;
  5607     //Button 2.Top:=Pag e95Control 1.Height-5 6;
  5608     //Button 12a.Top:=P age95Contr ol1.Height -56;
  5609     //Button 4a.Top:=Pa ge95Contro l1.Height- 56;
  5610     //Button 3a.Top:=Pa ge95Contro l1.Height- 56;
  5611   End;
  5612  
  5613   Procedure  TfrmMain.b tnAllClick (Sender: T Object);
  5614   //var
  5615   //  strLis t: TString List;
  5616   Begin
  5617     If ANURe moteProced ureCallInP rogress =  True Then
  5618       exit;
  5619  
  5620     AnimateL ogo(True);
  5621     StatusBa rLoadPt.Ca ption := ' Download a ll appoint ments.';
  5622     StatusBa rLoadPt.Re paint;
  5623     Applicat ion.Proces smessages;
  5624     lblApptS tatus.Capt ion := 'Al l Appointm ents';
  5625     frmMain. RPCBroker1 .Results.C lear;
  5626     RPCBroke r1.RemoteP rocedure : = 'DVBAB A PPOINTMENT  LIST';
  5627     RPCBroke r1.Param[0 ].Value :=  PatientIE N;
  5628     RPCBroke r1.Param[0 ].PType :=  literal;
  5629     RPCBroke r1.Param[1 ].Value :=  'A';                                                  //A=All ap pt. F=Futu re appt. P =Past appt .
  5630     RPCBroke r1.Param[1 ].PType :=  literal;
  5631     RPCBroke rCall;
  5632     Try
  5633       RPCBro ker1.Call;
  5634     Except
  5635       On EBr okerError  Do
  5636       Begin
  5637         ANUR emoteProce dureCallIn Progress : = False;
  5638         Anim ateLogo(Fa lse);
  5639         Stat usBarLoadP t.Caption  := 'RPC DV BAB APPOIN TMENT LIST  could not  be access ed!';
  5640         Stat usBarLoadP t.Repaint;
  5641         Appl ication.Pr ocessmessa ges;
  5642         Show MessageCAP RI('DVBAB  APPOINTMEN T LIST cou ld not be  accessed!' );
  5643       End;
  5644     End;
  5645  
  5646     //Begin  Build Repo rt
  5647     ANURemot eProcedure CallInProg ress := tr ue;
  5648     MemoAppo intments.L ines.Clear ;
  5649     screen.c ursor := c rHourglass ;
  5650  
  5651     MemoAppo intments.S etSelTextB uf(RPCBrok er1.Result s.GetText) ;
  5652     { strLis t := TStri ngList.Cre ate;                                                     // CodeC R708 rpk 5 /19/2015
  5653     try                                                                                   // CodeCR7 08 rpk 5/1 9/2015
  5654       strLis t.Assign(R PCBroker1. Results);                                              // CodeCR7 08 rpk 5/1 9/2015
  5655       strLis t.CustomSo rt(@SortAp pointments ByDate);                                    // CodeCR7 08 rpk 5/1 9/2015
  5656       MemoAp pointments .Lines.Ass ign(strLis t);                                         // CodeCR7 08 rpk 5/1 9/2015
  5657     finally                                                                               // CodeCR7 08 rpk 5/1 9/2015
  5658       strLis t.Free;                                                                      // CodeCR7 08 rpk 5/1 9/2015
  5659     end; }//  CodeCR708  rpk 5/19/ 2015
  5660  
  5661     screen.c ursor := c rDefault;
  5662     MemoAppo intments.V isible :=  True;
  5663     MemoAppo intments.S elStart :=  0;
  5664     MemoAppo intments.S elLength : = 0;
  5665  
  5666     if IsSet FocusValid (MemoAppoi ntments) t hen
  5667       MemoAp pointments .SetFocus;
  5668  
  5669     ANURemot eProcedure CallinProg ress := Fa lse;
  5670     AnimateL ogo(False) ;
  5671     StatusBa rLoadPt.Ca ption := ' Ready.';
  5672     StatusBa rLoadPt.Re paint;
  5673     Invalida te;                                                                          // CodeCR7 08 rpk 7/1 0/2015
  5674     Applicat ion.Proces smessages;
  5675     //End Of  Build Rep ort
  5676  
  5677   End;                                                                                    // btnAllC lick
  5678  
  5679   Procedure  TfrmMain.b tnFutureCl ick(Sender : TObject) ;
  5680   //var
  5681   //  strLis t: TString List;
  5682   Begin
  5683     If ANURe moteProced ureCallInP rogress =  True Then
  5684       exit;
  5685  
  5686     AnimateL ogo(True);
  5687     StatusBa rLoadPt.Ca ption := ' Download f uture appo intments.' ;
  5688     StatusBa rLoadPt.Re paint;
  5689     Applicat ion.Proces smessages;
  5690     lblApptS tatus.Capt ion := 'Fu ture Appoi ntments';
  5691     frmMain. RPCBroker1 .Results.C lear;
  5692     RPCBroke r1.RemoteP rocedure : = 'DVBAB A PPOINTMENT  LIST';
  5693     RPCBroke r1.Param[0 ].Value :=  PatientIE N;
  5694     RPCBroke r1.Param[0 ].PType :=  literal;
  5695     RPCBroke r1.Param[1 ].Value :=  'F';                                                  //A=All ap pt. F=Futu re appt. P =Past appt .
  5696     RPCBroke r1.Param[1 ].PType :=  literal;
  5697     RPCBroke rCall;
  5698     Try
  5699       RPCBro ker1.Call;
  5700     Except
  5701       On EBr okerError  Do
  5702       Begin
  5703         ANUR emoteProce dureCallIn Progress : = False;
  5704         Anim ateLogo(Fa lse);
  5705         Stat usBarLoadP t.Caption  := 'RPC DV BAB APPOIN TMENT LIST  could not  be access ed!';
  5706         Stat usBarLoadP t.Repaint;
  5707         Appl ication.Pr ocessmessa ges;
  5708         Show MessageCAP RI('DVBAB  APPOINTMEN T LIST cou ld not be  accessed!' );
  5709       End;
  5710     End;
  5711     //Begin  Build Repo rt
  5712     ANURemot eProcedure CallInProg ress := tr ue;
  5713     MemoAppo intments.L ines.Clear ;
  5714     screen.c ursor := c rHourglass ;
  5715  
  5716     MemoAppo intments.S etSelTextB uf(RPCBrok er1.Result s.GetText) ;
  5717     { strLis t := TStri ngList.Cre ate;                                                     // CodeC R708 rpk 5 /19/2015
  5718     try                                                                                   // CodeCR7 08 rpk 5/1 9/2015
  5719       strLis t.Assign(R PCBroker1. Results);                                              // CodeCR7 08 rpk 5/1 9/2015
  5720       strLis t.CustomSo rt(@SortAp pointments ByDate);                                    // CodeCR7 08 rpk 5/1 9/2015
  5721       MemoAp pointments .Lines.Ass ign(strLis t);                                         // CodeCR7 08 rpk 5/1 9/2015
  5722     finally                                                                               // CodeCR7 08 rpk 5/1 9/2015
  5723       strLis t.Free;                                                                      // CodeCR7 08 rpk 5/1 9/2015
  5724     end; }//  CodeCR708  rpk 5/19/ 2015
  5725  
  5726     screen.c ursor := c rDefault;
  5727     MemoAppo intments.V isible :=  True;
  5728     MemoAppo intments.S elStart :=  0;
  5729     MemoAppo intments.S elLength : = 0;
  5730     Try
  5731     MemoAppo intments.S etFocus Ex cept
  5732     End;
  5733     ANURemot eProcedure CallinProg ress := Fa lse;
  5734     AnimateL ogo(False) ;
  5735     StatusBa rLoadPt.Ca ption := ' Ready.';
  5736     StatusBa rLoadPt.Re paint;
  5737     Invalida te;                                                                          // CodeCR7 08 rpk 7/1 0/2015
  5738     Applicat ion.Proces smessages;
  5739     //End Of  Build Rep ort
  5740  
  5741   End;                                                                                    // btnFutu reClick
  5742  
  5743   Procedure  TfrmMain.b tnDocsRefr eshClick(S ender: TOb ject);
  5744   Begin
  5745     MemoDocs .Lines.Add ('Please s elect the  type of do cument you  wish to b rowse...') ;
  5746     lstDocs. Items.Clea r;
  5747   End;
  5748  
  5749   Procedure  TfrmMain.l stDocsClic k(Sender:  TObject);
  5750   const
  5751     STR_Mult ipleSelect ed = 'Mult iple docum ents are s elected.';                       //-MER Cod eCR126 7/2 010
  5752   Var
  5753     anuapptp ointer: St ring;
  5754     anudivis ion: Strin g;
  5755     anuinsti tution: St ring;
  5756     counter:  integer;
  5757     drugbuff er: String ;
  5758     drugclas s: String;
  5759     drugcoun t: integer ;
  5760     drugline s: integer ;
  5761     druglook up: String ;
  5762     dt: Stri ng;
  5763     fmdateno w: String;
  5764     fmdatepa st: String ;
  5765     foundrep ortflag: b oolean;
  5766     inX: lon gint;
  5767     line: St ring;
  5768     medbuffe r: ansistr ing;
  5769     name: St ring;
  5770     quickloo kup: tstri nglist;
  5771     resultsb uffer: tst ringlist;
  5772     RPCParam s: TParams ;
  5773     whichlin e: integer ;
  5774     x: longi nt;
  5775     xx: inte ger;
  5776     yy: inte ger;
  5777     zz: inte ger;
  5778     DisplayG rpIEN: Str ing;
  5779   Begin
  5780     // if mu ltiple doc uments are  selected,  don't dis play a doc ument -MER  CodeCR126  7/2010
  5781     if (lstD ocs.SelCou nt > 1) th en begin
  5782       if (Po s(STR_Mult ipleSelect ed, memoDo cs.Lines[0 ]) = 0) th en begin
  5783         memo Docs.Lines .Clear;
  5784         memo Docs.Lines .Add(STR_M ultipleSel ected);
  5785       end;
  5786       exit;
  5787     end;
  5788     inX := 0 ;
  5789     If ANURe moteProced ureCallInP rogress =  True Then
  5790       exit;
  5791   {  RPCBrok er1.Remote Procedure  := 'ORWU D T';
  5792     RPCBroke r1.Param[1 ].Value :=  'NOW';
  5793     RPCBroke r1.Param[1 ].PType :=  literal;
  5794     Try
  5795       RPCBro ker1.Call; }
  5796     //test d ynamic RPC  parameter s
  5797     RPCParam s := TPara ms.Create( nil);
  5798     RPCParam s[1].Value  := 'NOW';
  5799     RPCParam s[1].PType  := litera l;
  5800     try
  5801       try
  5802         if R PCBroker1. CallServer ('ORWU DT' , RPCParam s) and
  5803           (R PCBroker1. Results.Co unt > 0) t hen
  5804           fm datenow :=  RPCBroker 1.Results[ 0];
  5805       Except
  5806         On E BrokerErro r Do
  5807         Begi n
  5808           AN URemotePro cedureCall InProgress  := False;
  5809           An imateLogo( False);
  5810           St atusBarLoa dPt.Captio n := 'RPC  ORWU DT co uld not be  accessed! ';
  5811           St atusBarLoa dPt.Repain t;
  5812           Ap plication. Processmes sages;
  5813           Sh owMessageC APRI('ORWU  DT could  not be acc essed!');
  5814         End;
  5815       End;
  5816     finally
  5817       FreeAn dNil(RPCPa rams);
  5818     end;
  5819  
  5820     If formR eportBuild er <> Nil  Then
  5821       If dvb az = 0 The n
  5822         Form ReportBuil der.ORbtnA ddCurrent. Enabled :=  True;
  5823  
  5824     AnimateL ogo(True);
  5825     StatusBa rLoadPt.Ca ption := ' Downloadin g clinical  document. ';
  5826     StatusBa rLoadPt.Re paint;
  5827     Applicat ion.Proces smessages;
  5828     If (DocT ype = 'PRO BLEM LIST' ) Then
  5829     Begin
  5830       RPCBro ker1.Remot eProcedure  := 'ORQQP L PROBLEM  LIST';
  5831       RPCBro ker1.Param [1].Value  := Patient IEN;                                        // Patient  IEN
  5832       RPCBro ker1.Param [1].PType  := literal ;
  5833       If lst Docs.ItemI ndex = 0 T hen
  5834         RPCB roker1.Par am[2].Valu e := 'A';                                              // Both Ac tive and I nactive
  5835       If lst Docs.ItemI ndex = 1 T hen
  5836         RPCB roker1.Par am[2].Valu e := 'I';                                              // Both Ac tive and I nactive
  5837       If lst Docs.ItemI ndex = 2 T hen
  5838         RPCB roker1.Par am[2].Valu e := 'B';                                              // Both Ac tive and I nactive
  5839       RPCBro ker1.Param [2].PType  := literal ;
  5840       Try
  5841         RPCB roker1.Cal l;
  5842       Except
  5843         On E BrokerErro r Do
  5844         Begi n
  5845           AN URemotePro cedureCall InProgress  := False;
  5846           An imateLogo( False);
  5847           St atusBarLoa dPt.Captio n := 'ORQQ PL PROBLEM  LIST coul d not be a ccessed!';
  5848           St atusBarLoa dPt.Repain t;
  5849           Ap plication. Processmes sages;
  5850           Sh owMessageC APRI('ORQQ PL PROBLEM  LIST coul d not be a ccessed!') ;
  5851         End
  5852       End;
  5853       memoDo cs.Visible  := False;
  5854       memoDo cs.Lines.C lear;
  5855       If RPC Broker1.Re sults.Coun t = 0 Then
  5856       Begin
  5857         Anim ateLogo(Fa lse);
  5858         Stat usBarLoadP t.Caption  := 'Ready. ';
  5859         Stat usBarLoadP t.Repaint;
  5860         Appl ication.Pr ocessmessa ges;
  5861         exit ;
  5862       End;
  5863       If RPC Broker1.Re sults[0] =  '0' Then
  5864       Begin
  5865         Memo Docs.Lines .Add('');
  5866         Memo Docs.Lines .Add('No p roblems fo und.');
  5867       End;
  5868       For x  := 1 To St rToInt(RPC Broker1.Re sults[0])  Do
  5869       Begin
  5870         line  := RPCBro ker1.Resul ts[x];
  5871         name  := Piece( line, '^',  12);
  5872         dt : = Piece(li ne, '^', 5 );
  5873         If n ame <> ''  Then
  5874           Na me := Copy (name, pos (';', name ) + 1, 20) ;
  5875         If d t <> '' Th en
  5876           me moDocs.Lin es.Add(Pie ce(line, ' ^', 2) + '   ' + Piec e(line, '^ ', 3) + '   ' + name  + '  Onset : ' + fmDa tetimeConv ert(dt));
  5877         If d t = '' The n
  5878           me moDocs.Lin es.Add(Pie ce(line, ' ^', 2) + '   ' + Piec e(line, '^ ', 3) + '   ' + name) ;
  5879       End;
  5880       MemoDo cs.Visible  := True;
  5881       MemoDo cs.SelStar t := 0;
  5882       MemoDo cs.SelLeng th := 0;                                                          // ET 0603 29 try lst Docs.SetFo cus except  end;
  5883     End;
  5884     If (DocT ype = 'ORD ERS') Then                                                        // Order S ummary
  5885     Begin
  5886       frmMai n.RPCBroke r1.Results .Clear;
  5887       RPCBro ker1.Remot eProcedure  := 'ORWRP  REPORT TE XT';
  5888       RPCBro ker1.Param [1].Value  := Patient IEN;                                        // Patient  IEN
  5889       RPCBro ker1.Param [1].PType  := literal ;
  5890       RPCBro ker1.Param [2].Value  := '11';                                               // Order S ummary
  5891       RPCBro ker1.Param [2].PType  := literal ;
  5892       RPCBro ker1.Param [3].Value  := '';
  5893       RPCBro ker1.Param [3].PType  := literal ;
  5894       If lst Docs.ItemI ndex = 0 T hen
  5895         RPCB roker1.Par am[4].Valu e := '0';
  5896       If lst Docs.ItemI ndex = 1 T hen
  5897         RPCB roker1.Par am[4].Valu e := '7';
  5898       If lst Docs.ItemI ndex = 2 T hen
  5899         RPCB roker1.Par am[4].Valu e := '14';
  5900       If lst Docs.ItemI ndex = 3 T hen
  5901         RPCB roker1.Par am[4].Valu e := '30';
  5902       If lst Docs.ItemI ndex = 4 T hen
  5903         RPCB roker1.Par am[4].Valu e := '180' ;
  5904       If lst Docs.ItemI ndex = 5 T hen
  5905         RPCB roker1.Par am[4].Valu e := '365' ;
  5906       If lst Docs.ItemI ndex = 6 T hen
  5907         RPCB roker1.Par am[4].Valu e := '730' ;
  5908       If lst Docs.ItemI ndex = 7 T hen
  5909         RPCB roker1.Par am[4].Valu e := '1825 ';
  5910       If lst Docs.ItemI ndex = 8 T hen
  5911         RPCB roker1.Par am[4].Valu e := '9999 9';
  5912       RPCBro ker1.Param [4].PType  := literal ;
  5913       RPCBro ker1.Param [5].Value  := '';
  5914       RPCBro ker1.Param [5].PType  := literal ;
  5915       Try
  5916         RPCB roker1.Cal l;
  5917       Except
  5918         On E BrokerErro r Do
  5919         Begi n
  5920           AN URemotePro cedureCall InProgress  := False;
  5921           An imateLogo( False);
  5922           St atusBarLoa dPt.Captio n := 'RPC  ORWRP REPO RT TEXT co uld not be  accessed! ';
  5923           St atusBarLoa dPt.Repain t;
  5924           Ap plication. Processmes sages;
  5925           Sh owMessageC APRI('RPC  ORWRP REPO RT TEXT co uld not be  accessed! ');
  5926         End
  5927       End;
  5928       memoDo cs.Visible  := False;
  5929       memoDo cs.Lines.C lear;
  5930       MemoDo cs.SetSelT extBuf(RPC Broker1.Re sults.GetT ext);
  5931       If Mem oDocs.Line s.Count =  0 Then
  5932       Begin
  5933         Memo Docs.Lines .Add('');
  5934         Memo Docs.Lines .Add('No o rders foun d.');
  5935       End;
  5936       MemoDo cs.Lines.A dd('');
  5937       MemoDo cs.Visible  := True;
  5938       MemoDo cs.SelStar t := 0;
  5939       MemoDo cs.SelLeng th := 0;                                                          // ET 0603 29 try lst Docs.SetFo cus except  end;
  5940     End;
  5941     If (DocT ype = 'NUT ASSESS') T hen                                                    // Nutriti onal Asses sment
  5942     Begin
  5943       If CPR SVersion =  'V16' The n
  5944       Begin
  5945         RPCB roker1.Rem oteProcedu re := 'ORW RP REPORT  TEXT';
  5946         RPCB roker1.Par am[1].Valu e := Patie ntIEN;                                      // Patient  IEN
  5947         RPCB roker1.Par am[1].PTyp e := liter al;
  5948         RPCB roker1.Par am[2].Valu e := '17:N UTRITIONAL  ASSESSMEN T~DIETNS;O RDV08';    // Nutriti on assessm ent
  5949         RPCB roker1.Par am[2].PTyp e := liter al;
  5950         RPCB roker1.Par am[3].Valu e := '';
  5951         RPCB roker1.Par am[3].PTyp e := liter al;
  5952         RPCB roker1.Par am[4].Valu e := '9999 9';
  5953         RPCB roker1.Par am[4].PTyp e := liter al;
  5954         RPCB roker1.Par am[5].Valu e := '';                                               //lstDocs. Items[lstD ocs.ItemIn dex];
  5955         RPCB roker1.Par am[5].PTyp e := liter al;
  5956         RPCB roker1.Par am[6].Valu e := '0';
  5957         RPCB roker1.Par am[6].PTyp e := liter al;
  5958         RPCB roker1.Par am[7].Valu e := '0';
  5959         RPCB roker1.Par am[7].PTyp e := liter al;
  5960         Try
  5961           RP CBroker1.C all;
  5962         Exce pt
  5963           On  EBrokerEr ror Do
  5964           Be gin
  5965              ANURemoteP rocedureCa llInProgre ss := Fals e;
  5966              AnimateLog o(False);
  5967              StatusBarL oadPt.Capt ion := 'RP C ORWRP RE PORT TEXT  could not  be accesse d!';
  5968              StatusBarL oadPt.Repa int;
  5969              Applicatio n.Processm essages;
  5970              ShowMessag eCAPRI('RP C ORWRP RE PORT TEXT  could not  be accesse d!');
  5971           En d
  5972         End;
  5973         memo Docs.Lines .Clear;
  5974         Memo Docs.Visib le := Fals e;
  5975         Coun ter := -1;
  5976  
  5977         // i f not sear ching, the n use exis ting code  to bring u p data for  each
  5978         // d ocument se lected
  5979         If E ditSearchP N.Text = ' ' Then                                                 // CodeCR6 96 JRL 4/1 0/15
  5980         begi n                                                                            // CodeCR6 96 JRL 4/1 0/15
  5981           If  RPCBroker 1.Results. Count > 0  Then
  5982              For yy :=  0 To RPCBr oker1.Resu lts.Count  - 1 Do
  5983              Begin
  5984                If Piece (RPCBroker 1.Results[ yy], '^',  1) = '1' T hen
  5985                  inc(co unter);
  5986                If Count er = lstDo cs.ItemInd ex Then
  5987                  If Pie ce(RPCBrok er1.Result s[yy], '^' , 1) = '3'  Then
  5988                    memo Docs.Lines .Add(Piece (RPCBroker 1.Results[ yy], '^',  2));
  5989              End;
  5990         end                                                                               // CodeCR6 96 JRL 4/1 0/15
  5991         else                                                                              // if sear ching, the n check th e values o f the orig inal listb ox       / / CodeCX69 6 JRL 4/10 /15
  5992               // contai ning all d ocuments a gainst the  ones left  in the sm aller
  5993               // search  results.   This is n eeded beca use this p articular  RPC
  5994               // return s all text  results i n one call  versus re turning on e document
  5995               // as it  is selecte d on the l eft.
  5996         begi n                                                                            // CodeCX6 96 JRL 4/1 0/15
  5997           If  RPCBroker 1.Results. Count > 0  Then                                        // CodeCX6 96 JRL 4/1 0/15
  5998              For yy :=  0 To RPCBr oker1.Resu lts.Count  - 1 Do                           // CodeCX6 96 JRL 4/1 0/15
  5999              Begin                                                                        // CodeCX6 96 JRL 4/1 0/15
  6000                If Piece (RPCBroker 1.Results[ yy], '^',  1) = '1' T hen                   // CodeCX6 96 JRL 4/1 0/15
  6001                  inc(co unter);                                                           // CodeCX6 96 JRL 4/1 0/15
  6002                if lstDo cs.Items[l stDocs.Ite mIndex] =  lbNUTASSES SSearchInd ex.Items[C ounter] th en // Code CX696 JRL  4/10/15
  6003                  If Pie ce(RPCBrok er1.Result s[yy], '^' , 1) = '3'  Then                 // CodeCX6 96 JRL 4/1 0/15
  6004                    memo Docs.Lines .Add(Piece (RPCBroker 1.Results[ yy], '^',  2));       // CodeCX6 96 JRL 4/1 0/15
  6005              End;                                                                         // CodeCX6 96 JRL 4/1 0/15
  6006         end;                                                                              // CodeCX6 96 JRL 4/1 0/15
  6007         Memo Docs.Lines .Add('');
  6008         Memo Docs.Visib le := True ;
  6009         Memo Docs.SelSt art := 0;
  6010         Memo Docs.SelLe ngth := 0;                                                        // ET 0603 29 try lst Docs.SetFo cus except  end;
  6011         If S earchRunni ng = 0 The n                                                      //CodeCR69 6 JRL 4/8/ 15
  6012           If  EditSearc hPN.Text < > '' Then                                              //CodeCR69 6 JRL 4/8/ 15
  6013           Be gin                                                                          //CodeCR69 6 JRL 4/8/ 15
  6014              LastSearch FoundAt :=  0;                                                    //CodeCR69 6 JRL 4/8/ 15
  6015              buttonSear chClick(ap plication) ;                                           //CodeCR69 6 JRL 4/8/ 15
  6016           En d;                                                                           // end of  V15 CPRS
  6017       End;                                                                                // end of  V16 CPRS
  6018       If CPR SVersion =  'V15' The n
  6019       Begin
  6020         RPCB roker1.Rem oteProcedu re := 'ORW RP REPORT  TEXT';
  6021         RPCB roker1.Par am[1].Valu e := Patie ntIEN;                                      // Patient  IEN
  6022         RPCB roker1.Par am[1].PTyp e := liter al;
  6023         RPCB roker1.Par am[2].Valu e := '17';                                             // Nutriti on assessm ent
  6024         RPCB roker1.Par am[2].PTyp e := liter al;
  6025         RPCB roker1.Par am[3].Valu e := '';
  6026         RPCB roker1.Par am[3].PTyp e := liter al;
  6027         RPCB roker1.Par am[4].Valu e := '';
  6028         RPCB roker1.Par am[4].PTyp e := liter al;
  6029         RPCB roker1.Par am[5].Valu e := lstDo cs.Items[l stDocs.Ite mIndex];
  6030         RPCB roker1.Par am[5].PTyp e := liter al;
  6031         Try
  6032           RP CBroker1.C all;
  6033         Exce pt
  6034           On  EBrokerEr ror Do
  6035           Be gin
  6036              ANURemoteP rocedureCa llInProgre ss := Fals e;
  6037              AnimateLog o(False);
  6038              StatusBarL oadPt.Capt ion := 'RP C ORWRP RE PORT TEXT  could not  be accesse d!';
  6039              StatusBarL oadPt.Repa int;
  6040              Applicatio n.Processm essages;
  6041              ShowMessag eCAPRI('RP C ORWRP RE PORT TEXT  could not  be accesse d!');
  6042           En d
  6043         End;
  6044         memo Docs.Visib le := Fals e;
  6045         memo Docs.Lines .Clear;
  6046         Memo Docs.SetSe lTextBuf(R PCBroker1. Results.Ge tText);
  6047         Memo Docs.Lines .Add('');
  6048         Memo Docs.Visib le := True ;
  6049         Memo Docs.SelSt art := 1;                                                         //??
  6050         Memo Docs.SelLe ngth := 1;                                                        //??                                                 / / ET 06032 9 try lstD ocs.SetFoc us except  end;
  6051         Memo Docs.SelSt art := 0;
  6052         Memo Docs.SelLe ngth := 0;                                                        // ET 0603 29 try lst Docs.SetFo cus except  end;
  6053         If S earchRunni ng = 0 The n                                                      //CodeCR69 6 JRL 4/8/ 15
  6054           If  EditSearc hPN.Text < > '' Then                                              //CodeCR69 6 JRL 4/8/ 15
  6055           Be gin                                                                          //CodeCR69 6 JRL 4/8/ 15
  6056              LastSearch FoundAt :=  0;                                                    //CodeCR69 6 JRL 4/8/ 15
  6057              buttonSear chClick(ap plication) ;                                           //CodeCR69 6 JRL 4/8/ 15
  6058           En d;                                                                           // end of  V15 CPRS
  6059       End;
  6060     End;
  6061     If (DocT ype = 'PRO CEDURES')  Then
  6062     Begin
  6063       RPCBro ker1.Remot eProcedure  := 'ORWRP  REPORT TE XT';
  6064       RPCBro ker1.Param [1].Value  := Patient IEN;                                        // Patient  IEN
  6065       RPCBro ker1.Param [1].PType  := literal ;
  6066       RPCBro ker1.Param [2].Value  := '19';                                               // Procedu res
  6067       RPCBro ker1.Param [2].PType  := literal ;
  6068       RPCBro ker1.Param [3].Value  := '';
  6069       RPCBro ker1.Param [3].PType  := literal ;
  6070       RPCBro ker1.Param [4].Value  := '';
  6071       RPCBro ker1.Param [4].PType  := literal ;
  6072       RPCBro ker1.Param [5].Value  := Piece(l stDocs.Ite ms[lstDocs .ItemIndex ], '^', 2) ;
  6073       RPCBro ker1.Param [5].PType  := literal ;
  6074       RPCBro ker1.Param [6].Value  := '0';
  6075       RPCBro ker1.Param [6].PType  := literal ;
  6076       RPCBro ker1.Param [7].Value  := '0';
  6077       RPCBro ker1.Param [7].PType  := literal ;
  6078       Try
  6079         RPCB roker1.Cal l;
  6080       Except
  6081         On E BrokerErro r Do
  6082         Begi n
  6083           AN URemotePro cedureCall InProgress  := False;
  6084           An imateLogo( False);
  6085           St atusBarLoa dPt.Captio n := 'RPC  ORWRP REPO RT TEXT co uld not be  accessed! ';
  6086           St atusBarLoa dPt.Repain t;
  6087           Ap plication. Processmes sages;
  6088           Sh owMessageC APRI('RPC  ORWRP REPO RT TEXT co uld not be  accessed! ');
  6089         End
  6090       End;
  6091       memoDo cs.Visible  := False;
  6092       memoDo cs.Lines.C lear;
  6093       MemoDo cs.SetSelT extBuf(RPC Broker1.Re sults.GetT ext);
  6094       MemoDo cs.Lines.A dd('');
  6095       MemoDo cs.Visible  := True;
  6096       MemoDo cs.SelStar t := 0;
  6097       MemoDo cs.SelLeng th := 0;                                                          // ET 0603 29  try ls tDocs.SetF ocus excep t end;
  6098       If Sea rchRunning  = 0 Then                                                         //CodeCR69 6 JRL 4/8/ 15
  6099         If E ditSearchP N.Text <>  '' Then                                                //CodeCR69 6 JRL 4/8/ 15
  6100         Begi n                                                                            //CodeCR69 6 JRL 4/8/ 15
  6101           La stSearchFo undAt := 0 ;                                                      //CodeCR69 6 JRL 4/8/ 15
  6102           bu ttonSearch Click(appl ication);                                              //CodeCR69 6 JRL 4/8/ 15
  6103         End;                                                                              //CodeCR69 6 JRL 4/8/ 15
  6104     End;
  6105     If (DocT ype = 'DIE T') Then
  6106     Begin
  6107       RPCBro ker1.Remot eProcedure  := 'ORWRP  REPORT TE XT';
  6108       RPCBro ker1.Param [1].Value  := Patient IEN;                                        // Patient  IEN
  6109       RPCBro ker1.Param [1].PType  := literal ;
  6110       RPCBro ker1.Param [2].Value  := '4';                                                // Dieteti c Report
  6111       RPCBro ker1.Param [2].PType  := literal ;
  6112       RPCBro ker1.Param [3].Value  := '';
  6113       RPCBro ker1.Param [3].PType  := literal ;
  6114       RPCBro ker1.Param [4].Value  := '';
  6115       RPCBro ker1.Param [4].PType  := literal ;
  6116       RPCBro ker1.Param [5].Value  := '';
  6117       RPCBro ker1.Param [5].PType  := literal ;
  6118       RPCBro ker1.Param [6].Value  := '0';
  6119       RPCBro ker1.Param [6].PType  := literal ;
  6120       RPCBro ker1.Param [7].Value  := '0';
  6121       RPCBro ker1.Param [7].PType  := literal ;
  6122       Try
  6123         RPCB roker1.Cal l;
  6124       Except
  6125         On E BrokerErro r Do
  6126         Begi n
  6127           AN URemotePro cedureCall InProgress  := False;
  6128           An imateLogo( False);
  6129           St atusBarLoa dPt.Captio n := 'RPC  ORWRP REPO RT TEXT co uld not be  accessed! ';
  6130           St atusBarLoa dPt.Repain t;
  6131           Ap plication. Processmes sages;
  6132           Sh owMessageC APRI('RPC  ORWRP REPO RT TEXT co uld not be  accessed! ');
  6133         End
  6134       End;
  6135       memoDo cs.Visible  := False;
  6136       memoDo cs.Lines.C lear;
  6137       MemoDo cs.SetSelT extBuf(RPC Broker1.Re sults.GetT ext);
  6138       MemoDo cs.Lines.A dd('');
  6139       MemoDo cs.Visible  := True;
  6140       MemoDo cs.SelStar t := 1;
  6141       MemoDo cs.SelLeng th := 1;                                                          // ET 0603 29 try lst Docs.SetFo cus except  end;
  6142       MemoDo cs.SelStar t := 0;
  6143       MemoDo cs.SelLeng th := 0;                                                          // ET 0603 29 try lst Docs.SetFo cus except  end;
  6144     End;
  6145     If (DocT ype = 'MED S') Then
  6146     Begin
  6147       (*
  6148           If  Pos('DATE ',Uppercas e(lstDocs. Items[lstD ocs.ItemIn dex]))>0 t hen begin
  6149              AnimateLog o(False);
  6150              StatusBarL oadPt.Capt ion:='Read y.'; Statu sBarLoadPt .Repaint;  Applicatio n.Processm essages;
  6151              ShowMessag eCAPRI('UN DER CONSTR UCTION:  T he date ra nge option  will be a vailable i n the next  version o f CAPRI.') ;
  6152              exit;
  6153           en d;
  6154           *)
  6155       If lst Docs.ItemI ndex = 0 T hen
  6156       Begin                                                                               // Action  Profile
  6157         RPCB roker1.Rem oteProcedu re := 'ORW RP REPORT  TEXT';
  6158         RPCB roker1.Par am[1].Valu e := Patie ntIEN;                                      // Patient  IEN
  6159         RPCB roker1.Par am[1].PTyp e := liter al;
  6160         RPCB roker1.Par am[2].Valu e := '13:O UTPATIENT  RX PROFILE ~;;0';                // Outpati ent Med Pr ofile
  6161         RPCB roker1.Par am[2].PTyp e := liter al;
  6162         RPCB roker1.Par am[3].Valu e := '';
  6163         RPCB roker1.Par am[3].PTyp e := liter al;
  6164         RPCB roker1.Par am[4].Valu e := '';
  6165         RPCB roker1.Par am[4].PTyp e := liter al;
  6166         RPCB roker1.Par am[5].Valu e := '';
  6167         RPCB roker1.Par am[5].PTyp e := liter al;
  6168         RPCB roker1.Par am[6].Valu e := '0';
  6169         RPCB roker1.Par am[6].PTyp e := liter al;
  6170         RPCB roker1.Par am[7].Valu e := '0';
  6171         RPCB roker1.Par am[7].PTyp e := liter al;
  6172         Try
  6173           RP CBroker1.C all;
  6174         Exce pt
  6175           On  EBrokerEr ror Do
  6176           Be gin
  6177              ANURemoteP rocedureCa llInProgre ss := Fals e;
  6178              AnimateLog o(False);
  6179              StatusBarL oadPt.Capt ion := 'RP C ORWRP RE PORT TEXT  could not  be accesse d!';
  6180              StatusBarL oadPt.Repa int;
  6181              Applicatio n.Processm essages;
  6182              ShowMessag eCAPRI('RP C ORWRP RE PORT TEXT  could not  be accesse d!');
  6183           En d
  6184         End;
  6185         memo Docs.Visib le := Fals e;
  6186         memo Docs.Lines .Clear;
  6187         Memo Docs.SetSe lTextBuf(R PCBroker1. Results.Ge tText);
  6188         Memo Docs.Lines .Add('');
  6189         Memo Docs.Visib le := True ;
  6190         Memo Docs.SelSt art := 0;
  6191         Memo Docs.SelLe ngth := 0;                                                        // ET 0603 29 try lst Docs.SetFo cus except  end;
  6192       End
  6193       Else
  6194         If l stDocs.Ite mIndex = 1 3 Then
  6195         Begi n
  6196           //  BCMA Repo rt
  6197           fo rmDateRang eShort :=  TFormDateR angeShort. Create(nil );
  6198           RP CParams :=  TParams.C reate(nil) ;
  6199           RP CParams[1] .Value :=  PatientIEN ;                                           // Patient  IEN
  6200           RP CParams[1] .PType :=  literal;
  6201           RP CParams[2] .Value :=  '22:MED AD MIN HISTOR Y (BCMA)~; ;0;10';
  6202           RP CParams[2] .PType :=  literal;
  6203           RP CParams[3] .Value :=  '';
  6204           RP CParams[3] .PType :=  literal;
  6205           RP CParams[4] .Value :=  '';
  6206           RP CParams[4] .PType :=  literal;
  6207           RP CParams[5] .Value :=  '';
  6208           RP CParams[5] .PType :=  literal;
  6209           Tr y
  6210              If formDat eRangeShor t.ShowModa l = mrCanc el Then ex it;
  6211              RPCParams[ 6].Value : = FloatToS tr(FormDat eRangeshor t.ORDateCo mboStart.F MDate); //  Date Rang e
  6212              RPCParams[ 6].PType : = literal;
  6213              RPCParams[ 7].Value : = FloatToS tr(FormDat eRangeshor t.ORDateCo mboStop.FM Date); //  Date Range
  6214              RPCParams[ 7].PType : = literal;
  6215              try
  6216                //RPCBro ker1.Call;
  6217                RPCBroke r1.CallSer ver('ORWRP  REPORT TE XT', RPCPa rams, True );
  6218              Except
  6219                On EBrok erError Do
  6220                Begin
  6221                  ANURem oteProcedu reCallInPr ogress :=  False;
  6222                  Animat eLogo(Fals e);
  6223                  Status BarLoadPt. Caption :=  'RPC ORWR P REPORT T EXT could  not be acc essed!';
  6224                  Status BarLoadPt. Repaint;
  6225                  Applic ation.Proc essmessage s;
  6226                  ShowMe ssageCAPRI ('RPC ORWR P REPORT T EXT could  not be acc essed!');
  6227                End;
  6228              End;
  6229           Fi nally
  6230              FreeAndNil (formDateR angeShort) ;
  6231              FreeAndNil (RPCParams );
  6232           En d;
  6233           If  RPCBroker 1.Results. Count = 0  Then
  6234           Be gin
  6235              AnimateLog o(False);
  6236              StatusBarL oadPt.Capt ion := 'Re ady.';
  6237              StatusBarL oadPt.Repa int;
  6238              Applicatio n.Processm essages;
  6239              If MemoDoc s.Lines.Co unt = 0 Th en
  6240              Begin
  6241                MemoDocs .Lines.Add ('');
  6242                MemoDocs .Lines.Add ('There is  no data f or the req uested sea rch criter ia.');
  6243              End;
  6244              exit;
  6245           En d;
  6246           me moDocs.Vis ible := Fa lse;
  6247           me moDocs.Lin es.Clear;
  6248           Me moDocs.Set SelTextBuf (RPCBroker 1.Results. GetText);
  6249         End
  6250         Else
  6251         Begi n                                                                            // Pull fr om Orders
  6252           RP CParams :=  TParams.C reate(nil) ;
  6253           tr y
  6254              RPCParams[ 1].Value : = PatientI EN;                                         // Patient  IEN
  6255              RPCParams[ 1].PType : = literal;
  6256  
  6257              case lstDo cs.ItemInd ex of
  6258                9..12: R PCParams[2 ].Value :=  '2^0';                                     // Active  Orders
  6259              else
  6260                RPCParam s[2].Value  := '1^0';                                             // All ord ers
  6261              end;
  6262              RPCParams[ 2].PType : = literal;
  6263  
  6264              case lstDo cs.ItemInd ex of                                                  //CodeCR17 8 - rpm 4/ 18/11
  6265                1, 2, 9:  begin                                                            // All Out patient
  6266                    Disp layGrpIEN  := GetDisp layGrpIEN( 'OUTPATIEN T MEDICATI ONS');
  6267                    if ( DisplayGrp IEN = '0')  or (Displ ayGrpIEN =  '') then
  6268                      Di splayGrpIE N := '4';                                              //default  to std rel ease value
  6269                  end;
  6270                3, 4, 10 : begin                                                           // All Inp atient
  6271                    Disp layGrpIEN  := GetDisp layGrpIEN( 'INPATIENT  MEDICATIO NS');
  6272                    if ( DisplayGrp IEN = '0')  or (Displ ayGrpIEN =  '') then
  6273                      Di splayGrpIE N := '3';                                              //default  to std rel ease value
  6274                  end;
  6275                5, 6, 11 : begin                                                           // All Inp atient Uni t Dose
  6276                    Disp layGrpIEN  := GetDisp layGrpIEN( 'UNIT DOSE  MEDICATIO NS');
  6277                    if ( DisplayGrp IEN = '0')  or (Displ ayGrpIEN =  '') then
  6278                      Di splayGrpIE N := '23';                                             //default  to std rel ease value
  6279                  end;
  6280                7, 8, 12 : begin                                                           // Active  Inpatient  IV
  6281                    Disp layGrpIEN  := GetDisp layGrpIEN( 'IV MEDICA TIONS');
  6282                    if ( DisplayGrp IEN = '0')  or (Displ ayGrpIEN =  '') then
  6283                      Di splayGrpIE N := '24';                                             //default  to std rel ease value
  6284                  end;
  6285              end;
  6286              RPCParams[ 3].Value : = DisplayG rpIEN;
  6287              RPCParams[ 3].PType : = literal;
  6288  
  6289              case lstDo cs.ItemInd ex of
  6290                2, 4, 6,  8:
  6291                  begin
  6292                    form DateRangeS hort := TF ormDateRan geShort.Cr eate(nil);
  6293                    try
  6294                      fo rmDateRang eShort.Sho wModal;
  6295                      RP CParams[4] .Value :=  FloatToStr (FormDateR angeshort. ORDateComb oStart.FMD ate); // D ate Range
  6296                      RP CParams[4] .PType :=  literal;
  6297                      RP CParams[5] .Value :=  FloatToStr (FormDateR angeshort. ORDateComb oStop.FMDa te); // Da te Range
  6298                      RP CParams[5] .PType :=  literal;
  6299                    fina lly
  6300                      Fr eeAndNil(f ormDateRan geShort);
  6301                    end;
  6302                  end
  6303              else
  6304                begin
  6305                  RPCPar ams[4].Val ue := '0';                                             //Start da te
  6306                  RPCPar ams[4].PTy pe := lite ral;
  6307                  RPCPar ams[5].Val ue := '0';                                             //Stop Dat e
  6308                  RPCPar ams[5].PTy pe := lite ral;
  6309                end;
  6310              end;
  6311              Try
  6312                //RPCBro ker1.Call;
  6313                RPCBroke r1.CallSer ver('ORWOR R AGET', R PCParams,  True);
  6314              Except
  6315                On EBrok erError Do
  6316                Begin
  6317                  ANURem oteProcedu reCallInPr ogress :=  False;
  6318                  Animat eLogo(Fals e);
  6319                  Status BarLoadPt. Caption :=  'RPC ORWO RR AGET co uld not be  accessed! ';
  6320                  Status BarLoadPt. Repaint;
  6321                  Applic ation.Proc essmessage s;
  6322                  ShowMe ssageCAPRI ('RPC ORWO RR AGET co uld not be  accessed! ');
  6323                End
  6324              End;
  6325           fi nally
  6326              FreeAndNil (RPCParams );
  6327           en d;
  6328  
  6329           me moDocs.Lin es.Clear;
  6330           //  Order lis t retrieve d.  Now gr ab order t ext for ea ch item
  6331           If  Piece(RPC Broker1.Re sults[0],  '^', 1) =  '0' Then
  6332           Be gin
  6333              AnimateLog o(False);
  6334              StatusBarL oadPt.Capt ion := 'Re ady.';
  6335              StatusBarL oadPt.Repa int;
  6336              Applicatio n.Processm essages;
  6337              If MemoDoc s.Lines.Co unt = 0 Th en
  6338              Begin
  6339                MemoDocs .Lines.Add ('');
  6340                MemoDocs .Lines.Add ('There is  no data f or the req uested sea rch criter ia.');
  6341              End;
  6342              exit;
  6343           En d;
  6344           me moDocs.Lin es.Clear;
  6345  
  6346           RP CParams :=  TParams.C reate(nil) ;
  6347           tr y
  6348              //RPCBroke r1.RemoteP rocedure : = 'ORWORR  GET4LST';
  6349              RPCParams[ 1].Value : = PatientI EN;                                         // Patient  IEN
  6350              RPCParams[ 1].PType : = literal;
  6351              RPCParams[ 2].Value : = '-1';
  6352              RPCParams[ 2].PType : = literal;
  6353              medbuffer  := '';
  6354              druglines  := StrToIn t(Piece(RP CBroker1.R esults[0],  '^', 1));
  6355              For x := 1  To drugli nes Do
  6356              Begin
  6357                // Set u p for brok er call
  6358                RPCParam s[3].Mult[ IntToStr(x )] := Piec e(RPCBroke r1.Results [x], '^',  1);
  6359                medbuffe r := medbu ffer + Pie ce(RPCPara ms[3].Mult [IntToStr( x)], ';',  1) + '^';
  6360              End;
  6361              RPCParams[ 3].PType : = list;
  6362              Try
  6363                //RPCBro ker1.Call;
  6364                RPCBroke r1.CallSer ver('ORWOR R GET4LST' , RPCParam s, True);
  6365              Except
  6366                On EBrok erError Do
  6367                Begin
  6368                  ANURem oteProcedu reCallInPr ogress :=  False;
  6369                  Animat eLogo(Fals e);
  6370                  Status BarLoadPt. Caption :=  'RPC ORWO RR AGET co uld not be  accessed! ';
  6371                  Status BarLoadPt. Repaint;
  6372                  Applic ation.Proc essmessage s;
  6373                  ShowMe ssageCAPRI ('RPC ORWO RR AGET co uld not be  accessed! ');
  6374                End
  6375              End;
  6376           fi nally
  6377              FreeAndNil (RPCParams );
  6378           en d;
  6379           If  RPCBroker 1.Results. Count = 0  Then
  6380           Be gin
  6381              AnimateLog o(False);
  6382              StatusBarL oadPt.Capt ion := 'Re ady.';
  6383              StatusBarL oadPt.Repa int;
  6384              Applicatio n.Processm essages;
  6385              If MemoDoc s.Lines.Co unt = 0 Th en
  6386              Begin
  6387                MemoDocs .Lines.Add ('');
  6388                MemoDocs .Lines.Add ('There is  no data f or the req uested sea rch criter ia.');
  6389              End;
  6390              exit;
  6391           En d;
  6392           Me moDocs.Vis ible := Fa lse;
  6393           re sultsbuffe r := tstri nglist.Cre ate;
  6394           qu icklookup  := tstring list.creat e;
  6395           re sultsbuffe r.Clear;
  6396           qu icklookup. clear;
  6397           Fo r x := 0 T o RPCBroke r1.Results .Count - 1  Do
  6398              resultsbuf fer.add(RP CBroker1.R esults[x]) ;
  6399  
  6400           dr ugcount :=  druglines ;
  6401           dr uglines :=  1;
  6402           wh ichline :=  0;
  6403           dr uglookup : = '';
  6404  
  6405           Fo r x := 0 T o resultsb uffer.Coun t - 1 Do
  6406           Be gin
  6407              inX := x;
  6408              Line := re sultsbuffe r[x];
  6409              If Line[1]  = '~' The n
  6410              Begin                                                                        // Order S tuff
  6411                If (lstD ocs.ItemIn dex = 1) O r (lstDocs .ItemIndex  = 2) Then
  6412                Begin                                                                      // Only do  this for  outpatient
  6413                  If dru glookup <>  '' Then
  6414                  Begin
  6415                    // T ake off "D ISCONTINUE " if appli cable
  6416                    If P os('DISCON TINUE ', U ppercase(D ruglookup) ) = 1 Then
  6417                    Begi n
  6418                      Dr ugLookup : = Copy(Dru gLookup, P os(' ', Dr ugLookup)  + 1, 99);
  6419                    End;
  6420                    // S trip off e verything  after "Qua ntity:"
  6421                    If P os('QUANTI TY: ', Upp ercase(Dru glookup))  > 1 Then
  6422                    Begi n
  6423                      Dr ugLookup : = Copy(Dru gLookup, 1 , Pos('QUA NTITY: ',  Uppercase( DrugLookup )) - 2);
  6424                    End;
  6425                    drug buffer :=  '';
  6426                    (*
  6427                    //Lo ok for a n umeral in  character  11 or high er and str ip everyth ing after  that.
  6428                    xx:= 0;
  6429                    for  zz:=1 to l ength(drug Lookup) do
  6430                      if  xx=0 then
  6431                         if (druglo okup[zz]=' 1') or (dr uglookup[z z]='2') or  (druglook up[zz]='3' ) or
  6432                           (drugloo kup[zz]='4 ') or (dru glookup[zz ]='5') or  (druglooku p[zz]='6')  or
  6433                           (drugloo kup[zz]='7 ') or (dru glookup[zz ]='8') or  (druglooku p[zz]='9')  or
  6434                           (drugloo kup[zz]='0 ') then
  6435                             xx:=zz ;
  6436                    // A lways take  the first  20 charac ters
  6437                    // I NTERFERON  BETA-1B is  in class  IM900. The  other int erferons a re in IM70 0.
  6438                    if x x>20 then  DrugLookup :=Copy(Dru gLookup,1, xx-2);
  6439                    *)
  6440                    // c heck buffe r first
  6441                    For  zz := 0 To  resultsbu ffer.count  - 1 Do
  6442                      If  piece(res ultsbuffer [zz], '^',  1) = drug lookup The n
  6443                      Be gin
  6444                         drugbuffer  := piece( resultsbuf fer[zz], ' ^', 2);
  6445                      En d;
  6446                    If d rugbuffer  = '' Then
  6447                    Begi n
  6448                      // Not found  in buffer
  6449                      FM ListerOrde rInfo.IENS  := ',' +  Piece(medb uffer, '^' , drugline s);
  6450                      FM ListboxOrd erInfo.Get List;
  6451                      If  FMListbox OrderInfo. Items.Coun t > 0 Then
  6452                         For xx :=  0 To FMLis tboxOrderI nfo.Items. Count - 1  Do
  6453                           If pos(' OR GTX DIS PENSE DRUG   ', FMLis tboxOrderI nfo.Items[ xx]) = 1 T hen
  6454                           Begin
  6455                             //Foun d it do ca ll to do l ookup
  6456                             FMGets DrugFile.I ENS := Cop y(FMListbo xOrderInfo .Items[xx] , pos('  ' , FMListbo xOrderInfo .Items[xx] ) + 4, 99) ;
  6457                             FMGets DrugFile.G etData;
  6458                             drugcl ass := '';
  6459                             For yy  := 0 To F MListBoxVA DrugClass. Items.Coun t - 1 Do
  6460                               If p os(fmgetsd rugfile.ge tfield('2' ).fmdbexte rnal + '   ', FMListB oxVADrugCl ass.Items[ yy]) = 1 T hen
  6461                                 dr ugclass :=  FMListBox VADrugClas s.Items[yy ];
  6462                             result sbuffer.ad d(druglook up + '^' +  drugclass );
  6463                             drugbu ffer := Pi ece(result sbuffer[re sultsbuffe r.count -  1], '^', 2 );
  6464                           End;
  6465                    End;
  6466                    Memo Docs.Lines .Add('VA D RUG CLASS  - ' + drug buffer);
  6467                    inc( druglines) ;
  6468                    Stat usbarloadp t.caption  := 'Loadin g drug cla ss for ' +  inttostr( druglines)  + ' of '  + inttostr (drugcount );
  6469                    Stat usbarloadp t.repaint;
  6470                  End;
  6471                End;
  6472                MemoDocs .Lines.Add ('');
  6473                MemoDocs .Lines.Add ('PROVIDER : ' + Piec e(Line, '^ ', 11) + '   START: '  + FMDateT imeConvert (Piece(Lin e, '^', 4) ) + '  STO P: ' + FMD ateTimeCon vert(Piece (Line, '^' , 5)));
  6474                whichlin e := 1;
  6475              End
  6476              Else
  6477              Begin                                                                        // Text St uff
  6478                MemoDocs .Lines.Add (Copy(Line , 2, Lengt h(Line) -  1));
  6479                If which line = 1 T hen
  6480                Begin
  6481                  druglo okup := Me moDocs.Lin es[MemoDoc s.Lines.Co unt - 1];
  6482                  whichl ine := 0;
  6483                End;
  6484              End;
  6485           En d;
  6486           If  (lstDocs. ItemIndex  = 1) Or (l stDocs.Ite mIndex = 2 ) Then
  6487           Be gin                                                                          // Only do  this for  outpatient
  6488              drugbuffer  := piece( resultsbuf fer[inX],  '^', 2);
  6489              MemoDocs.L ines.Add(' VA DRUG CL ASS - ' +  drugbuffer );
  6490           En d;
  6491           re sultsbuffe r.free;
  6492           qu icklookup. free;
  6493           Me moDocs.Vis ible := Tr ue;
  6494           Me moDocs.Sel Start := 0 ;
  6495           Me moDocs.Sel Length :=  0;                                                     // ET 0603 29 try lst Docs.SetFo cus except  end;
  6496         End;
  6497       MemoDo cs.visible  := True;
  6498       If Mem oDocs.Line s.Count =  0 Then
  6499       Begin
  6500         Memo Docs.Lines .Add('');
  6501         Memo Docs.Lines .Add('Ther e is no da ta for the  requested  search cr iteria.');
  6502       End;
  6503     End;
  6504     If (DocT ype = 'IMA GING') The n
  6505     Begin
  6506       frmMai n.RPCBroke r1.Results .Clear;
  6507       RPCBro ker1.Remot eProcedure  := 'ORWRP  REPORT TE XT';
  6508       RPCBro ker1.Param [1].Value  := Patient IEN;                                        // Patient  IEN
  6509       RPCBro ker1.Param [1].PType  := literal ;
  6510       RPCBro ker1.Param [2].Value  := '18';                                               // Imaging  Report
  6511       RPCBro ker1.Param [2].PType  := literal ;
  6512       RPCBro ker1.Param [3].Value  := '';
  6513       RPCBro ker1.Param [3].PType  := literal ;
  6514       RPCBro ker1.Param [4].Value  := '';
  6515       RPCBro ker1.Param [4].PType  := literal ;
  6516       RPCBro ker1.Param [5].Value  := Piece(l stDocs.Ite ms[lstDocs .ItemIndex ], '^', 2) ;
  6517       RPCBro ker1.Param [5].PType  := literal ;
  6518       RPCBro ker1.Param [6].Value  := '0';
  6519       RPCBro ker1.Param [6].PType  := literal ;
  6520       RPCBro ker1.Param [7].Value  := '0';
  6521       RPCBro ker1.Param [7].PType  := literal ;
  6522       Try
  6523         RPCB roker1.Cal l;
  6524       Except
  6525         On E BrokerErro r Do
  6526         Begi n
  6527           AN URemotePro cedureCall InProgress  := False;
  6528           An imateLogo( False);
  6529           St atusBarLoa dPt.Captio n := 'RPC  ORWRP REPO RT TEXT co uld not be  accessed! ';
  6530           St atusBarLoa dPt.Repain t;
  6531           Ap plication. Processmes sages;
  6532           Sh owMessageC APRI('RPC  ORWRP REPO RT TEXT co uld not be  accessed! ');
  6533         End
  6534       End;
  6535       memoDo cs.Visible  := False;
  6536       memoDo cs.Lines.C lear;
  6537       MemoDo cs.SetSelT extBuf(RPC Broker1.Re sults.GetT ext);
  6538       MemoDo cs.Lines.A dd('');
  6539       MemoDo cs.Visible  := True;
  6540       MemoDo cs.SelStar t := 0;
  6541       MemoDo cs.SelLeng th := 0;                                                          // ET 0603 29 try lst Docs.SetFo cus except  end;
  6542       If Sea rchRunning  = 0 Then                                                         //CodeCR69 6 JRL 4/8/ 15
  6543         If E ditSearchP N.Text <>  '' Then                                                //CodeCR69 6 JRL 4/8/ 15
  6544         Begi n                                                                            //CodeCR69 6 JRL 4/8/ 15
  6545           La stSearchFo undAt := 0 ;                                                      //CodeCR69 6 JRL 4/8/ 15
  6546           bu ttonSearch Click(appl ication);                                              //CodeCR69 6 JRL 4/8/ 15
  6547         End;                                                                              //CodeCR69 6 JRL 4/8/ 15
  6548     End;
  6549     If (DocT ype = 'VS' ) Then                                                            // Vitals
  6550     Begin
  6551     (*  Defe ct #2199 -  rpm 4/21/ 09 - Follo wing code  failed whe n the Item Index
  6552         was  -1 as a re sult of fo rcing the  ItemIndex  to 9 with  only 8 ite ms in
  6553         Tab9 5Control1C hange.
  6554       If Pos ('DATE', U ppercase(l stDocs.Ite ms[lstDocs .ItemIndex ])) > 0 Th en
  6555       Begin
  6556         Anim ateLogo(Fa lse);
  6557         Stat usBarLoadP t.Caption  := 'Ready. ';
  6558         Stat usBarLoadP t.Repaint;
  6559         Appl ication.Pr ocessmessa ges;
  6560         Show MessageCAP RI('UNDER  CONSTRUCTI ON:  The d ate range  option wil l be avail able in th e next ver sion of CA PRI.');
  6561         exit ;
  6562       End;
  6563     *)
  6564       frmMai n.RPCBroke r1.Results .Clear;
  6565       RPCBro ker1.Remot eProcedure  := 'ORWRP  REPORT TE XT';
  6566       RPCBro ker1.Param [1].Value  := Patient IEN;                                        // Patient  IEN
  6567       RPCBro ker1.Param [1].PType  := literal ;
  6568       RPCBro ker1.Param [2].Value  := '5';                                                // Vitals  Report
  6569       RPCBro ker1.Param [2].PType  := literal ;
  6570       RPCBro ker1.Param [3].Value  := '';
  6571       RPCBro ker1.Param [3].PType  := literal ;
  6572       RPCBro ker1.Param [4].Value  := '';
  6573       RPCBro ker1.Param [4].PType  := literal ;
  6574       If lst Docs.ItemI ndex = 0 T hen
  6575         RPCB roker1.Par am[4].Valu e := '0';
  6576       If lst Docs.ItemI ndex = 1 T hen
  6577         RPCB roker1.Par am[4].Valu e := '7';
  6578       If lst Docs.ItemI ndex = 2 T hen
  6579         RPCB roker1.Par am[4].Valu e := '14';
  6580       If lst Docs.ItemI ndex = 3 T hen
  6581         RPCB roker1.Par am[4].Valu e := '30';
  6582       If lst Docs.ItemI ndex = 4 T hen
  6583         RPCB roker1.Par am[4].Valu e := '180' ;
  6584       If lst Docs.ItemI ndex = 5 T hen
  6585         RPCB roker1.Par am[4].Valu e := '365' ;
  6586       If lst Docs.ItemI ndex = 6 T hen
  6587         RPCB roker1.Par am[4].Valu e := '730' ;
  6588       If lst Docs.ItemI ndex = 7 T hen
  6589         RPCB roker1.Par am[4].Valu e := '1825 ';
  6590       If lst Docs.ItemI ndex = 8 T hen
  6591         RPCB roker1.Par am[4].Valu e := '9999 9';
  6592       RPCBro ker1.Param [5].Value  := '';
  6593       RPCBro ker1.Param [5].PType  := literal ;
  6594       RPCBro ker1.Param [6].Value  := '0';
  6595       RPCBro ker1.Param [6].PType  := literal ;
  6596       RPCBro ker1.Param [7].Value  := '0';
  6597       RPCBro ker1.Param [7].PType  := literal ;
  6598     (* Defec t #2199 -  rpm 4/21/0 9 - ItemIn dex should  never be  9.  Appear s to be
  6599        an in complete f uture enha ncement.
  6600       If lst Docs.ItemI ndex = 9 T hen
  6601       Begin
  6602         RPCB roker1.Par am[6].Valu e := Float ToStr(Form DateRange. ORDateComb oStart.FMD ate); // D ate Range
  6603         RPCB roker1.Par am[6].PTyp e := liter al;
  6604         RPCB roker1.Par am[7].Valu e := Float ToStr(Form DateRange. ORDateComb oStop.FMDa te); // Da te Range
  6605         RPCB roker1.Par am[7].PTyp e := liter al;
  6606       End;
  6607     *)
  6608       Try
  6609         RPCB roker1.Cal l;
  6610       Except
  6611         On E BrokerErro r Do
  6612         Begi n
  6613           AN URemotePro cedureCall InProgress  := False;
  6614           An imateLogo( False);
  6615           St atusBarLoa dPt.Captio n := 'RPC  ORWRP REPO RT TEXT co uld not be  accessed! ';
  6616           St atusBarLoa dPt.Repain t;
  6617           Ap plication. Processmes sages;
  6618           Sh owMessageC APRI('RPC  ORWRP REPO RT TEXT co uld not be  accessed! ');
  6619         End
  6620       End;
  6621       memoDo cs.Visible  := False;
  6622       memoDo cs.Lines.C lear;
  6623       MemoDo cs.SetSelT extBuf(RPC Broker1.Re sults.GetT ext);
  6624       If Mem oDocs.Line s.Count >  4 Then
  6625         If U ppercase(M emoDocs.Li nes[5]) =  'NO CUMULA TIVE VITAL S DATA FOR  THIS PATI ENT' Then
  6626         Begi n
  6627           Me moDocs.Lin es.Insert( 6, 'within  the selec ted date r ange.');
  6628         End;
  6629       If Mem oDocs.Line s.Count >  5 Then
  6630         If U ppercase(M emoDocs.Li nes[6]) =  'NO CUMULA TIVE VITAL S DATA FOR  THIS PATI ENT' Then
  6631         Begi n
  6632           Me moDocs.Lin es.Insert( 7, 'within  the selec ted date r ange.');
  6633         End;
  6634       MemoDo cs.Lines.A dd('');
  6635       MemoDo cs.SelStar t := 1;
  6636       MemoDo cs.SelLeng th := 1;                                                          // ET 0603 29 try lst Docs.SetFo cus except  end;
  6637       MemoDo cs.SelStar t := 0;
  6638       MemoDo cs.SelLeng th := 0;                                                          // ET 0603 29 try lst Docs.SetFo cus except  end;
  6639       MemoDo cs.Visible  := True;
  6640     End;
  6641     If (DocT ype = 'LAB ') Then
  6642     Begin
  6643       If lst Docs.ItemI ndex = 11  Then
  6644       Begin                                                                               // Graph l abs
  6645         if V aUtils.Scr eenReaderA ctive then  begin
  6646           Sh owMessageC APRI('The  graphing i nterface i s not suit able for s creen read er use.  '  +
  6647              'Please us e the text  reports t o obtain t he equival ent inform ation.');
  6648         end  else begin
  6649           If  ListLabTe stNames.Co unt = 0 Th en
  6650           Be gin
  6651              TGifImage( GifImageVi staYellow. picture.Gr aphic).Ani mate := Tr ue;
  6652              StatusBarL oadPt.Capt ion := 'Lo ading lab  test names .';
  6653              StatusBarL oadPt.Repa int;
  6654              Applicatio n.Processm essages;
  6655  
  6656              RPCBroker1 .RemotePro cedure :=  'DVBAB LAB LIST';
  6657              RPCBrokerC all;
  6658              Try
  6659                RPCBroke r1.Call;
  6660              Except
  6661                On EBrok erError Do
  6662                Begin
  6663                  ANURem oteProcedu reCallInPr ogress :=  False;
  6664                  Animat eLogo(Fals e);
  6665                  Status BarLoadPt. Caption :=  'RPC DVBA B LABLIST  could not  be accesse d!';
  6666                  Status BarLoadPt. Repaint;
  6667                  Applic ation.Proc essmessage s;
  6668                  ShowMe ssageCAPRI ('DVBAB LA BLIST coul d not be a ccessed!') ;
  6669                End;
  6670              End;
  6671              If RPCBrok er1.Result s.Count >  0 Then
  6672                For xx : = 0 To RPC Broker1.Re sults.Coun t - 1 Do
  6673                  listLa bTestNames .Add(RPCBr oker1.Resu lts[xx]);
  6674              frmLabGrap h.chartLab .AllowZoom  := False;
  6675              frmLabGrap h.ButtonGr aph.Visibl e := True;
  6676              frmLabGrap h.DateTime Picker1.Vi sible := T rue;
  6677              frmLabGrap h.DateTime Picker2.Vi sible := T rue;
  6678              frmLabGrap h.DateTime Picker1.Da te := Now  - 7;
  6679              frmLabGrap h.DateTime Picker2.Da te := Now;
  6680              AnimateLog o(False);
  6681              StatusBarL oadPt.Capt ion := 'Re ady.';
  6682              StatusBarL oadPt.Repa int;
  6683              Applicatio n.Processm essages;
  6684           En d;
  6685           fr mLabGraph. Top := 7 +  frmMain.T op + ((frm Main.Heigh t - frmLab Graph.Heig ht) Div 2) ;
  6686           fr mLabGraph. Left := fr mMain.Left  + ((frmMa in.Width -  frmLabGra ph.Width)  Div 2);
  6687           fr mLabGraph. ListBoxLab s.Items.Cl ear;
  6688           sc reen.curso r := crhou rglass;
  6689           Fo r xx := 0  To listLab TestNames. Count - 1  Do
  6690              frmLabGrap h.ListBoxL abs.Items. Add(Piece( listLabTes tNames[xx] , '^', 1)) ;
  6691           Fo r xx := fr mLabGraph. ListBoxLab s.Items.Co unt - 1 Do wnto 1 Do
  6692           Be gin
  6693              applicatio n.processm essages;
  6694              If frmLabG raph.ListB oxLabs.Ite ms[xx] = f rmLabGraph .ListBoxLa bs.Items[x x - 1] The n
  6695                frmLabGr aph.ListBo xLabs.Item s.Delete(x x);
  6696              If frmLabG raph.ListB oxLabs.Ite ms[xx] = ' ' Then
  6697                frmLabGr aph.ListBo xLabs.Item s.Delete(x x);
  6698           En d;
  6699           sc reen.curso r := crdef ault;
  6700           An imateLogo( False);
  6701           St atusBarLoa dPt.Captio n := 'Read y.';
  6702           St atusBarLoa dPt.Repain t;
  6703           Ap plication. Processmes sages;
  6704           fr mLabGraph. ShowModal;
  6705         end;
  6706         exit ;
  6707       End;
  6708       frmMai n.RPCBroke r1.Results .Clear;
  6709       RPCBro ker1.Remot eProcedure  := 'ORWLR  CUMULATIV E REPORT';
  6710       RPCBro ker1.Param [1].Value  := Patient IEN;                                        // Patient  IEN
  6711       RPCBro ker1.Param [1].PType  := literal ;
  6712       If lst Docs.ItemI ndex = 0 T hen
  6713         RPCB roker1.Par am[2].Valu e := '8';
  6714       If lst Docs.ItemI ndex = 1 T hen
  6715         RPCB roker1.Par am[2].Valu e := '15';
  6716       If lst Docs.ItemI ndex = 2 T hen
  6717         RPCB roker1.Par am[2].Valu e := '32';
  6718       If lst Docs.ItemI ndex = 3 T hen
  6719         RPCB roker1.Par am[2].Valu e := '180' ;
  6720       If lst Docs.ItemI ndex = 4 T hen
  6721         RPCB roker1.Par am[2].Valu e := '365' ;
  6722       If lst Docs.ItemI ndex = 5 T hen
  6723         RPCB roker1.Par am[2].Valu e := '730' ;
  6724       If lst Docs.ItemI ndex = 6 T hen
  6725         RPCB roker1.Par am[2].Valu e := '1825 ';
  6726       If lst Docs.ItemI ndex = 7 T hen
  6727         RPCB roker1.Par am[2].Valu e := '9999 9';
  6728       If (ls tDocs.Item Index = 0)  Or (lstDo cs.ItemInd ex = 1) Or  (lstDocs. ItemIndex  = 2) Or
  6729         (lst Docs.ItemI ndex = 3)  Or (lstDoc s.ItemInde x = 4) Or  (lstDocs.I temIndex =  5) Or
  6730         (lst Docs.ItemI ndex = 6)  Or (lstDoc s.ItemInde x = 7) The n
  6731       Begin
  6732         RPCB roker1.Par am[2].PTyp e := liter al;
  6733         RPCB roker1.Par am[3].Valu e := Copy( fmdatenow,  1, Pos('. ', fmdaten ow) - 1) +  '.2359';
  6734         RPCB roker1.Par am[3].PTyp e := liter al;
  6735         fmda tepast :=  FMDateTime Convert2(f mdatenow);
  6736         fmda tepast :=  Copy(FMDat ePast, 1,  Pos('@', F mDatePast)  - 1);
  6737         RPCB roker1.Par am[4].Valu e := FMToD ateConvert (FormatDat eTime('mm/ dd/yyyy',  StrToDate( FMDatePast ) - StrToI nt(RPCBrok er1.Param[ 2].Value)) );
  6738         RPCB roker1.Par am[4].PTyp e := liter al;
  6739       End;
  6740       //Show MessageCAP RI(RPCBrok er1.Param[ 1].Value);
  6741       //Show MessageCAP RI(RPCBrok er1.Param[ 2].Value);
  6742       //Show MessageCAP RI(RPCBrok er1.Param[ 3].Value);
  6743       //Show MessageCAP RI(RPCBrok er1.Param[ 4].Value);
  6744       //
  6745       If lst Docs.ItemI ndex = 8 T hen
  6746       Begin
  6747         RPCB roker1.Rem oteProcedu re := 'ORW RP REPORT  TEXT';
  6748         RPCB roker1.Par am[1].Valu e := Patie ntIEN;                                      // Patient  IEN
  6749         RPCB roker1.Par am[1].PTyp e := liter al;
  6750         RPCB roker1.Par am[2].Valu e := '20';                                             // Anatomi c Path
  6751         RPCB roker1.Par am[2].PTyp e := liter al;
  6752         RPCB roker1.Par am[3].Valu e := '0';                                              // Anatomi c Path
  6753         RPCB roker1.Par am[3].PTyp e := liter al;
  6754         RPCB roker1.Par am[4].Valu e := '9999 ';                                          // Anatomi c Path
  6755         RPCB roker1.Par am[4].PTyp e := liter al;
  6756         RPCB roker1.Par am[5].Valu e := '1';                                              // Anatomi c Path
  6757         RPCB roker1.Par am[5].PTyp e := liter al;
  6758         RPCB roker1.Par am[6].Valu e := '0';
  6759         RPCB roker1.Par am[6].PTyp e := liter al;
  6760         RPCB roker1.Par am[7].Valu e := '0';
  6761         RPCB roker1.Par am[7].PTyp e := liter al;
  6762       End;
  6763       If lst Docs.ItemI ndex = 9 T hen
  6764       Begin
  6765         RPCB roker1.Rem oteProcedu re := 'ORW RP REPORT  TEXT';
  6766         RPCB roker1.Par am[1].Valu e := Patie ntIEN;                                      // Patient  IEN
  6767         RPCB roker1.Par am[1].PTyp e := liter al;
  6768         RPCB roker1.Par am[2].Valu e := '2';                                              // Blood B ank
  6769         RPCB roker1.Par am[2].PTyp e := liter al;
  6770         RPCB roker1.Par am[3].Valu e := '0';                                              // Anatomi c Path
  6771         RPCB roker1.Par am[3].PTyp e := liter al;
  6772         RPCB roker1.Par am[4].Valu e := '9999 ';                                          // Anatomi c Path
  6773         RPCB roker1.Par am[4].PTyp e := liter al;
  6774         RPCB roker1.Par am[5].Valu e := '1';                                              // Anatomi c Path
  6775         RPCB roker1.Par am[5].PTyp e := liter al;
  6776         RPCB roker1.Par am[6].Valu e := '0';
  6777         RPCB roker1.Par am[6].PTyp e := liter al;
  6778         RPCB roker1.Par am[7].Valu e := '0';
  6779         RPCB roker1.Par am[7].PTyp e := liter al;
  6780       End;
  6781       If lst Docs.ItemI ndex = 10  Then
  6782       Begin
  6783         RPCB roker1.Rem oteProcedu re := 'ORW LRR MICRO' ;
  6784         RPCB roker1.Par am[1].Valu e := Patie ntIEN;                                      // Patient  IEN
  6785         RPCB roker1.Par am[1].PTyp e := liter al;
  6786         //Sh owMessageC APRI(Forma tDateTime( 'mm/dd/yyy y',date));
  6787         RPCB roker1.Par am[2].Valu e := '5000 101.2359';                                  // Stop Da te
  6788         RPCB roker1.Par am[2].PTyp e := liter al;
  6789         RPCB roker1.Par am[3].Valu e := '1171 021';                                       // Start D ate
  6790         RPCB roker1.Par am[3].PTyp e := liter al;
  6791       End;
  6792       Try
  6793         RPCB roker1.Cal l;
  6794       Except
  6795         On E BrokerErro r Do
  6796         Begi n
  6797           AN URemotePro cedureCall InProgress  := False;
  6798           An imateLogo( False);
  6799           St atusBarLoa dPt.Captio n := 'RPC  ORWRP REPO RT TEXT co uld not be  accessed! ';
  6800           St atusBarLoa dPt.Repain t;
  6801           Ap plication. Processmes sages;
  6802           Sh owMessageC APRI('RPC  ORWRP REPO RT TEXT co uld not be  accessed! ');
  6803         End
  6804       End;
  6805       memoDo cs.Visible  := False;
  6806       memoDo cs.Lines.C lear;
  6807       MemoDo cs.SetSelT extBuf(RPC Broker1.Re sults.GetT ext);
  6808       MemoDo cs.Lines.A dd('');
  6809       MemoDo cs.Visible  := True;
  6810       MemoDo cs.SelStar t := 0;
  6811       MemoDo cs.SelLeng th := 0;                                                          // ET 0603 29 try lst Docs.SetFo cus except  end;
  6812       If RPC Broker1.Re moteProced ure = 'ORW LRR MICRO'  Then
  6813       Begin
  6814         If M emoDocs.Li nes.Count  = 0 Then
  6815         Begi n
  6816           Me moDocs.Lin es.Add('') ;
  6817           Me moDocs.Lin es.Add('No  microbiol ogy data f ound in th e date ran ge specifi ed...');
  6818         End;
  6819       End;
  6820       foundr eportflag  := false;                                                         // Do this  to strip  the report  header
  6821       MemoDo cs.Visible  := False;
  6822       If Mem oDocs.Line s.Count >  0 Then
  6823         For  xx := 0 To  MemoDocs. Lines.Coun t - 1 Do
  6824           If  MemoDocs. Lines[xx]  = '[REPORT  TEXT]' Th en
  6825              foundrepor tflag := t rue;
  6826       If fou ndreportfl ag = true  Then
  6827       Begin
  6828         Repe at
  6829           Me moDocs.Lin es.Delete( 0);
  6830         Unti l (MemoDoc s.Lines[0]  = '[REPOR T TEXT]')  Or (MemoDo cs.Lines.C ount = 0);
  6831         Memo Docs.Lines .Delete(0) ;
  6832       End;
  6833       MemoDo cs.Visible  := True;
  6834       MemoDo cs.SelStar t := 0;
  6835       MemoDo cs.SelLeng th := 0;                                                          // ET 0603 29 try lst Docs.SetFo cus except  end;
  6836       If Mem oDocs.Line s.Count =  0 Then
  6837       Begin
  6838         Memo Docs.Lines .Add('');
  6839         Memo Docs.Lines .Add('No d ata found  in the dat e range sp ecified... ');
  6840       End;
  6841       If Mem oDocs.Line s.Count >  1 Then
  6842         If M emoDocs.Li nes[1] = ' No Data Fo und' Then
  6843           Me moDocs.Lin es[1] := ' No data fo und in the  date rang e specifie d...';
  6844     End;
  6845     If (DocT ype = 'PN' ) Or (DocT ype = 'DS' ) Then                                      // Notes a nd Dischar ge Summari es
  6846     Begin
  6847       // Get  Epsiode D ate/Time
  6848       FMGets TIU.IENS : = Piece(ls tDocs.Item s[lstDocs. ItemIndex] , '^', 2);
  6849       FMGets TIU.GetAnd Fill;
  6850       Try
  6851       anuapp tpointer : = FMGetsTI U.GetField ('1205').F MDBInterna l Except a nuapptpoin ter := ''
  6852       End;                                                                                // Pointer  to visit
  6853       anuins titution : = '';
  6854       anudiv ision := ' ';
  6855       If anu apptpointe r <> '' Th en
  6856       Begin
  6857         FMGe tsHospital Location.I ENS := anu apptpointe r;
  6858         FMGe tsHospital Location.G etData;
  6859         Try
  6860         anui nstitution  := FMGets HospitalLo cation.Get Field('3') .FMDBExter nal Except
  6861         End;
  6862         Try
  6863         anud ivision :=  FMGetsHos pitalLocat ion.GetFie ld('3.5'). FMDBExtern al Except
  6864         End;
  6865       End;
  6866       //
  6867       frmMai n.RPCBroke r1.Results .Clear;
  6868       RPCBro ker1.Remot eProcedure  := 'TIU G ET RECORD  TEXT';
  6869       RPCBro ker1.Param [1].Value  := Piece(l stDocs.Ite ms[lstDocs .ItemIndex ], '^', 2) ;
  6870       RPCBro ker1.Param [1].PType  := literal ;
  6871       Try
  6872         RPCB roker1.Cal l;
  6873       Except
  6874         On E BrokerErro r Do
  6875         Begi n
  6876           AN URemotePro cedureCall InProgress  := False;
  6877           An imateLogo( False);
  6878           St atusBarLoa dPt.Captio n := 'RPC  TIU GET RE CORD TEXT  could not  be accesse d!';
  6879           St atusBarLoa dPt.Repain t;
  6880           Ap plication. Processmes sages;
  6881           Sh owMessageC APRI('RPC  TIU GET RE CORD TEXT  could not  be accesse d!');
  6882         End
  6883       End;
  6884       memoDo cs.Visible  := False;
  6885       memoDo cs.Lines.C lear;
  6886       If Doc Type = 'DS ' Then
  6887         RPCB roker1.Res ults.Inser t(4, '     DIVISION:  ' + anudiv ision);
  6888       If Doc Type = 'DS ' Then
  6889         RPCB roker1.Res ults.Inser t(4, ' INS TITUTION:  ' + anuins titution);
  6890       If Doc Type = 'DS ' Then
  6891         RPCB roker1.Res ults.Inser t(4, '  EP SIODE END  DATE/TIME:  ' + FMEdi tEpisodeEn dDateTime. Text);
  6892       If Doc Type = 'DS ' Then
  6893         RPCB roker1.Res ults.Inser t(4, 'EPSI ODE BEGIN  DATE/TIME:  ' + FMEdi tEpisodeBe ginDateTim e.Text);
  6894       If Doc Type = 'PN ' Then
  6895         RPCB roker1.Res ults.Inser t(4, '     DIVISION:  ' + anudiv ision);
  6896       If Doc Type = 'PN ' Then
  6897         RPCB roker1.Res ults.Inser t(4, ' INS TITUTION:  ' + anuins titution);
  6898       RPCBro ker1.Resul ts.Add('') ;
  6899       MemoDo cs.SetSelT extBuf(RPC Broker1.Re sults.GetT ext);
  6900       MemoDo cs.SelStar t := 1;
  6901       MemoDo cs.SelLeng th := 1;                                                          // ET 0603 29 try lst Docs.SetFo cus except  end;
  6902       MemoDo cs.SelStar t := 0;
  6903       MemoDo cs.SelLeng th := 0;                                                          // ET 0603 29 try lst Docs.SetFo cus except  end;
  6904       MemoDo cs.Visible  := True;
  6905       If Sea rchRunning  = 0 Then
  6906         If E ditSearchP N.Text <>  '' Then
  6907         Begi n
  6908           La stSearchFo undAt := 0 ;
  6909           bu ttonSearch Click(appl ication);
  6910         End;
  6911     End;
  6912     If DocTy pe = 'CN'  Then                                                              // Consult s
  6913     Begin
  6914       frmMai n.RPCBroke r1.Results .Clear;
  6915       RPCBro ker1.Remot eProcedure  := 'ORQQC N DETAIL';
  6916       RPCBro ker1.Param [1].Value  := Piece(l stDocs.Ite ms[lstDocs .ItemIndex ], '^', 2) ;
  6917       RPCBro ker1.Param [1].PType  := literal ;
  6918       Try
  6919         RPCB roker1.Cal l;
  6920       Except
  6921         On E BrokerErro r Do
  6922         Begi n
  6923           AN URemotePro cedureCall InProgress  := False;
  6924           An imateLogo( False);
  6925           St atusBarLoa dPt.Captio n := 'RPC  ORQQCN DET AIL could  not be acc essed!';
  6926           St atusBarLoa dPt.Repain t;
  6927           Ap plication. Processmes sages;
  6928           Sh owMessageC APRI('RPC  ORQQCN DET AIL could  not be acc essed!');
  6929         End
  6930       End;
  6931       memoDo cs.Visible  := False;
  6932       memoDo cs.Lines.C lear;
  6933       MemoDo cs.SetSelT extBuf(RPC Broker1.Re sults.GetT ext);
  6934       MemoDo cs.Lines.A dd('');
  6935       MemoDo cs.Visible  := True;
  6936       MemoDo cs.SelStar t := 0;
  6937       MemoDo cs.SelLeng th := 0;                                                          // ET 0603 29 try lst Docs.SetFo cus except  end;
  6938       If Sea rchRunning  = 0 Then                                                         //CodeCR69 6 JRL 4/8/ 15
  6939         If E ditSearchP N.Text <>  '' Then                                                //CodeCR69 6 JRL 4/8/ 15
  6940         Begi n                                                                            //CodeCR69 6 JRL 4/8/ 15
  6941           La stSearchFo undAt := 0 ;                                                      //CodeCR69 6 JRL 4/8/ 15
  6942           bu ttonSearch Click(appl ication);                                              //CodeCR69 6 JRL 4/8/ 15
  6943         End;                                                                              //CodeCR69 6 JRL 4/8/ 15
  6944     End;
  6945     AnimateL ogo(False) ;
  6946     StatusBa rLoadPt.Ca ption := ' Ready.';
  6947     StatusBa rLoadPt.Re paint;
  6948     Applicat ion.Proces smessages;
  6949     If Searc hRunning < > 99 Then
  6950     Begin
  6951       MemoDo cs.SelStar t := 0;
  6952       MemoDo cs.SelLeng th := 0;                                                          // ET 0603 29 Try lst Docs.SetFo cus except  end;
  6953     End
  6954     Else
  6955     Begin
  6956       Search Running :=  0;
  6957     End;
  6958     // Highl ight if ju st searche d
  6959   End;
  6960  
  6961   Procedure  TfrmMain.L oadReports Options;
  6962   Begin
  6963     ORReport sAvailable .Clear;
  6964     ORReport sAvailable .Items.Add ('Pt. Inqu iry');
  6965     ORReport sAvailable .Items.Add ('Detailed  Inpt. Inq uiry');
  6966     ORReport sAvailable .Items.Add ('C&P Exam  Detail');
  6967     ORReport sAvailable .Items.Add ('7131 Det ail');
  6968     ORReport sAvailable .Items.Add ('Addition al Treatin g Faciliti es');
  6969     ORReport sAvailable .Items.Add ('View Reg istration  Data');
  6970     ORReport sAvailable .Items.Add ('Patient  Profile MA S (Full)') ;
  6971     ORReport sAvailable .Items.Add ('Surgery  Report');
  6972     ORReport sAvailable .ItemIndex  := 0;
  6973     ORReport sAvailable Click(Appl ication);
  6974   End;
  6975  
  6976   Procedure  TfrmMain.O RReportsAv ailableCli ck(Sender:  TObject);
  6977   Var
  6978     x: integ er;
  6979     TypeOfMo vement: St ring;
  6980     a, b: St ring;
  6981  
  6982     Function  buildrepo rt: boolea n;
  6983     Begin
  6984       //Buil d Report
  6985       Status BarLoadPt. Caption :=  'Download ing report .';
  6986       Status BarLoadPt. Repaint;
  6987       Applic ation.Proc essmessage s;
  6988       ANURem oteProcedu reCallInPr ogress :=  true;
  6989       Report Memo.Lines .Clear;
  6990       screen .cursor :=  crHourgla ss;
  6991  
  6992       Report Memo.SetSe lTextBuf(R PCBroker1. Results.Ge tText);
  6993  
  6994       screen .cursor :=  crDefault ;
  6995       Report Memo.Visib le := True ;
  6996       Report Memo.SelSt art := 1;
  6997       Report Memo.SelLe ngth := 1;
  6998  
  6999       If IsS etFocusVal id(ReportM emo) then
  7000  
  7001         Repo rtMemo.Sel Start := 0 ;
  7002       Report Memo.SelLe ngth := 0;
  7003  
  7004       If IsS etFocusVal id(ReportM emo) then
  7005         Repo rtMemo.Set Focus;
  7006  
  7007       ANURem oteProcedu reCallinPr ogress :=  False;
  7008       Animat eLogo(Fals e);
  7009       Status BarLoadPt. Caption :=  'Ready.';
  7010       Status BarLoadPt. Repaint;
  7011       Applic ation.Proc essmessage s;
  7012       //End  Of Build R eport
  7013       Result  := True;
  7014     End;
  7015   Begin
  7016     If ANURe moteProced ureCallInP rogress =  True Then
  7017       exit;
  7018  
  7019     StatusBa rLoadPt.Ca ption := ' Downloadin g report.' ;
  7020     StatusBa rLoadPt.Re paint;
  7021     Applicat ion.Proces smessages;
  7022     AnimateL ogo(True);
  7023  
  7024     PanelSur geryReport s.Visible  := False;
  7025     ReportMe mo.Lines.C lear;
  7026     PanelRep ortChoice. Visible :=  False;
  7027     panelRep ortChoice2 .Visible : = False;
  7028     fmRegion alOfficeNu mber.Visib le := Fals e;
  7029     label16. Visible :=  False;
  7030     checkbox Mailman.Vi sible := F alse;
  7031     If ORRep ortsAvaila ble.ItemIn dex = 0 Th en
  7032     Begin                                                                                 // Pt. Inq uiry
  7033       frmMai n.RPCBroke r1.Results .Clear;
  7034  
  7035       RPCBro ker1.Remot eProcedure  := 'DVBAB  PTINQ';
  7036       RPCBro ker1.Param [0].Value  := Patient IEN;
  7037       RPCBro ker1.Param [0].PType  := literal ;
  7038       RPCBro kerCall;
  7039       Try
  7040         RPCB roker1.Cal l;
  7041       Except
  7042         On E BrokerErro r Do
  7043         Begi n
  7044           AN URemotePro cedureCall InProgress  := False;
  7045           An imateLogo( False);
  7046           St atusBarLoa dPt.Captio n := 'RPC  DVBAB PTIN Q could no t be acces sed!';
  7047           St atusBarLoa dPt.Repain t;
  7048           Ap plication. Processmes sages;
  7049           Sh owMessageC APRI('RPC  DVBAB PTIN Q could no t be acces sed!');
  7050         End
  7051       End;
  7052       BuildR eport;
  7053       exit;
  7054     End;
  7055     If ORRep ortsAvaila ble.ItemIn dex = 2 Th en
  7056     Begin
  7057       Status BarLoadPt. Caption :=  'Ready.';
  7058       Status BarLoadPt. Repaint;
  7059       Applic ation.Proc essmessage s;
  7060       ANURem oteProcedu reCallInPr ogress :=  false;
  7061       Animat eLogo(Fals e);
  7062       ShowMe ssageCapri ('To run t his report , go to th e C&&P Exa ms tab, cl ick an exa m and clic k the "Sta tus Inquir y" button. ');
  7063     End;
  7064     If ORRep ortsAvaila ble.ItemIn dex = 3 Th en
  7065     Begin
  7066       Status BarLoadPt. Caption :=  'Ready.';
  7067       Status BarLoadPt. Repaint;
  7068       Applic ation.Proc essmessage s;
  7069       ANURem oteProcedu reCallInPr ogress :=  false;
  7070       Animat eLogo(Fals e);
  7071       ShowMe ssageCapri ('To run t his report , go to th e 7131 Req uest tab,  click a re quest and  click the  "Status In quiry" but ton.');
  7072       exit;
  7073     End;
  7074     If ORRep ortsAvaila ble.ItemIn dex = 4 Th en
  7075     Begin                                                                                 // Other S ites
  7076       Animat eLogo(True );
  7077       Status BarLoadPt. Caption :=  'Generati ng report. ';
  7078       Status BarLoadPt. Repaint;
  7079       Applic ation.Proc essmessage s;
  7080       RPCBro ker1.Remot eProcedure  := 'ORWCI RN FACLIST ';
  7081       RPCBro ker1.Param [0].Value  := Patient IEN;
  7082       RPCBro ker1.Param [0].PType  := literal ;
  7083       RPCBro kerCall;
  7084       Try
  7085         RPCB roker1.Cal l;
  7086       Except
  7087         On E BrokerErro r Do
  7088         Begi n
  7089           AN URemotePro cedureCall InProgress  := False;
  7090           An imateLogo( False);
  7091           St atusBarLoa dPt.Captio n := 'RPC  ORWCIRN FA CLIST coul d not be a ccessed!';
  7092           St atusBarLoa dPt.Repain t;
  7093           Ap plication. Processmes sages;
  7094           Sh owMessageC APRI('ORWC IRN FACLIS T could no t be acces sed!');
  7095         End
  7096       End;
  7097       If Pie ce(RPCBrok er1.Result s[0], '^',  1) = '-1'  Then
  7098       Begin
  7099         // O nly local  data or ot her proble m
  7100         Repo rtMemo.Lin es.Add('Si tes could  not be loa ded.');
  7101       End
  7102       Else
  7103       Begin
  7104         Repo rtMemo.Lin es.Add('Si tes visite d:');
  7105         For  x := 0 To  RPCBroker1 .Results.C ount - 1 D o
  7106         Begi n
  7107           a  := Copy(Pi ece(RPCBro ker1.Resul ts[x], '^' , 1) + '         ', 1 , 8);
  7108           b  := Copy(Pi ece(RPCBro ker1.Resul ts[x], '^' , 2) + '                            ', 1, 2 5);
  7109           Re portMemo.L ines.Add(a  + b + FMD ateTimeCon vert(Piece (RPCBroker 1.Results[ x], '^', 3 )));
  7110         End;
  7111       End;
  7112       Animat eLogo(Fals e);
  7113       Status BarLoadPt. Caption :=  'Ready.';
  7114       Status BarLoadPt. Repaint;
  7115       Applic ation.Proc essmessage s;
  7116     End;
  7117     If ORRep ortsAvaila ble.ItemIn dex = 5 Th en
  7118     Begin                                                                                 // View Re gistration
  7119       If pat ientIEN =  '' Then
  7120       Begin
  7121         Show MessageCAP RI('Please  select a  patient fi rst.');
  7122         exit ;
  7123       End;
  7124       frmMai n.RPCBroke r1.Results .Clear;
  7125       frmMai n.RPCBroke r1.RemoteP rocedure : = 'DVBAB R EPORTS';                         //VIEW REG ISTRATION
  7126       frmMai n.RPCBroke r1.Param[0 ].Value :=  '9';
  7127       frmMai n.RPCBroke r1.Param[0 ].PType :=  literal;
  7128       frmMai n.RPCBroke r1.Param[1 ].Value :=  PatientIE N;
  7129       frmMai n.RPCBroke r1.Param[1 ].PType :=  literal;
  7130       //frmM ain.RPCBro ker1.Call;
  7131       Animat eLogo(True );
  7132       Status BarLoadPt. Caption :=  'Generati ng report. ';
  7133       Status BarLoadPt. Repaint;
  7134       Applic ation.Proc essmessage s;
  7135       RPCBro kerCall;
  7136       Try
  7137         frmM ain.RPCBro ker1.Call;
  7138       Except
  7139         On E BrokerErro r Do
  7140         Begi n
  7141           AN URemotePro cedureCall InProgress  := False;
  7142           // ShowMessag eCAPRI('RP C DVBAB RE PORTS coul d not be a ccessed!') ;
  7143           Re portMemo.L ines.Add(' There was  a problem  running th e call RPC  DVBAB REP ORTS.');
  7144           // If RPCBrok er1.Connec ted = Fals e Then  BS E mod - rp m 1/8/09
  7145           //   RPCBroke r1.Connect ed := True ;  BSE mod  - rpm 1/8 /09
  7146           If  Not Conne ctToServer ('DVBA CAP RI GUI') T hen
  7147           Be gin
  7148              ShowMessag eCAPRI('Co uld not us e option " DVBA CAPRI  GUI!"');
  7149              applicatio n.terminat e;
  7150           En d;
  7151           If  RPCBroker 1.Connecte d = False  Then
  7152           Be gin
  7153              ShowMessag eCAPRI('Co uld not us e option " DVBA CAPRI  GUI!"');
  7154              applicatio n.terminat e;
  7155           En d;
  7156           ex it;
  7157         End;
  7158       End;
  7159       QuickC opy(frmMai n.RPCBroke r1.Results , ReportMe mo);
  7160       If Rep ortMemo.Li nes.Count  > 0 Then
  7161         For  x := Repor tmemo.Line s.Count -  1 Downto 0  Do
  7162           If  ReportMem o.Lines[x]  = '<RET>  to CONTINU E, ^N for  screen N o r ''^'' to  QUIT: ' T hen
  7163              ReportMemo .Lines.Del ete(x);
  7164       If Rep ortMemo.Li nes.count  = 0 Then
  7165         Repo rtMemo.Lin es.Add('No  data foun d for requ ested repo rt criteri a.');
  7166       Report Memo.SelSt art := 0;
  7167       Report Memo.SelLe ngth := 0;
  7168       Animat eLogo(Fals e);
  7169       Status BarLoadPt. Caption :=  'Ready.';
  7170       Status BarLoadPt. Repaint;
  7171       Applic ation.Proc essmessage s;
  7172     End;
  7173     If ORRep ortsAvaila ble.ItemIn dex = 6 Th en
  7174     Begin                                                                                 // Patient  Profile M AS (Full)
  7175       Animat eLogo(Fals e);
  7176       Status BarLoadPt. Caption :=  'Ready.';
  7177       Status BarLoadPt. Repaint;
  7178       Applic ation.Proc essmessage s;
  7179       If Pat ientIEN =  '' Then
  7180       Begin
  7181         Show MessageCAP RI('Please  select a  patient fi rst.');
  7182         exit ;
  7183       End;
  7184  
  7185       //Code CR85 - rpm  4/13/10
  7186       frmPat ientProfil eMAS := Tf rmPatientP rofileMAS. Create(nil );
  7187       try
  7188         if ( frmPatient ProfileMAS .ShowModal  = mrOK) t hen
  7189         begi n
  7190           Ge tPatientPr ofileMAS(P atientIEN) ;
  7191         end;
  7192       finall y
  7193         Free AndNil(frm PatientPro fileMAS);
  7194       end;
  7195     End;
  7196     If ORRep ortsAvaila ble.ItemIn dex = 7 Th en
  7197     Begin                                                                                 // Surgery  reports;
  7198       If All owSurgeryR eport = Fa lse Then
  7199       Begin
  7200         Show MessageCAP RI('Surger y reports  require re lease of p atch SR*3* 100.  Expe cted date  that this  report typ e will be  available  is approxi mately Dec ember 1, 2 003.');
  7201         Stat usBarLoadP t.Caption  := 'Ready. ';
  7202         Stat usBarLoadP t.Repaint;
  7203         Appl ication.Pr ocessmessa ges;
  7204         ANUR emoteProce dureCallIn Progress : = false;
  7205         Anim ateLogo(Fa lse);
  7206         exit ;
  7207       End;
  7208       PanelS urgeryRepo rts.Visibl e := True;
  7209       PanelS urgeryRepo rts.BringT oFront;
  7210       if Mem oCPTCopyri ght.Visibl e then beg in                                          // -MER Co deCR119 12 /10
  7211         Memo CPTCopyrig ht.SetFocu s;                                                     // -MER Co deCR119 8/ 2010
  7212         Memo CPTCopyrig ht.SelStar t := 0;                                                // -MER Co deCR119 8/ 2010
  7213       end;
  7214       Button OKSurgeryR eports.Ena bled := Fa lse;
  7215       RPCBro ker1.Remot eProcedure  := 'DVBAB  SURGERY C ASE';
  7216       RPCBro ker1.Param [0].Value  := Patient IEN;
  7217       RPCBro ker1.Param [0].PType  := literal ;
  7218       Try
  7219         RPCB roker1.Cal l;
  7220       Except
  7221         On E BrokerErro r Do
  7222         Begi n
  7223           AN URemotePro cedureCall InProgress  := False;
  7224           An imateLogo( False);
  7225           St atusBarLoa dPt.Captio n := 'DVBA B SURGERY  CASE could  not be ac cessed!';
  7226           St atusBarLoa dPt.Repain t;
  7227           Ap plication. Processmes sages;
  7228           Sh owMessageC APRI('DVBA B SURGERY  CASE could  not be ac cessed!');
  7229         End;
  7230       End;
  7231       Surger yReports.C lear;
  7232       QuickC opy(RPCBro ker1.Resul ts, Surger yReports);
  7233       QuickC opy(RPCBro ker1.Resul ts, ORList BoxSurgery Reports.It ems);
  7234       If ORL istBoxSurg eryReports .Items.Cou nt > 0 The n
  7235         For  x := 0 To  ORListBoxS urgeryRepo rts.Items. Count - 1  Do
  7236         Begi n
  7237           // ShowMessag eCAPRI(ORL istBoxSurg eryReports .Items[x]) ;
  7238   //         ORListBoxS urgeryRepo rts.Items[ x]:=Piece( ORListBoxS urgeryRepo rts.Items[ x],'^',2)+ '^'+
  7239   //           FMDateTi meConvert( Piece(ORLi stBoxSurge ryReports. Items[x],' ^',3))+'   '+
  7240   //           Piece(OR ListBoxSur geryReport s.Items[x] ,'^',4)+'  ('+
  7241   //           Piece(OR ListBoxSur geryReport s.Items[x] ,'^',5)+') ';
  7242           OR ListBoxSur geryReport s.Items[x]  := Piece( ORListBoxS urgeryRepo rts.Items[ x], '^', 1 ) + '^' +
  7243              FMDateTime Convert(Pi ece(ORList BoxSurgery Reports.It ems[x], '^ ', 2)) + '   ' +
  7244              Piece(ORLi stBoxSurge ryReports. Items[x],  '^', 3) +  ' ' +
  7245              Piece(ORLi stBoxSurge ryReports. Items[x],  '^', 4) +  '';
  7246         End;
  7247     End;
  7248     If ORRep ortsAvaila ble.ItemIn dex = 1 Th en
  7249     Begin                                                                                 // Detaile d Inpt. In quiry
  7250       LabelR eportChoic e.Caption  := 'Detail ed Inpatie nt Inquiry ';
  7251       PanelR eportChoic e.Visible  := True;
  7252       PanelR eportChoic e.BringToF ront;
  7253       FMList erAdmissio ns.PartLis t.Clear;
  7254       FMList erAdmissio ns.PartLis t.Add(Pati entIEN);
  7255       //FMLi sterAdmiss ions.GetLi st(FMListB oxAdmissio n.Items);
  7256       FMList BoxAdmissi on.GetList ;
  7257       If FML istBoxAdmi ssion.Item s.Count >  0 Then
  7258       Begin                                                                               //strip of f pt ien a nd anythin g not belo nging to p t.
  7259         For  x := FMLis tBoxAdmiss ion.Items. Count - 1  Downto 0 D o
  7260         Begi n
  7261           If  Pos(patie ntien + '   ', FMList BoxAdmissi on.Items[x ]) <> 1 Th en
  7262              FMListBoxA dmission.I tems.Delet e(x)
  7263           El se
  7264              FMListBoxA dmission.I tems[x] :=  Copy(FMLi stBoxAdmis sion.Items [x], Pos('   ', FMLis tBoxAdmiss ion.Items[ x]) + 4, 9 99);
  7265         End;
  7266       End;
  7267       If FML istBoxAdmi ssion.Item s.Count >  0 Then
  7268       Begin
  7269         FMLi stBoxAdmis sion.Visib le := Fals e;
  7270         For  x := FMLis tBoxAdmiss ion.Items. Count - 1  Downto 0 D o
  7271         Begi n
  7272           FM ListBoxAdm ission.Ite mIndex :=  x;
  7273           Ty peOfMoveme nt := Copy (FMListBox Admission. Items[x],  Pos('  ',  FMListBoxA dmission.I tems[x]) +  4, 255);
  7274           FM GetsMoveme ntType.IEN S := Copy( TypeOfMove ment, Pos( '  ', Type OfMovement ) + 4, 255 );
  7275           Ty peOfMoveme nt := Copy (TypeOfMov ement, 1,  Pos('  ',  TypeOfMove ment) - 1) ;
  7276           FM GetsMoveme ntType.Get AndFill;
  7277           If  Uppercase (FMEditMov ementType. Text) = 'A DMISSION'  Then
  7278           Be gin
  7279              FMEditMove mentWardLo cation.Tex t := 'UNKN OWN';
  7280              FMEditFaci lityMoveme ntType.Tex t := 'UNKN OWN';
  7281              FMGetsFaci lityMoveme ntType.IEN S := TypeO fMovement;
  7282              Try
  7283              FMGetsFaci lityMoveme ntType.Get AndFill Ex cept
  7284              End;
  7285              FMGetsPati entMovemen t.IENS :=  FMListBoxA dmission.G etSelected Record.IEN ;
  7286              Try
  7287              FMGetsPati entMovemen t.GetAndFi ll Except
  7288              End;
  7289              If FMEditM ovementWar dLocation. Text = ''  Then
  7290                FMEditMo vementWard Location.T ext := 'UN KNOWN';
  7291              FMListBoxA dmission.I tems[x] :=  FMDateTim eConvert(C opy(FMList BoxAdmissi on.Items[x ], 1, Pos( '  ', FMLi stBoxAdmis sion.Items [x]) - 1))  + '  ' +  FMEditFaci lityMoveme ntType.Tex t + '    T O:  ' +
  7292                FMEditMo vementWard Location.T ext;
  7293           En d
  7294           El se
  7295           Be gin
  7296              FMListBoxA dmission.I tems.Delet e(x);
  7297           En d;
  7298         End;
  7299         FMLi stBoxAdmis sion.ItemI ndex := 0;                                             // These t wo lines f orce the l ist to the  top
  7300         FMLi stBoxAdmis sion.ItemI ndex := -1 ;
  7301         FMLi stBoxAdmis sion.Visib le := True ;
  7302         FMLi stBoxAdmis sion.SetFo cus;
  7303       End
  7304       Else
  7305       Begin
  7306         FMLi stBoxAdmis sion.Items .Add('No a dmissions  found');
  7307       End;
  7308       If FML istBoxAdmi ssion.Item s.Count >  0 Then
  7309       Begin
  7310         FMLi stBoxAdmis sion.ItemI ndex := 0;
  7311         FMLi stBoxAdmis sion.SetFo cus;
  7312       End;
  7313       (*
  7314       {Use C PRS Visit  Loader ORW PT ADMITLS T}
  7315       RPCBro ker1.Remot eProcedure  := 'ORWPT  ADMITLST' ;
  7316       RPCBro ker1.Param [0].Value  := Patient IEN;
  7317       RPCBro ker1.Param [0].PType  := literal ;
  7318       RPCBro kerCall; t ry RPCBrok er1.Call;
  7319         exce pt
  7320       On EBr okerError  do
  7321         Show MessageCAP RI('Connec tion to se rver for O RWPT ADMIT LST could  not be est ablished!' );
  7322       end;
  7323       ListBo xReportCho ice.Items. Clear;
  7324       ListBo xReportCho iceHidden. Items.Clea r;
  7325       ListBo xReportCho iceHidden. Items:=RPC Broker1.Re sults;
  7326       If Lis tBoxReport ChoiceHidd en.Items.C ount=0 the n
  7327         List BoxReportC hoice.Item s.Add('No  admissions  found');
  7328       If lis tboxReport ChoiceHidd en.Items.C ount>0 the n for x:=0  to listbo xReportCho iceHidden. Items.Coun t-1 do beg in
  7329           li stboxRepor tChoice.It ems.Add(Co py(listbox ReportChoi ceHidden.I tems[x],Po s('^',list boxReportC hoiceHidde n.Items[x] )+1,254));
  7330           li stboxRepor tChoice.It ems[x]:=Co py(listbox ReportChoi ce.Items[x ],Pos('^', listboxRep ortChoice. Items[x])+ 1,254);
  7331           li stboxRepor tChoice.It ems[x]:=FM DateTimeCo nvert(Copy (listboxRe portChoice Hidden.Ite ms[x],1,Po s('^',list boxReportC hoiceHidde n.Items[x] )-1))+'  ' +Copy(list boxReportC hoice.Item s[x],1,Pos ('^',listb oxReportCh oice.Items [x])-1);
  7332       end;
  7333   *)
  7334     End;
  7335     StatusBa rLoadPt.Ca ption := ' Ready.';
  7336     StatusBa rLoadPt.Re paint;
  7337     Applicat ion.Proces smessages;
  7338     ANURemot eProcedure CallInProg ress := fa lse;
  7339     AnimateL ogo(False) ;
  7340   End;
  7341  
  7342   Procedure  TfrmMain.S howHIAUser DownloadWe bsite;
  7343   Var
  7344     HIAURL:  String;
  7345     tempserv er: String ;
  7346     tempport : integer;
  7347   Begin
  7348     tempServ er := RPCB roker1.Ser ver;
  7349     tempPort  := RPCBro ker1.Liste nerPort;
  7350     RPCBroke r1.Connect ed := Fals e;
  7351     RPCBroke r1.Server  := HomeSer ver;
  7352     RPCBroke r1.Listene rPort := S trToInt(Ho mePort);
  7353     //RPCBro ker1.Conne cted := tr ue;  BSE m od - rpm 1 /8/09
  7354     ConnectT oServer('D VBA CAPRI  GUI');
  7355  
  7356     //Get UR L
  7357     //CAPRI_ CodeCR95   - jcs - 05 /20/2010
  7358     if not C allRPC(RPC Broker1, ' DVBAB GET  URL', ['5' ], nil) th en
  7359       exit;
  7360     try
  7361       if RPC Broker1.Re sults.Coun t > 0 then
  7362         if R PCBroker1. Results[0]  <> '' the n
  7363         begi n
  7364           HI AURL := RP CBroker1.R esults[0];
  7365           // Code161 -  rpm 2/14/1 1 - change d text as  requested  by Brian O linger ema il 2/2/11
  7366           Sh owmessage( 'You have  been ident ified as a  Health In formation  Access (HI A) user.'
  7367              + #13#10 +  'You will  now be re directed t o the HIA  site to do wnload the  latest ve rsion of C APRI.');
  7368           if  Assigned( frmSplashS creen) the n
  7369              frmSplashS creen.Repa int;
  7370           Sh ellExecute (Handle, ' open', PAn siChar(HIA URL), nil,  nil, SW_S HOWNORMAL) ;
  7371         end;
  7372     except
  7373       ShowMe ssageCAPRI ('Unable t o access t he Health  Informatio n Access d ownload si te.');
  7374     End;
  7375  
  7376     RPCBroke r1.Connect ed := Fals e;
  7377     RPCBroke r1.Server  := TempSer ver;
  7378     RPCBroke r1.Listene rPort := T empPort;
  7379     //RPCBro ker1.Conne cted := tr ue;  BSE m od - rpm 1 /8/09
  7380     ConnectT oServer('D VBA CAPRI  GUI');
  7381   End;
  7382  
  7383   procedure  TfrmMain.a ctCapriHel pExecute(S ender: TOb ject);
  7384   begin
  7385     // launc h help COD E CR 381 - MER 6/2012
  7386     Applicat ion.HelpCo ntext(1);
  7387   end;
  7388  
  7389   procedure  TfrmMain.a ctCCRLaunc hExecute(S ender: TOb ject);
  7390   begin
  7391     try
  7392       frmCnt rctdExmMai n := TfrmC ntrctdExmM ain.Create (nil);
  7393       frmCnt rctdExmMai n.ShowModa l;
  7394  
  7395       Applic ation.Proc essMessage s;
  7396       ExamRe questRefre shClick(Ap plication) ;                                             finally
  7397       FreeAn dNil(frmCn trctdExmMa in);
  7398     end;
  7399   end;
  7400  
  7401   procedure  TfrmMain.a ctDevEditU serKeysExe cute(Sende r: TObject );
  7402   begin
  7403     UserKeys EditDialog ();
  7404   end;
  7405  
  7406   procedure  TfrmMain.a ctDevThrow ExceptExec ute(Sender : TObject) ;
  7407   Var
  7408     sgNotNum ber: Strin g;
  7409     inNumber : Integer;
  7410   Begin
  7411     sgNotNum ber := '1a bc2';
  7412     inNumber  := StrToI nt(sgNotNu mber);
  7413     ShowMess age(IntToS tr(inNumbe r));
  7414   end;
  7415  
  7416   procedure  TfrmMain.a ctDevUserK eysExecute (Sender: T Object);
  7417   begin
  7418     UserKeys Dialog;
  7419   end;
  7420  
  7421   procedure  TfrmMain.a ctEditCopy Execute(Se nder: TObj ect);
  7422   begin
  7423     FEditCtr l.CopyToCl ipboard;
  7424   end;
  7425  
  7426   procedure  TfrmMain.a ctEditCutE xecute(Sen der: TObje ct);
  7427   begin
  7428     FEditCtr l.CutToCli pboard;
  7429   end;
  7430  
  7431   procedure  TfrmMain.a ctEditPast eExecute(S ender: TOb ject);
  7432   begin
  7433     FEditCtr l.SelText  := Clipboa rd.AsText;
  7434   end;
  7435  
  7436   procedure  TfrmMain.a ctEditSele ctAllExecu te(Sender:  TObject);
  7437   begin
  7438     FEditCtr l.SelectAl l;
  7439   end;
  7440  
  7441   procedure  TfrmMain.a ctEditUndo Execute(Se nder: TObj ect);
  7442   begin
  7443     FEditCtr l.Perform( EM_UNDO, 0 , 0);
  7444   end;
  7445  
  7446   procedure  TfrmMain.a ctEditUpda te(Sender:  TObject);
  7447   Var
  7448     tempTMem oBox: TMem o;
  7449     tempTEdi t: TEdit;
  7450     tempTRic hEdit: TRi chEdit;
  7451   Begin
  7452     FEditCtr l := Nil;
  7453     If Scree n.ActiveCo ntrol Is T CustomEdit  Then
  7454       FEditC trl := TCu stomEdit(S creen.Acti veControl) ;
  7455     If Scree n.ActiveCo ntrol Is T RichEdit T hen
  7456       FEditC trlRichEdi t := TRich Edit(Scree n.ActiveCo ntrol);
  7457     If FEdit Ctrl <> Ni l Then
  7458     Begin
  7459       actEdi tUndo.Enab led := FEd itCtrl.Per form(EM_CA NUNDO, 0,  0) <> 0;
  7460       actEdi tCut.Enabl ed := FEdi tCtrl.SelL ength > 0;
  7461       actEdi tCopy.Enab led := act EditCut.En abled;
  7462       actPop ReadOnlyCo py.Enabled  := actEdi tCut.Enabl ed;
  7463       actPop ReadOnlySe lectAll.En abled := T rue;
  7464       actEdi tSelectAll .Enabled : = True;
  7465       actEdi tPaste.Ena bled := Cl ipboard.Ha sFormat(CF _TEXT);
  7466     End
  7467     Else
  7468     Begin
  7469       actEdi tUndo.Enab led := Fal se;
  7470       actEdi tCut.Enabl ed := Fals e;
  7471       actEdi tCopy.Enab led := Fal se;
  7472       actPop ReadOnlyCo py.Enabled  := False;
  7473       actPop ReadOnlySe lectAll.En abled := F alse;
  7474       actEdi tSelectAll .Enabled : = False;
  7475       actEdi tPaste.Ena bled := Fa lse;
  7476     End;
  7477     // Don't  let read  only memos  accept pa ste functi on
  7478     If FEdit Ctrl = Nil  Then
  7479       exit;
  7480     If (Uppe rcase(FEdi tCtrl.Clas sName) = ' TMEMO') Th en
  7481     Begin
  7482       tempTM emoBox :=  FEditCtrl  As TMemo;
  7483       If (te mpTMemoBox .Readonly  = True) Th en
  7484       Begin
  7485         actE ditUndo.En abled := F alse;
  7486         actE ditCut.Ena bled := Fa lse;
  7487         actE ditPaste.E nabled :=  False;
  7488       End;
  7489     End;
  7490     If (Uppe rcase(FEdi tCtrl.Clas sName) = ' TRICHEDIT' ) Then
  7491     Begin
  7492       tempTR ichEdit :=  FEditCtrl  As TRichE dit;
  7493       If (te mpTRichEdi t.Readonly  = True) T hen
  7494       Begin
  7495         actE ditUndo.En abled := F alse;
  7496         actE ditCut.Ena bled := Fa lse;
  7497         actE ditPaste.E nabled :=  False;
  7498       End;
  7499     End;
  7500     If (Uppe rcase(FEdi tCtrl.Clas sName) = ' TEDIT') Th en
  7501     Begin
  7502       tempTE dit := FEd itCtrl As  TEdit;
  7503       If (te mpTEdit.Re adonly = T rue) Then
  7504       Begin
  7505         actE ditUndo.En abled := F alse;
  7506         actE ditCut.Ena bled := Fa lse;
  7507         actE ditPaste.E nabled :=  False;
  7508       End;
  7509     End;
  7510   end;
  7511  
  7512   procedure  TfrmMain.a ctFileConn ectExecute (Sender: T Object);
  7513   Var
  7514     boReview erKey: Boo lean;
  7515     Flag: Bo olean;
  7516     FoundCPW MKey: Stri ng;
  7517     IsOldVer sionAllowe d: Boolean ;
  7518     Manifest Cnt: Integ er;                                                               // rpk 7/2 /2014
  7519     tempflag : boolean;
  7520     TempPort : Integer;
  7521     TempSend er: TActio n;
  7522     TempServ er: String ;
  7523     tempstri ng: String ;
  7524     TempStri ng2: Strin g;
  7525     TempStrP ort: Strin g;
  7526     TempStrS erver: Str ing;
  7527     versiona : real;
  7528     versionb : real;
  7529     versionr evisionst:  String;
  7530     versions hown: bool ean;
  7531     VistAVer sion: Stri ng;
  7532     x: integ er;
  7533     xversion a: real;
  7534     xversion b: real;
  7535     xversion revisionst : String;
  7536     xx: inte ger;
  7537     yy: inte ger;
  7538     zz: inte ger;
  7539     tempClie ntItem: TA ctionClien tItem;
  7540     aStream:  TMemorySt ream;
  7541     authToke n: string;
  7542     VDUrl: s tring;
  7543     edtstr:  String;
  7544     actnItem Separator:  TActionCl ientItem;                                              // CodeCR6 68 rpk 1/2 1/2015
  7545   Begin
  7546  
  7547     // Code  "1892890Dh doy*(@hDH2 8y(#*yUHKJ DH"
  7548  
  7549     If ANURe moteProced ureCallInP rogress =  True Then
  7550       exit;
  7551  
  7552     If CCOWM ode = Fals e Then
  7553     Try
  7554       If RPC Broker1.Co ntextor <>  Nil Then
  7555         RPCB roker1.Con textor :=  Nil;
  7556     Except
  7557     End;
  7558  
  7559     If Essov ersion = f alse Then
  7560       labelD ivision.vi sible := F alse;
  7561  
  7562     If Assig ned(formTI UDisplay)  Then
  7563     Begin
  7564       Try
  7565         form TIUDisplay .Visible : = False;
  7566         form TIUDisplay .Release;
  7567         form TIUDisplay  := Nil;
  7568       Except
  7569       End;
  7570     End;
  7571     If (actF ileConnect .caption =  '&Disconn ect...') A nd
  7572       Assign ed(PNCSFor m) Then
  7573     Begin
  7574       ShowMe ssage('Ple ase close  the open T emplate.') ;
  7575       PNCSFo rm.Show;
  7576       Exit;
  7577     End;
  7578  
  7579     //Animat eLogo(True );
  7580     TempSend er := Nil;
  7581  
  7582     If Upper case(Sende r.Classnam e) = 'TACT ION' Then
  7583     Begin
  7584       TempSe nder := Se nder As TA ction;
  7585     End;
  7586     versions hown := fa lse;
  7587  
  7588     If (actF ileConnect .Caption =  '&Connect ...') Or ( (Assigned( TempSender )) And (Te mpSender =  actFileSw itchSites) ) Then
  7589     Begin                                                                                 //connect
  7590  
  7591       // Dec  2005 Chuc k Sener Re ports that  the GUI s ometimes h angs at th is spot an d never
  7592       // shu ts down
  7593       // Put  in a 60 s econd time r and clos e CAPRI if  no connec tion in th at time.
  7594       TimerI nitialConn ection.Ena bled := Tr ue;
  7595  
  7596       If Swi tchToSite  = '' Then
  7597         If N ot Connect ToServer(' DVBA CAPRI  GUI') The n
  7598         Begi n
  7599           Sh uttingDown  := True;
  7600           ti merhalt.en abled := t rue;
  7601           ap plication. terminate;
  7602           ex it;
  7603         End;
  7604  
  7605       // If  it gets to  this spot , the conn ection wor ked, so tu rn off the  timer.
  7606       TimerI nitialConn ection.Ena bled := Fa lse;
  7607  
  7608       If Swi tchToSite  = '' Then
  7609         If R PCBroker1. Connected  = False Th en
  7610         Begi n
  7611           Sh owMessageC APRI('Coul d not use  option "DV BA CAPRI G UI!"');
  7612           // timerhalt. enabled:=t rue;
  7613           ap plication. terminate;
  7614           ex it;
  7615         End;
  7616       If for mESSOSelec t = Nil Th en
  7617       Begin
  7618         form ESSOSelect  := TformE SSOSelect. Create(frm Main);
  7619         Home Server :=  RPCBroker1 .Server;
  7620         Home Port := In ttoStr(RPC Broker1.Li stenerPort );
  7621         //Co deCR353 -  rpm 5/14/1 2
  7622         //Po pulate Vir tual VA UR L value on  initial c onnection  to home se rver
  7623         if C allRPC(RPC Broker1, ' DVBAB GET  URL', ['6' ], nil) th en
  7624         begi n
  7625           if  RPCBroker 1.Results. Count > 0  then
  7626           be gin
  7627              FVirtualVA URL := RPC Broker1.Re sults[0];
  7628            / /CodeCR353  - rpm 5/3 1/12
  7629            / /A URL res ult indica tes that w e can popu late the V irtual VA  TOKEN
  7630            / /value bec ause the s erver patc h is loade d at the s ite.
  7631              if (FVirtu alVAURL <>  '') then
  7632              begin
  7633                if CallR PC(RPCBrok er1, 'DVBA B GET VVA  TOKEN', [] , nil) the n
  7634                  if RPC Broker1.Re sults.Coun t > 0 then
  7635                    FVir tualVAToke n := RPCBr oker1.Resu lts[0];
  7636              end;
  7637           en d;
  7638         end;
  7639         if C allRPC(RPC Broker1, ' DVBAB GET  URL', ['7' ], nil) th en                    // CodeCR4 40 (AMIS29 0) JRL 11/ 15/12
  7640         begi n                                                                            // CodeCR4 40 (AMIS29 0) JRL 11/ 15/12
  7641           if  RPCBroker 1.Results. Count > 0  then                                        // CodeCR4 40 (AMIS29 0) JRL 11/ 15/12
  7642           be gin                                                                          // CodeCR4 40 (AMIS29 0) JRL 11/ 15/12
  7643              FAMIS290UR L := RPCBr oker1.Resu lts[0];                                     // CodeCR4 40 (AMIS29 0) JRL 11/ 15/12
  7644            / /If an URL  exists, t his indica tes that t he AMIS290         //  CodeCR440  (AMIS290)  JRL 11/15 /12
  7645            / /reports h ave been r eplaced.   New AMIS29 0 function ality   //  CodeCR440  (AMIS290)  JRL 11/15 /12
  7646            / /is found  at the URL  location                                //  CodeCR440  (AMIS290)  JRL 11/15 /12
  7647           en d;                                                                           // CodeCR4 40 (AMIS29 0) JRL 11/ 15/12
  7648         end;                                                                              // CodeCR4 40 (AMIS29 0) JRL 11/ 15/12
  7649  
  7650         if T IdHTTPVler .GetVlerDa sURL() = ' ' then                                      //could ha ve been se t via comm and line p aram     / /CodeCR500  JRL 9/10/ 13
  7651         begi n                                                                            //CodeCR50 0 JRL 9/10 /13
  7652           if  CallRPC(R PCBroker1,  'DVBAB GE T URL', [' 8'], nil)  then                  //CodeCR50 0 JRL 08/2 7/13
  7653           be gin                                                                          //CodeCR50 0 JRL 08/2 7/13
  7654              if RPCBrok er1.Result s.Count >  0 then                                      //CodeCR50 0 JRL 08/2 7/13
  7655              begin                                                                        //CodeCR50 0 JRL 08/2 7/13
  7656                TIdHTTPV ler.SetVle rDasURL(RP CBroker1.R esults[0]) ;                     //CodeCR?? ? LMS 2014 -07-21  Mo ving from  main form  field. Nee ds to be a vailable A pp wide in  all units  that need  VLER acce ss
  7657              end;                                                                         //CodeCR50 0 JRL 08/2 7/13
  7658           en d;                                                                           //CodeCR50 0 JRL 08/2 7/13
  7659         end;
  7660       End;
  7661  
  7662       
  7663       TempSe rver := RP CBroker1.S erver;
  7664       TempPo rt := RPCB roker1.Lis tenerPort;
  7665  
  7666       SetFon t;
  7667  
  7668       If frm MailMessag e = Nil Th en
  7669         frmM ailMessage  := TfrmMa ilMessage. Create(frm Main);
  7670  
  7671       If ESS OVersion =  True Then
  7672       Begin
  7673         Time OutTimer.E nabled :=  True;
  7674  
  7675         //CA PRI_CodeCR 95  - jcs  - 05/20/20 10
  7676         if n ot CallRPC (RPCBroker 1, 'XWB GE T VARIABLE  VALUE', [ 'DTIME'],  nil, True)  then
  7677           ex it;
  7678  
  7679         If T imeOutVal  < 0 Then                                                          // Need th is to keep  value fro m getting   reset whe n switchin g sites
  7680           Ti meOutVal : = StrToInt (RPCBroker 1.Results[ 0]);
  7681         If T imeOutVal  < 600 Then
  7682           Ti meOutVal : = 600;
  7683  
  7684         If f rmMailMan  = Nil Then
  7685         Begi n
  7686           //  Only chec k mail on  home serve r once at  start-up
  7687           fr mMailMan : = TfrmMail Man.Create (frmMain);
  7688  
  7689           {G et User DU Z}
  7690           // CAPRI_Code CR95  - jc s - 05/20/ 2010 - Why  are we ma king this  call?
  7691           if  not CallR PC(RPCBrok er1, 'XWB  GET VARIAB LE VALUE',  ['DUZ'],  nil, True)  then
  7692              exit;
  7693  
  7694           If  frmMailMa n = Nil Th en
  7695              frmMailMan  := TfrmMa ilMan.Crea te(frmMain );
  7696           se tfont;
  7697         End;
  7698  
  7699         setf ont;
  7700         form EssoSelect .StaticTex t1.Caption  := 'Selec t a site.' ;
  7701         Cont extorChang eMessage : = 'The app lication i s in the p rocess of  switching  VistA acco unts. If y ou continu e, CAPRI w ill drop o ut of the  clinical c ontext.';
  7702         CCOW BreakLink  := True;
  7703         Form EssoSelect .formstyle  := fsStay OnTop;
  7704  
  7705         If F ormEssoSel ect.Showmo dal = mrca ncel Then
  7706         Begi n                                                                            // Check f or cancel  button and  exit
  7707           If  ESSOIniti alized = T rue Then
  7708              If RPCBrok er1.Connec ted = True  Then
  7709                exit;
  7710           Sh uttingDown  := True;
  7711           Co ntextorCha ngeMessage  := '';
  7712           CC OWBreakLin k := False ;
  7713           ac tFileQuitE xecute(App lication);
  7714         End;
  7715         // C odeCR185 - MER 04/201 1
  7716         if A ssigned(Re flectionWr apper) the n
  7717           Re flectionWr apper.Term inateEmula tor;
  7718         // D rop telnet  connectio n if one e xists
  7719         If a ssigned(fr mTelnet) T hen
  7720           If  frmTelnet .bitbtnDis connect.Vi sible = Tr ue Then
  7721           Be gin
  7722              frmTelnet. Disconnect BtnClick(S elf);
  7723           En d;
  7724  
  7725         ESSO Connecting  := True;
  7726         ESSO Initialize d := True;
  7727  
  7728         If ( TempServer  = RPCBrok er1.Server ) And (Tem pPort = RP CBroker1.L istenerPor t) Then
  7729         Begi n
  7730           ex it;
  7731         End;
  7732  
  7733         Time rRemoteDat a.Enabled  := False;
  7734         List BoxRemoteD ataPending .Items.Cle ar;
  7735         If f rmMain.RPC Broker1.Se rver = ''  Then
  7736         Begi n
  7737           ap plication. terminate;
  7738         End;
  7739  
  7740         temp ClientItem  := Action ManMain.Fi ndItemByCa ption('Ex& ternal App lications' );
  7741         If A ssigned(te mpClientIt em) Then
  7742           te mpClientIt em.Visible  := True;
  7743  
  7744         //Se t HIA Sear ch menu It em under T ools menu  to enable  true
  7745         // M NJ - 09/10 /2012
  7746         actH IASearch.E nabled :=  True;
  7747       End
  7748       else
  7749       begin
  7750         temp ClientItem  := Action ManMain.Fi ndItemByCa ption('Ex& ternal App lications' );
  7751         If A ssigned(te mpClientIt em) Then
  7752           te mpClientIt em.Visible  := False;
  7753       end;
  7754  
  7755       If Not  ConnectTo Server('DV BA CAPRI G UI') Then
  7756       Begin
  7757         Show MessageCAP RI('Could  not use op tion "DVBA  CAPRI GUI !"');
  7758         appl ication.te rminate;
  7759       End;
  7760  
  7761       If RPC Broker1.Co nnected =  False Then
  7762       Begin
  7763         Show MessageCAP RI('Could  not use op tion "DVBA  CAPRI GUI !"');
  7764         appl ication.te rminate;
  7765       End;
  7766  
  7767       ESSOCo nnecting : = False;
  7768  
  7769       If RPC Broker1.Co nnected =  True Then
  7770       Begin
  7771         Time OutTimer.E nabled :=  True;
  7772         Pati entIEN :=  '';
  7773         pati entIENDOD  := '';
  7774  
  7775         frmM ain.Captio n := Progr amNameCapt ion;
  7776         Clea rForm;                                                                       //CodeCR24 8 - rpm 3/ 8/12 - cle ar the hea der and ta b set
  7777         If C COWMode =  True Then
  7778         Begi n
  7779           // If ESSOVer sion<>True  then begi n
  7780           //  Get local  station n umber
  7781           RP CBroker1.R emoteProce dure := 'D VBAB CCOW' ;
  7782           RP CBroker1.P aram[0].Va lue := '1' ;
  7783           RP CBroker1.P aram[0].PT ype := lit eral;
  7784           RP CBrokerCal l;
  7785           Tr y
  7786              RPCBroker1 .Call;
  7787           Ex cept
  7788              On EBroker Error Do
  7789              Begin
  7790                ANURemot eProcedure CallInProg ress := Fa lse;
  7791                AnimateL ogo(False) ;
  7792                StatusBa rLoadPt.Ca ption := ' DVBAB CCOW  could not  be access ed!';
  7793                Progress BarLoadPt. Repaint;
  7794                frmMain. Repaint;
  7795                ShowMess ageCAPRI(' DVBAB CCOW  could not  be access ed!');
  7796                applicat ion.termin ate;
  7797                applicat ion.termin ate;
  7798              End;
  7799           En d;
  7800           Lo calStation Number :=  Piece(RPCB roker1.Res ults[0], ' ^', 3);
  7801  
  7802           //  Get Test  system sta tus
  7803           RP CBroker1.R emoteProce dure := 'D VBAB CCOW' ;
  7804           RP CBroker1.P aram[0].Va lue := '2' ;
  7805           RP CBroker1.P aram[0].PT ype := lit eral;
  7806           RP CBrokerCal l;
  7807           Tr y
  7808              RPCBroker1 .Call;
  7809           Ex cept
  7810              On EBroker Error Do
  7811              Begin
  7812                ANURemot eProcedure CallInProg ress := Fa lse;
  7813                AnimateL ogo(False) ;
  7814                StatusBa rLoadPt.Ca ption := ' DVBAB CCOW  could not  be access ed!';
  7815                Progress BarLoadPt. Repaint;
  7816                frmMain. Repaint;
  7817                ShowMess ageCAPRI(' DVBAB CCOW  could not  be access ed!');
  7818                applicat ion.termin ate;
  7819                applicat ion.termin ate;
  7820              End;
  7821           En d;
  7822           Te stSystemLo gin := RPC Broker1.Re sults[0];
  7823           // End;
  7824         End;
  7825  
  7826         {Rel oad Divisi ons and In stitutions  on New Sy stem}
  7827         frmS PlashScree n := TfrmS plashScree n.Create(f rmMain);
  7828         frmS plashScree n.PanelVer sion.Heigh t := Panel 1.Height;
  7829         frmS plashScree n.PanelVer sion.Capti on := Vers ionUser;
  7830         frmS plashScree n.PanelVer sion.Left  := (frmSPl ashScreen. Width Div  2) - (frmS PlashScree n.PanelVer sion.Width  Div 2);
  7831         frmS PlashScree n.StatusLa bel.Height  := Panel1 .Height;
  7832         frmS PlashScree n.Shape1.H eight := P anel1.Heig ht;
  7833         frmS PlashScree n.GaugeLoa dSite.Prog ress := 0;
  7834         frmS PlashScree n.GaugeLoa dSite.Fore Color := c lRed;
  7835         frmS PlashScree n.GaugeLoa dSite.Top  := frmSPla shScreen.S hape1.Top  + frmSPlas hScreen.Sh ape1.Heigh t;
  7836         frmS PlashScree n.Height : = frmSPlas hScreen.Ga ugeLoadSit e.Top + 32 ;
  7837         frmS PlashScree n.Panel1.H eight := f rmSPlashSc reen.Gauge LoadSite.T op + 33;
  7838         frmS PlashScree n.StatusLa bel.Font : = panel1.f ont;
  7839         frmS plashScree n.Show;
  7840         frmS plashScree n.Repaint;                                                        //added -  rpm 3/18/0 9
  7841  
  7842         // P ull up fil e from cen tral direc tory, if e xists.
  7843         // A llows user  to be not ified of u pgrades, e tc.
  7844  
  7845         // G et Home Sy stem Data  for Restri cted Pt Li st
  7846         If ( EssoLoginY et <> True ) And (ESS OVersion =  true) And  (listRest rictedPati ents.count  = 0) Then
  7847         Begi n
  7848  
  7849           Es soLoginYet  := True;
  7850  
  7851           fr mSplashScr een.Status Label.Capt ion := 'Ch ecking for  restricti ons...';
  7852           fr mSplashScr een.Repain t;
  7853           Te mpStrServe r := Upper case(RPCBr oker1.ANUS trServer);
  7854           Te mpStrPort  := RPCBrok er1.ANUStr Port;
  7855           RP CBroker1.C onnected : = False;
  7856           RP CBroker1.S erver := R PCBroker1. ANUStrServ erHome;
  7857           RP CBroker1.L istenerPor t := Strto Int(RPCBro ker1.ANUSt rPortHome) ;
  7858           // RPCBroker1 .Connected  := True;   BSE mod -  rpm 1/8/0 9
  7859           // If Not Aut horizedOpt ion('DVBA  CAPRI GUI' ) then beg in  BSE mo d - rpm 1/ 8/09
  7860           If  Not Conne ctToServer ('DVBA CAP RI GUI') T hen
  7861           Be gin
  7862              ShowMessag eCAPRI('Co uld not us e option " DVBA CAPRI  GUI!"');
  7863              applicatio n.terminat e;
  7864           En d;
  7865  
  7866           // Populate T ools
  7867           FM ListBoxCAP RITools.Ge tList;
  7868  
  7869           If  FMListBox CAPRITools .Items.Cou nt > 0 The n
  7870           Be gin
  7871              For xx :=  0 To FMLis tBoxCAPRIT ools.Items .Count - 1  Do
  7872              Begin
  7873                TempActi on[xx] :=  TAction.Cr eate(Actio nManMain);
  7874                TempActi on[xx].OnE xecute :=  frmMain.te mpToolClic k;
  7875                TempActi on[xx].Cap tion := Pi ece(FMList BoxCAPRITo ols.Items[ xx], ';',  2);
  7876                TempActi on[xx].Nam e := 'NewT ool' + int tostr(xx);
  7877                TempActi on[xx].Cat egory := ' External A pplication s';
  7878                //Add we blink URL,  if approp riate
  7879                If (pos( 'HTTP://',  uppercase (FMListBox CAPRITools .Items[xx] )) > 0) or
  7880                  (pos(' HTTPS://',  uppercase (FMListBox CAPRITools .Items[xx] )) > 0) Th en
  7881                  TempAc tion[xx].I mageIndex  := 15
  7882                else
  7883                  TempAc tion[xx].I mageIndex  := -1;
  7884  
  7885                tempActi on[xx].Act ionList :=  ActionMan Main;
  7886                with Act ionManMain .ActionBar s[0].Items [2].Items[ 6].Items.A dd do
  7887                  Action  := tempAc tion[xx];
  7888              End;
  7889           En d;
  7890  
  7891           fr mSPlashScr een.GaugeL oadSite.Pr ogress :=  5;
  7892           {G et User DU Z}
  7893           // CAPRI_Code CR95  - jc s - 05/20/ 2010
  7894           if  not CallR PC(RPCBrok er1, 'XWB  GET VARIAB LE VALUE',  ['DUZ'],  nil, True)  then
  7895              exit;
  7896  
  7897           Us erDUZHomeS erver := R PCBroker1. Results[0] ;
  7898           // Get Securi ty Keys
  7899           Us erKeys.Cle ar;
  7900           FM ListerUser Keys.IENS  := ',' + U serDUZHome Server;
  7901           FM ListerUser Keys.GetLi st(UserKey s);
  7902  
  7903           FM Gets1.IENS  := UserDU ZHomeServe r;
  7904           FM Gets1.GetD ata;
  7905           ho meemailadd ress := lo wercase(fm gets1.GetF ield('.151 ').FMDBExt ernal);
  7906           // Make sure  .151 in th e new pers on file ha s an entry
  7907           If  Homeemail address =  '' Then
  7908           Be gin
  7909              {Init Mail }
  7910              {Get User  E-Mail Add ress on Ho me Server}
  7911              RPCBroker1 .RemotePro cedure :=  'DVBAB MAI L INIT';
  7912              RPCBrokerC all;
  7913              Try
  7914                RPCBroke r1.Call;
  7915                homeemai laddress : = lowercas e(Piece(RP CBroker1.R esults[0],  '^', 1));
  7916  
  7917                frmForwa rdingAddre ss := Tfrm Forwarding Address.Cr eate(frmMa in);
  7918                frmForwa rdingAddre ss.Edit1.t ext := 'NO NE SPECIFI ED';
  7919                frmForwa rdingAddre ss.RadioBu tton3.Visi ble := Fal se;
  7920                frmForwa rdingAddre ss.RadioBu tton1.Capt ion := low ercase(hom eemailaddr ess);
  7921                frmForwa rdingAddre ss.ShowMod al;
  7922                If frmFo rwardingAd dress.Radi oButton1.C hecked = T rue Then
  7923                Begin
  7924                  homeem ailaddress  := lowerc ase(frmFor wardingAdd ress.Radio Button1.Ca ption);
  7925                End;
  7926                If frmFo rwardingAd dress.Radi oButton2.C hecked = T rue Then
  7927                Begin
  7928                  homeem ailaddress  := lowerc ase(frmFor wardingAdd ress.editO therEmailA ddress.tex t);
  7929                  // Use  specified  e-mail ad dress
  7930                End;
  7931                // Updat e .151 fie ld next
  7932                FMFiler2 .AddFDA('2 00', UserD UZHomeServ er, '.151' , HomeEMai lAddress);
  7933                If Not f mfiler2.Up date Then
  7934                Begin
  7935                  fmfile r2.Display Errors;
  7936                End;
  7937                frmForwa rdingAddre ss.Release ;
  7938                frmForwa rdingAddre ss := Nil;
  7939              Except On  EBrokerErr or Do
  7940                Begin
  7941                  ANURem oteProcedu reCallInPr ogress :=  False;
  7942                  Animat eLogo(Fals e);
  7943                  Status BarLoadPt. Caption :=  'Mail Ini t not comp leted.';
  7944                  Status BarLoadPt. Repaint;
  7945                  Applic ation.Proc essmessage s;
  7946                End;
  7947              End;
  7948           En d;
  7949  
  7950           {G et User Fi lemanCode}
  7951           // CAPRI_Code CR95  - jc s - 05/20/ 2010
  7952           if  not CallR PC(RPCBrok er1, 'XWB  GET VARIAB LE VALUE',  ['DUZ(0)' ], nil, Tr ue) then
  7953              exit;
  7954  
  7955           If  RPCBroker 1.Results. Count > 0  Then
  7956              UserFilema nCode := R PCBroker1. Results[0]
  7957           El se
  7958              UserFilema nCode := ' ';
  7959  
  7960           // Check for  restricted
  7961           Li stRestrict edPatients .Clear;
  7962           {G et Divisio n}
  7963           RP CBroker1.R emoteProce dure := 'D VBAB DIVIS ION';
  7964           RP CBrokerCal l;
  7965           Tr y
  7966              RPCBroker1 .Call;
  7967           Ex cept
  7968              On EBroker Error Do
  7969              Begin
  7970                ANURemot eProcedure CallInProg ress := Fa lse;
  7971                AnimateL ogo(False) ;
  7972                StatusBa rLoadPt.Ca ption := ' RPC DVBAB  DIVISION c ould not b e accessed !';
  7973                StatusBa rLoadPt.Re paint;
  7974                Applicat ion.Proces smessages;
  7975                ShowMess ageCAPRI(' DVBAB DIVI SION could  not be ac cessed!');
  7976              End;
  7977           En d;
  7978           If  RPCBroker 1.Results. Count = 0  Then
  7979           Be gin
  7980              ShowMessag eCAPRI('Yo u have not  been give n a divisi on.  Pleas e contact  IRM for as sistance.' );
  7981              applicatio n.terminat e;
  7982           En d;
  7983  
  7984           fr mSPlashScr een.GaugeL oadSite.Pr ogress :=  10;
  7985           Us erDivision  := RPCBro ker1.Resul ts[0];
  7986  
  7987  
  7988           // CAPRI_Code CR95  - jc s - 05/20/ 2010
  7989           if  not CallR PC(RPCBrok er1, 'XWB  GET VARIAB LE VALUE',  ['DUZ("2" )'], nil,  True) then
  7990              exit;
  7991  
  7992           Re moteUserDi visionNumb er := '';
  7993           FM GetsInstit ution.IENS  := RPCBro ker1.Resul ts[0];
  7994           //  Check to  be sure di vision doe sn't come  back as "1 ".
  7995           //  If it doe s, read lo cal field  999000, wh ich is an  override v alue
  7996           //  for divis ion.
  7997           FM GetsCAPRID ivision.IE NS := User DUZHomeSer ver;
  7998           FM GetsCAPRID ivision.Ge tData;
  7999           te mpflag :=  false;
  8000           Tr y
  8001              If fmgetsC APRIDivisi on.GetFiel d('999000' ).FMDBExte rnal <> ''  Then
  8002           te mpflag :=  true Excep t tempflag  := false;
  8003           En d;
  8004           If  tempflag  = true The n
  8005           Be gin
  8006              UserDivisi on := Piec e(uppercas e(fmgetsCA PRIDivisio n.GetField ('999000') .FMDBExter nal), ';',  2);
  8007              UserDivisi onNumber : = Piece(up percase(fm getsCAPRID ivision.Ge tField('99 9000').FMD BExternal) , ';', 1);
  8008              RemoteUser DivisionNu mber := Pi ece(upperc ase(fmgets CAPRIDivis ion.GetFie ld('999000 ').FMDBExt ernal), '; ', 1);
  8009           En d
  8010           El se
  8011           Be gin
  8012              // Convert  RPCBroker  results t o field 99  of instit ution file
  8013              FMGetsInst itution.Ge tData;
  8014              UserDivisi onNumber : = FMGetsIn stitution. GetField(' 99').FMDBE xternal;
  8015              RemoteUser DivisionNu mber := FM GetsInstit ution.GetF ield('99') .FMDBExter nal;
  8016           En d;
  8017  
  8018           If  (RemoteUs erDivision Number = ' ') Or (Rem oteUserDiv isionNumbe r = '1') T hen
  8019           Be gin
  8020              Showmessag e('There w as a probl em detecti ng your di vision.  P lease noti fy IT supp ort.');
  8021              applicatio n.terminat e;
  8022           En d;
  8023  
  8024           //  Strip "-"  off end
  8025           Te mpString : = '';
  8026           If  Length(Us erDivision ) > 0 Then
  8027              For x := l ength(user division)  Downto 1 D o
  8028                If Userd ivision[x]  = '-' The n
  8029                  If (te mpstring =  '') Or (p os('-BVA/V BA', temps tring) > 0 ) Then
  8030                    temp string :=  Copy(Userd ivision, 1 , x - 1);
  8031           If  TempStrin g <> '' Th en
  8032              UserDivisi on := Temp String;
  8033           //  --HERE--* ********** **********
  8034  
  8035  
  8036           // CAPRI_Code CR95  - jc s - 05/20/ 2010
  8037           if  not CallR PC(RPCBrok er1, 'XWB  GET VARIAB LE VALUE',  ['DUZ'],  nil, True)  then
  8038              exit;
  8039  
  8040           FM GetsNewPer son.IENS : = RPCBroke r1.Results [0];
  8041           fr mSPlashScr een.GaugeL oadSite.Pr ogress :=  15;
  8042           FM GetsNewPer son.GetAnd Fill;
  8043  
  8044           Us erHomePrim aryMenu :=  FMGetsNew Person.Get Field('201 ').FMDBExt ernal;
  8045           FP rimaryMenu Assignable  := IsPrim aryMenuAss ignable(Us erHomePrim aryMenu);  //CodeCR10 9 - rpm 8/ 4/10
  8046           Re strictedPt Selection  := FMGetsN ewPerson.G etField('1 01.01').FM DBExternal ;
  8047           Pa tientSelec tionList : = FMGetsNe wPerson.Ge tField('10 1.02').FMD BInternal;
  8048           If  Restricte dPtSelecti on = '' Th en
  8049              Restricted PtSelectio n := 'N';
  8050           If  (Restrict edPtSelect ion[1] = ' Y') And (U ppercase(P atientSele ctionList)  = '') The n
  8051           Be gin
  8052              ShowMessag eCAPRI('Yo u are rest ricted to  a set of p atients bu t have no  patient se lection li st.');
  8053              applicatio n.terminat e;
  8054           En d;
  8055  
  8056           //  1/11/06
  8057           Re strictedPt Selection  := 'N';
  8058           If  Restricte dPtSelecti on[1] = 'Y ' Then
  8059           Be gin
  8060  
  8061              frmSplashS creen.Stat usLabel.Ca ption := ' Getting re stricted p atient lis t...';
  8062              frmSPlashS creen.Gaug eLoadSite. Progress : = 18;
  8063              frmSplashS creen.Repa int;
  8064              {Get User  DUZ on Hom e System}
  8065              RPCBroker1 .RemotePro cedure :=  'DVBAB TEA M PATIENTS ';
  8066              RPCBroker1 .Param[0]. Value := P atientSele ctionList;
  8067              RPCBroker1 .Param[0]. PType := l iteral;
  8068              RPCBrokerC all;
  8069              Try
  8070                RPCBroke r1.Call;
  8071              Except
  8072                On EBrok erError Do
  8073                Begin
  8074                  ANURem oteProcedu reCallInPr ogress :=  False;
  8075                  Animat eLogo(Fals e);
  8076                  Status BarLoadPt. Caption :=  'RPC DVBA B TEAM PAT IENTS coul d not be a ccessed!';
  8077                  Status BarLoadPt. Repaint;
  8078                  Applic ation.Proc essmessage s;
  8079                  ShowMe ssageCAPRI ('DVBAB TE AM PATIENT S could no t be acces sed!');
  8080                End;
  8081              End;
  8082              QuickCopy( frmMain.RP CBroker1.R esults, li stRestrict edPatients );
  8083              If RPCBrok er1.Result s.Count =  0 Then
  8084              Begin
  8085                ShowMess ageCAPRI(' Your restr icted pati ent list i s empty.') ;
  8086                applicat ion.termin ate;
  8087              End;
  8088              If Upperca se(listRes trictedPat ients[0])  = '^NO PAT IENTS FOUN D.' Then
  8089              Begin
  8090                ShowMess ageCAPRI(' You are re stricted t o a set of  patients  but have n o patients  on your l ist.');
  8091                applicat ion.termin ate;
  8092              End;
  8093           En d;
  8094  
  8095           RP CBroker1.C onnected : = False;
  8096           RP CBroker1.S erver := T empStrServ er;
  8097           RP CBroker1.L istenerPor t := Strto Int(TempSt rPort);
  8098           // RPCBroker1 .Connected  := True;   BSE mod -  rpm 1/8/0 9
  8099           // If Not Aut horizedOpt ion('DVBA  CAPRI GUI' ) Then  BS E mod - rp m 1/8/09
  8100           if  not Conne ctToServer ('DVBA CAP RI GUI') t hen
  8101           Be gin
  8102              ShowMessag eCAPRI('Co uld not us e option " DVBA CAPRI  GUI!"');
  8103              applicatio n.terminat e;
  8104           En d;
  8105         End;
  8106  
  8107         {Get  User DUZ}
  8108  
  8109         //CA PRI_CodeCR 95  - jcs  - 05/20/20 10
  8110         if n ot CallRPC (RPCBroker 1, 'XWB GE T VARIABLE  VALUE', [ 'DUZ'], ni l, True) t hen
  8111           ex it;
  8112  
  8113         Auth orIEN := ' ';
  8114         If R PCBroker1. Results.Co unt > 0 Th en
  8115           Au thorIEN :=  RPCBroker 1.Results[ 0];
  8116         If E SSOVersion  = False T hen
  8117         Begi n
  8118           // Get Securi ty Keys
  8119           Us erKeys.Cle ar;
  8120           If  AuthorIEN  <> '' The n
  8121              FMListerUs erKeys.IEN S := ',' +  AuthorIEN ;
  8122           FM ListerUser Keys.GetLi st(UserKey s);
  8123         End;
  8124         User KeysStr :=  UserKeys. Text;
  8125         FMGe ts1.IENS : = AuthorIE N;
  8126         FMGe ts1.GetAnd Fill;
  8127         loca lemailaddr ess := fmg ets1.GetFi eld('.151' ).FMDBExte rnal;
  8128         Auth orSSN := F MGets1.Get Field('9') .FMDBInter nal;
  8129         Auth orName :=  FMGets1.Ge tField('.0 1').FMDBEx ternal;
  8130  
  8131         If E SSOVersion  = False T hen
  8132         Begi n
  8133           {G et Divisio n}
  8134           RP CBroker1.R emoteProce dure := 'D VBAB DIVIS ION';
  8135           RP CBrokerCal l;
  8136           Tr y
  8137              RPCBroker1 .Call;
  8138           Ex cept
  8139              On EBroker Error Do
  8140              Begin
  8141                ANURemot eProcedure CallInProg ress := Fa lse;
  8142                AnimateL ogo(False) ;
  8143                StatusBa rLoadPt.Ca ption := ' RPC DVBAB  DIVISION c ould not b e accessed !';
  8144                StatusBa rLoadPt.Re paint;
  8145                Applicat ion.Proces smessages;
  8146                ShowMess ageCAPRI(' DVBAB DIVI SION could  not be ac cessed!');
  8147              End;
  8148           En d;
  8149           If  RPCBroker 1.Results. Count = 0  Then
  8150           Be gin
  8151              ShowMessag eCAPRI('Yo u have not  been give n a divisi on.  Pleas e contact  IRM for as sistance.' );
  8152              applicatio n.terminat e;
  8153           En d;
  8154           fr mSPlashScr een.GaugeL oadSite.Pr ogress :=  22;
  8155           Us erDivision  := RPCBro ker1.Resul ts[0];
  8156  
  8157  
  8158           // CAPRI_Code CR95  - jc s - 05/20/ 2010
  8159           if  not CallR PC(RPCBrok er1, 'XWB  GET VARIAB LE VALUE',  ['DUZ(2)' ], nil, Tr ue) then
  8160              exit;
  8161  
  8162           //  Convert R PCBroker r esults to  field 99 o f institut ion file
  8163           FM GetsInstit ution.IENS  := RPCBro ker1.Resul ts[0];
  8164           FM GetsInstit ution.GetD ata;
  8165           Us erDivision Number :=  FMGetsInst itution.Ge tField('99 ').FMDBExt ernal;
  8166  
  8167           //  Strip "-"  off end
  8168           Te mpString : = '';
  8169           If  Length(Us erDivision ) > 0 Then
  8170              For x := l ength(user division)  Downto 1 D o
  8171                If Userd ivision[x]  = '-' The n
  8172                  If (te mpstring =  '') Or (p os('-BVA/V BA', temps tring) > 0 ) Then
  8173                    temp string :=  Copy(Userd ivision, 1 , x - 1);
  8174           If  TempStrin g <> '' Th en
  8175              UserDivisi on := Temp String;
  8176  
  8177           {G et User Fi lemanCode}
  8178           // CAPRI_Code CR95  - jc s - 05/20/ 2010
  8179           if  not CallR PC(RPCBrok er1, 'XWB  GET VARIAB LE VALUE',  ['DUZ(0)' ], nil, Tr ue) then
  8180              exit;
  8181  
  8182           If  RPCBroker 1.Results. Count > 0  Then
  8183              UserFilema nCode := R PCBroker1. Results[0]
  8184           El se
  8185              UserFilema nCode := ' ';
  8186         end;
  8187  
  8188         {tel net stuff  ---------- ---------- ---------- ---------- ---------- ---}
  8189         // U sed only i n CAPRI Re mote
  8190         // 2 01 = Prima ry Menu
  8191         // 7  = DISUSER  - User no t allowed  to log on
  8192         // 9 .2 = Termi nation dat e
  8193         User RemoteDISU SER := '';
  8194         User RemoteTerm inationDat e := '';
  8195         User RemotePrim aryMenu :=  '';
  8196  
  8197         If e ssoversion  = true Th en
  8198         Begi n
  8199           FM GetsNewPer son.IENS : = AuthorIE N;
  8200           FM GetsNewPer son.GetDat a;
  8201  
  8202           //  If error  reading th is, let th e user in  the system  anyway
  8203           Us erRemoteDI SUSER := F MGetsNewPe rson.GetFi eld('7').F MDBInterna l;
  8204           Us erRemoteTe rminationD ate := FMG etsNewPers on.GetFiel d('9.2').F MDBInterna l;
  8205           Us erRemotePr imaryMenu  := FMGetsN ewPerson.G etField('2 01').FMDBE xternal;
  8206  
  8207           //  Check is  user is HI A User.
  8208           //  The essos elector co ntrols pop ulating th e FMGetsCo mponent
  8209           tr y                                                                            //protect  against mi ssing fiel d #4 in fi le #396.96  - rpm 10/ 22/08
  8210              if formESS OSelect.FM GetsUserSi tes.GetFie ld('4').FM DBInternal  = 'Y' The n
  8211                UserRemo teHIAUser  := True
  8212              else
  8213                UserRemo teHIAUser  := False;
  8214  
  8215              if formEss oSelect.FM GetsUserSi tes.GetFie ld('5').FM DBInternal  = 'Y' the n
  8216                FIsDoDUs er := True
  8217              else
  8218                FIsDoDUs er := Fals e;
  8219           ex cept
  8220              //do nothi ng
  8221           en d;
  8222         End;
  8223         {--- ---------- ---------- ---------- ---------- ---------- ---------- ---}
  8224  
  8225         frmS plashScree n.StatusLa bel.Captio n := 'Chec king versi on...';
  8226   //      fr mSPlashScr een.GaugeL oadSite.Pr ogress :=  25;
  8227         frmS PlashScree n.GaugeLoa dSite.Prog ress := 20 ;
  8228         frmS plashScree n.Repaint;
  8229         RPCB roker1.Rem oteProcedu re := 'DVB AB VERSION ';
  8230         RPCB roker1.Par am[0].Valu e := Versi onUser;
  8231         RPCB roker1.Par am[0].PTyp e := liter al;
  8232         RPCB rokerCall;
  8233         Try
  8234           RP CBroker1.C all;
  8235         Exce pt
  8236           On  EBrokerEr ror Do
  8237           Be gin
  8238              ANURemoteP rocedureCa llInProgre ss := Fals e;
  8239              AnimateLog o(False);
  8240              StatusBarL oadPt.Capt ion := 'RP C DVBAB VE RSION coul d not be a ccessed!';
  8241              StatusBarL oadPt.Repa int;
  8242              Applicatio n.Processm essages;
  8243              ShowMessag eCAPRI('DV BAB VERSIO N could no t be acces sed!');
  8244              applicatio n.terminat e;
  8245           En d;
  8246         End;
  8247         If R PCBroker1. Results.Co unt > 0 Th en
  8248         Begi n
  8249   //      bu ffer := RP CBroker1.R esults[0];
  8250   //      Sh owMessage( buffer);
  8251           Vi stAVersion  := Piece( RPCBroker1 .Results[0 ], '^', 1) ;
  8252           Ve rsionA :=  StrToFloat (Piece(Vis tAVersion,  '*', 2));
  8253           Ve rsionB :=  StrToFloat (Piece(Vis tAVersion,  '*', 3));
  8254           Ve rsionRevis ionSt := P iece(VistA Version, ' *', 4);
  8255           XV ersionA :=  StrToFloa t(Piece(Ve rsion, '*' , 2));
  8256           XV ersionB :=  StrToFloa t(Piece(Ve rsion, '*' , 3));
  8257           XV ersionRevi sionSt :=  Piece(Vers ion, '*',  4);
  8258  
  8259           if  Uppercase (Piece(RPC Broker1.Re sults[0],  '^', 2)) =  'NOOLD' t hen
  8260              IsOldVersi onAllowed  := False
  8261           el se
  8262              IsOldVersi onAllowed  := True;
  8263  
  8264           If  Piece(RPC Broker1.Re sults[0],  '^', 3) =  'SURGERY'  Then
  8265              AllowSurge ryReport : = True
  8266           El se
  8267              AllowSurge ryReport : = False;
  8268           //  Go ahead  and hardco de this
  8269           Al lowSurgery Report :=  True;
  8270           //  Make 45*1  compatibl e with 41* 1 too
  8271           //  12/5/02 -  Turn off  compatibil ity.  Requ ire newest  patch.
  8272           // ShowMessag eCAPRI(flo attostr(xv ersiona)+'  '+floatto str(xversi onb));
  8273           If  FloatToSt r(VersionA ) = '41' T hen
  8274              If FloatTo Str(Versio nB) = '1'  Then
  8275                XVersion A := 41;
  8276           If  XVersionA  < Version A Then
  8277           Be gin
  8278              If Version Shown = Fa lse Then
  8279                ShowMess ageCAPRI(' Your clien t software  is older  than the s erver on V istA.  Ple ase contac t IRM for  assistance .  VistA i s running  ' + VistAV ersion);
  8280              if NOT IsO ldVersionA llowed the n
  8281              begin
  8282                //ShowMe ssageCAPRI ('Old vers ions of CA PRI will n ot run fro m this ser ver.');
  8283                ShowMess ageCAPRI(
  8284                  'Versi ons of CAP RI prior t o DVBA*2.7 *' + Float ToStr(Vers ionA) + '  will not r un from th is server. ' + #13 +  #10 +
  8285                  'You a re current ly running  DVBA*2.7* ' + FloatT oStr(XVers ionA) + '. ');
  8286                if Assig ned(frmSpl ashScreen)  then
  8287                  frmSpl ashScreen. Repaint;
  8288                if UserR emoteHIAUs er = True  then
  8289                  ShowHI AUserDownl oadWebsite ;
  8290                applicat ion.termin ate;
  8291              end;
  8292              VersionSho wn := True ;
  8293           En d;
  8294           If  XVersionA  = Version A Then
  8295              If XVersio nB < Versi onB Then
  8296              Begin
  8297                If Versi onShown =  False Then
  8298                  ShowMe ssageCAPRI ('Your cli ent softwa re is olde r than the  server on  VistA.  P lease cont act IRM fo r assistan ce.  VistA  is runnin g ' + Vist AVersion);
  8299                if NOT I sOldVersio nAllowed t hen
  8300                begin
  8301                  //Show MessageCAP RI('Old ve rsions of  CAPRI will  not run f rom this s erver.');
  8302                  ShowMe ssageCAPRI (
  8303                    'Ver sions of C APRI prior  to DVBA*2 .7*' + Flo atToStr(Ve rsionA) +  ' will not  run from  this serve r.' + #13  + #10 +
  8304                    'You  are curre ntly runni ng DVBA*2. 7*' + Floa tToStr(XVe rsionA) +  '.');
  8305                  if Use rRemoteHIA User = Tru e Then
  8306                    Show HIAUserDow nloadWebsi te;
  8307                  applic ation.term inate;
  8308                end;
  8309                VersionS hown := Tr ue;
  8310              End;
  8311           If  (VersionS hown = Fal se) And (X VersionRev isionSt <  VersionRev isionSt) T hen
  8312           Be gin
  8313              If Version Shown = Fa lse Then
  8314                ShowMess ageCAPRI(' Your clien t software  is older  than the s erver on V istA.  Ple ase contac t IRM for  assistance .  VistA i s running  ' + VistAV ersion);
  8315              if NOT IsO ldVersionA llowed the n
  8316              begin
  8317                //ShowMe ssageCAPRI ('Old vers ions of CA PRI will n ot run fro m this ser ver.');
  8318                ShowMess ageCAPRI(
  8319                  'Versi ons of CAP RI prior t o DVBA*2.7 *' + Float ToStr(Vers ionA) + '  will not r un from th is server. ' + #13 +  #10 +
  8320                  'You a re current ly running  DVBA*2.7* ' + FloatT oStr(XVers ionA) + '. ');
  8321                if UserR emoteHIAUs er = True  Then
  8322                  ShowHI AUserDownl oadWebsite ;
  8323                applicat ion.termin ate;
  8324              end;
  8325           En d;
  8326         End
  8327         Else
  8328         Begi n
  8329           If  VersionSh own = Fals e Then
  8330              ShowMessag eCAPRI('Th e version  loaded in  VistA is c orrupt or  old.  Plea se contact  IRM for a ssistance.   You may  continue u sing CAPRI , but ther e could be  problems  while logg ed into th is system. ');
  8331         End;
  8332  
  8333         // R estricted  patient li st for non -remote ve rsion
  8334         If E ssoVersion  = False T hen
  8335         Begi n
  8336           FM GetsNewPer son.IENS : = AuthorIE N;
  8337           FM GetsNewPer son.GetAnd Fill;
  8338           Re strictedPt Selection  := FMGetsN ewPerson.G etField('1 01.01').FM DBExternal ;
  8339           Pa tientSelec tionList : = FMGetsNe wPerson.Ge tField('10 1.02').FMD BInternal;
  8340           If  Restricte dPtSelecti on = '' Th en
  8341              Restricted PtSelectio n := 'N';
  8342           If  (Restrict edPtSelect ion[1] = ' Y') And (U ppercase(P atientSele ctionList)  = '') The n
  8343           Be gin
  8344              ShowMessag eCAPRI('Yo u are rest ricted to  a set of p atients bu t have no  patient se lection li st.');
  8345              applicatio n.terminat e;
  8346           En d;
  8347           If  Restricte dPtSelecti on[1] = 'Y ' Then
  8348           Be gin
  8349              frmSplashS creen.Stat usLabel.Ca ption := ' Getting re stricted p atient lis t...';
  8350              frmSPlashS creen.Gaug eLoadSite. Progress : = 30;
  8351              frmSplashS creen.Repa int;
  8352              RPCBroker1 .RemotePro cedure :=  'DVBAB TEA M PATIENTS ';
  8353              RPCBroker1 .Param[0]. Value := P atientSele ctionList;
  8354              RPCBroker1 .Param[0]. PType := l iteral;
  8355              RPCBrokerC all;
  8356              Try
  8357                RPCBroke r1.Call;
  8358              Except
  8359                On EBrok erError Do
  8360                Begin
  8361                  ANURem oteProcedu reCallInPr ogress :=  False;
  8362                  Animat eLogo(Fals e);
  8363                  Status BarLoadPt. Caption :=  'RPC DVBA B TEAM PAT IENTS coul d not be a ccessed!';
  8364                  Status BarLoadPt. Repaint;
  8365                  Applic ation.Proc essmessage s;
  8366                  ShowMe ssageCAPRI ('DVBAB TE AM PATIENT S could no t be acces sed!');
  8367                End;
  8368              End;
  8369              If RPCBrok er1.Result s.Count >  0 Then
  8370                For xx : = 0 To RPC Broker1.Re sults.Coun t - 1 Do
  8371                  listRe strictedPa tients.Add (RPCBroker 1.Results[ xx]);
  8372              If RPCBrok er1.Result s.Count =  0 Then
  8373              Begin
  8374                ShowMess ageCAPRI(' Your restr icted pati ent list i s empty.') ;
  8375                applicat ion.termin ate;
  8376              End;
  8377              If Upperca se(listRes trictedPat ients[0])  = '^NO PAT IENTS FOUN D.' Then
  8378              Begin
  8379                ShowMess ageCAPRI(' You are re stricted t o a set of  patients  but have n o patients  on your l ist.');
  8380                applicat ion.termin ate;
  8381              End;
  8382           En d;
  8383           If  Not Autho rizedOptio n('DVBA CA PRI GUI')  Then
  8384           Be gin
  8385              ShowMessag eCAPRI('Co uld not us e option " DVBA CAPRI  GUI!"');
  8386              applicatio n.terminat e;
  8387           En d;
  8388         End;
  8389  
  8390         BitB tnNewForm. Visible :=  False;
  8391         // Q C #2016 -  jcs - Ensu re button  is always  enabled to  match rig ht click d elete.
  8392         // D elete even t will val idate.
  8393         // B uttonIPRDe lete.Visib le := Fals e;
  8394         // Q C #2016 -  jcs - Vari able no lo nger neede d
  8395         // A NUCanEditC PWM := Fal se;
  8396  
  8397         // C odeCR668 -  JRL 2/23/ 15
  8398         // I t was disc overed tha t there ma y be times  when NO s ecurity ke ys are
  8399         // a ssigned an d that all ows some m enu option s to displ ay that sh ouldn't.
  8400         // T o avoid co de and tes ting impac t, I'm mod ifying the  test from :
  8401         //     If UserK eys.Count  > 0 Then
  8402         // t o
  8403         //     If UserK eys.Count  >= 0 Then
  8404         // T his mimize s code cha nges late  in the tes ting cycle .  The tes t will
  8405         // a lways succ eed and al l code in  the loop b elow will  always be  executed.
  8406         If U serKeys.Co unt >= 0 T hen
  8407         Begi n
  8408           Re adOnlyMode  := IsUser KeyInList( 'DVBA CAPR I READ ONL Y,DVBA CAP RI READ O' );
  8409           ac tToolsExam ListParame ters.Visib le := IsUs erKeyInLis t('DVBA CA PRI EXAM L IST EDIT,D VBA CAPRI  EXAM LIST  E,DVBA C S UPERVISOR' );
  8410           If  IsUserKey InList('DV BA CAPRI W ORKSHEET T AB,DVBA CA PRI WORKSH EET ') The n
  8411           Be gin
  8412              TabCPWorks heets.Visi ble := Tru e;
  8413              TabCPWorks heets.Enab led := Tru e;
  8414              TabCPWorks heets.TabV isible :=  True;
  8415              actToolsUn signedWork sheets.Vis ible := Tr ue;
  8416           En d;
  8417           //  Check Pat ch Number  for defens ive coding
  8418           if  IsPatchIn stalled('D VBA*2.7*18 1') then                                    // CodeCR3 47 - JRL 6 /12/12
  8419           be gin                                                                          // CodeCR3 47 - JRL 6 /12/12
  8420              // Make th e vocation al rehab t ab visible  only if t he user               // CodeCR3 47 - JRL 6 /12/12
  8421              // has Voc Rehab user keys                                                   // CodeCR3 47 - JRL 6 /12/12
  8422              TabVocReha b.TabVisib le := IsUs erKeyInLis t('DVBA CA PRI VRE_CO UNSELOR,DV BA CAPRI V RE_COUNSEL OR'); // C odeCR347 -  JRL 6/12/ 12
  8423              if TabVocR ehab.TabVi sible then                                             // CodeCR3 47 - JRL 6 /12/12
  8424              begin                                                                        // CodeCR3 47 - JRL 6 /12/12
  8425                if not A ssigned(Vo cRehab) th en                                          // CodeCR3 47 - JRL 6 /12/12
  8426                  VocReh ab := TVoc Rehab.Crea te;                                         // CodeCR3 47 - JRL 6 /12/12
  8427                // assig n access i f user has  VHA VocRe hab privil eges                  // CodeCR3 47 - JRL 6 /12/12
  8428                // (used  for assig ning consu lts)                                        // CodeCR3 47 - JRL 6 /12/12
  8429                VocRehab .VHAAccess  := IsUser KeyInList( 'DVBA CAPR I VHA_COOR DINATOR,DV BA CAPRI V HA_COORDIN ATOR'); //  CodeCR347  - JRL 6/1 2/12
  8430              end;                                                                         // CodeCR3 47 - JRL 6 /12/12
  8431           en d                                                                            // CodeCR3 47 - JRL 6 /12/12
  8432           el se                                                                           // CodeCR3 47 - JRL 6 /12/12
  8433              TabVocReha b.TabVisib le := FALS E;                                          // CodeCR3 47 - JRL 6 /12/12
  8434           if  IsPatchIn stalled('D VBA*2.7*19 7') then
  8435           be gin
  8436           
  8437           en d;
  8438             
  8439           //  DVBA CAPR I DENY GET VBADOCS wa s added in  patch 186 .  VBA use rs could
  8440           //  be assign ed this ke y.  If thi s key was  assigned,  then the m enu option
  8441           //  'Get Docs  from VVA'  would not  be visibl e.  After  implementa tion, this
  8442           //  was deter mined to b e hard to  administra te, so thi s key is b eing
  8443           //  deprecate d and a ne w key will  be added  in patch 1 87 to all  users
  8444           //  to allow  them acces s to 'Get  Docs from  VVA'.  VBA  users not  allowed
  8445           //  to see VV A docs her e will not  get this  key. -JRL  5/15/14
  8446           if  IsPatchIn stalled('D VBA*2.7*18 6') AND                                     // CodeCR5 77 - JRL 5 /15/14 //O nly execut e this cod e if
  8447              NOT IsPatc hInstalled ('DVBA*2.7 *187') the n                                // CodeCR5 77 - JRL 5 /15/14 //P atch 186 i s installe d and
  8448           be gin                                                                          // CodeCR5 77 - JRL 5 /15/14 //P atch 187 i s not inst alled
  8449              if IsUserK eyInList(' DVBA CAPRI  DENY_GETV BADOCS') t hen                   // CodeCR4 97 - JRL 6 /07/13
  8450                actFileR etrieveVir tualVA.Vis ible := FA LSE                              // CodeCR4 97 - JRL 6 /07/13
  8451              else                                                                         // CodeCR5 77 - JRL 5 /15/14
  8452                actFileR etrieveVir tualVA.Vis ible := TR UE;                              // CodeCR5 77 - JRL 5 /15/14
  8453           en d;                                                                           // CodeCR5 77 - JRL 5 /15/14
  8454           if  IsPatchIn stalled('D VBA*2.7*18 7') then                                    // CodeCR5 77 - JRL 5 /15/14 //O nly execut e this cod e if
  8455           be gin                                                                          // CodeCR5 77 - JRL 5 /15/14 //i f Patch 18 7 is insta lled
  8456              if IsUserK eyInList(' DVBA CAPRI  GETVBADOC S') then                         // CodeCR5 77 - JRL 5 /15/14
  8457                actFileR etrieveVir tualVA.Vis ible := TR UE                               // CodeCR5 77 - JRL 5 /15/14
  8458              else                                                                         // CodeCR5 77 - JRL 5 /15/14
  8459                actFileR etrieveVir tualVA.Vis ible := FA LSE;                             // CodeCR5 77 - JRL 5 /15/14
  8460           en d;                                                                           // CodeCR5 77 - JRL 5 /15/14
  8461   //         if IsUserK eyInList(' DVBA GetDo csfromVLER ') then                            // CodeC R567 - JRL  5/18/14
  8462   //            actFile RetrieveDo csVLERDAS. Visible :=  TRUE                              // CodeC R567 - JRL  5/18/14
  8463   //         else                                                                           // CodeC R567 - JRL  5/18/14
  8464   //            actFile RetrieveDo csVLERDAS. Visible :=  FALSE;                            // CodeC R567 - JRL  5/18/14
  8465           //  Add in se curity key  for retri eving docu ments from  VLER/DAS             // CodeCR5 67 - JRL 5 /22/14
  8466           //  You must  have this  key to see  the menu  option Get  Docs from  VLER      // CodeCR5 67 - JRL 5 /22/14
  8467           if  IsPatchIn stalled('D VBA*2.7*18 7') then                                    // CodeCR5 67 - JRL 5 /22/14
  8468           be gin                                                                          // CodeCR5 67 - JRL 5 /22/14
  8469               // get th e separato r between  Get Docs f rom Virtua l VA and G et Docs fr om DAS
  8470              try
  8471                actnItem Separator  := ActionM anMain.Act ionBars[0] .Items[0]. Items[11];  // CodeCR 668 - RPK  1/21/2015
  8472              except
  8473                actnItem Separator  := nil;
  8474              end;
  8475              if IsUserK eyInList(' DVBA CAPRI  GETDOCSFR OMVLER') t hen                   // CodeCR5 67 - JRL 5 /18/14
  8476              begin                                                                        // CodeCR5 67 - JRL 5 /22/14
  8477                actFileR etrieveDoc sVLERDAS.V isible :=  TRUE;                            // CodeCR5 67 - JRL 5 /18/14
  8478   //               actF ileSeparat orBarVisib le.Visible  := TRUE;                          // CodeC R567 - JRL  5/22/14
  8479                if actnI temSeparat or <> nil  then                                        // CodeCR6 68 - RPK 1 /21/2015
  8480                  actnIt emSeparato r.Visible  := True;                                    // CodeCR6 68 - RPK 1 /21/2015
  8481              end                                                                          // CodeCR5 67 - JRL 5 /22/14
  8482              else                                                                         // CodeCR5 67 - JRL 5 /18/14
  8483              begin                                                                        // CodeCR5 67 - JRL 5 /22/14
  8484                actFileR etrieveDoc sVLERDAS.V isible :=  FALSE;                           // CodeCR5 67 - JRL 5 /18/14
  8485   //               actF ileSeparat orBarVisib le.Visible  := FALSE;                         // CodeC R567 - JRL  5/22/14
  8486                if actnI temSeparat or <> nil  then                                        // CodeCR6 68 - RPK 1 /21/2015
  8487                  actnIt emSeparato r.Visible  := False;                                   // CodeCR6 68 - RPK 1 /21/2015
  8488              end                                                                          // CodeCR5 67 - JRL 5 /22/14
  8489           en d;                                                                           // CodeCR5 67 - JRL 5 /22/14
  8490           if  IsPatchIn stalled('D VBA*2.7*19 0') then                                    // CodeCR6 98 - RPK 3 /30/2015
  8491           be gin                                                                          // CodeCR6 98 - RPK 3 /30/2015
  8492              if ESSOVer sion then                                                         // If remo tely logge d in, then  check sec urity key  // CodeCR6 98 - JRL 4 /20/2015
  8493              begin                                                                        // CodeCR6 98 - JRL 4 /20/2015
  8494                actHelpE dtCancelRe asons.Visi ble := IsU serKey('DV BA CAPRI E XAMCANC');  // CodeCR 698 - RPK  3/30/2015
  8495                actHelpE dtInsuffRe asons.Visi ble := IsU serKey('DV BA CAPRI E XAMINSUFF' ); // Code CR698 - RP K 3/30/201 5
  8496              end                                                                          // CodeCR6 98 - JRL 4 /20/2015
  8497              else                                                                         // CodeCR6 98 - JRL 4 /20/2015
  8498              begin                                                                        // CodeCR6 98 - JRL 4 /20/2015
  8499                actHelpE dtCancelRe asons.Visi ble := FAL SE;                              // CodeCR6 98 - JRL 4 /20/2015
  8500                actHelpE dtInsuffRe asons.Visi ble := FAL SE;                              // CodeCR6 98 - JRL 4 /20/2015
  8501              end;                                                                         // CodeCR6 98 - JRL 4 /20/2015
  8502           en d;                                                                           // CodeCR6 98 - RPK 3 /30/2015
  8503           if  IsPatchIn stalled('D VBA*2.7*19 3') then                                    // Patch 1 93 JRL 7/2 9/16
  8504           be gin                                                                          // Patch 1 93 JRL 7/2 9/16
  8505              if (IsUser Key('DVBA  CAPRI RERO UTEREASONS ')) AND                          // Patch 1 93 JRL 7/2 9/16                        
  8506                 (ESSOVe rsion = FA LSE) then                                              // If remo tely logge d in, then  check sec urity key  // CodeCR6 98 - JRL 4 /20/2015
  8507                actHelpE dtReRouteR easons.Vis ible := TR UE                               // Patch 1 93 JRL 7/2 9/16
  8508              else                                                                         // Patch 1 93 JRL 7/2 9/16
  8509                actHelpE dtReRouteR easons.Vis ible := FA LSE;                             // Patch 1 93 JRL 7/2 9/16
  8510           en d                                                                            // Patch 1 93 JRL 7/2 9/16
  8511           el se                                                                           // Patch 1 93 JRL 9/2 3/16
  8512              actHelpEdt ReRouteRea sons.Visib le := FALS E;                               // Patch 1 93 JRL 9/2 3/16
  8513  
  8514           if  IsPatchIn stalled('D VBA*2.7*19 7') then                                    // Patch19 7 JRL 2/8/ 17
  8515               actHelpEd tVREReRout eReasons.V isible :=  IsUserKey( 'DVBA CAPR I VRE_RR R EASON') //  Patch197  JRL 2/8/17
  8516           el se                                                                           // Patch19 7 JRL 2/8/ 17
  8517               actHelpEd tVREReRout eReasons.V isible :=  FALSE;                           // Patch19 7 JRL 2/8/ 17
  8518             
  8519           Fo undCPWMKey  := '';
  8520           If  IsUserKey InList('DV BAB CPWM R EQUIRE REV IEW,DVBAB  CPWM REQUI RE REV') T hen
  8521              FoundCPWMK ey := Foun dCPWMKey +  'DVBAB CP WM REQUIRE  REVIEW,';
  8522           If  IsUserKey InList('DV BAB CPWM D ISALLOW RE VIEW,DVBAB  CPWM DISA LLOW REV')  Then
  8523              FoundCPWMK ey := Foun dCPWMKey +  'DVBAB CP WM DISALLO W REVIEW,' ;
  8524           If  IsUserKey InList('DV BAB CPWM O PTIONAL RE VIEW,DVBAB  CPWM OPTI ONAL REV')  Then
  8525              FoundCPWMK ey := Foun dCPWMKey +  'DVBAB CP WM OPTIONA L REVIEW,' ;
  8526           bo ReviewerKe y := IsUse rKeyInList ('DVBAB CP WM REVIEWE R,DVBAB CP WM REVIE') ;
  8527           If  (FoundCPW MKey <> '' ) Or boRev iewerKey T hen
  8528           Be gin
  8529              BitBtnNewF orm.Visibl e := True;
  8530              // QC #201 6 - jcs -  Ensure but ton is alw ays enable d to match  right cli ck delete.
  8531              // Delete  event will  validate.
  8532              //ButtonIP RDelete.Vi sible := T rue;
  8533              TabCPWorks heets.Enab led := Tru e;
  8534              TabCPWorks heets.TabV isible :=  True;
  8535              TabCPWorks heets.Visi ble := Tru e;
  8536              actToolsCP RSCosigUti l.Visible  := True;
  8537              actToolsUn signedWork sheets.Vis ible := Tr ue;
  8538           En d;
  8539           If  Piece(Fou ndCPWMKey,  ',', 2) < > '' Then
  8540           Be gin
  8541              Showmessag eCAPRI('Yo u have con flicting C APRI secur ity keys.   Please no tify IRM t here is a  problem wi th keys: '  + char(13 ) + Copy(F oundCPWMKe y, 1, leng th(FoundCP WMKey) - 1 ));
  8542           En d;
  8543         End;
  8544  
  8545         // E nable C&P  Worksheets  tab for C LAIMS user s with Fil eMan acces s "@", "U" , and "u".
  8546         if ( TabCPWorks heets.TabV isible = F alse) and  (EssoVersi on) then
  8547         begi n
  8548           if  (Pos('@',  userfilem ancode) >  0) or
  8549              (Pos('u',  userfilema ncode) > 0 ) or
  8550              (Pos('U',  userfilema ncode) > 0 ) then
  8551           be gin
  8552              TabCPWorks heets.Visi ble := Tru e;
  8553              TabCPWorks heets.Enab led := Tru e;
  8554              TabCPWorks heets.TabV isible :=  True;
  8555           en d;
  8556         end;
  8557  
  8558         //Lo ading Lab  tests used  to be her e...
  8559         List LabTestNam es.Clear;
  8560  
  8561         frmS plashScree n.StatusLa bel.Captio n := 'Load ing drug c lasses...' ;
  8562         fmli stboxvadru gclass.get list;
  8563         If f mlistervad rugclass.m ore = true  Then
  8564           Re peat fmlis tboxvadrug class.getm ore
  8565           Un til fmlist ervadrugcl ass.more =  false;
  8566         frmS plashScree n.StatusLa bel.Captio n := 'Load ing medica l center d ivisions.. .';
  8567         frmS PlashScree n.GaugeLoa dSite.Prog ress := 65 ;
  8568         frmS plashScree n.Repaint;
  8569         // G et divisio ns and for ce them in  the order  they are  in the fil e
  8570         GetA llDivision s(ListMedi calCenterD ivision);                                   //CodeCR18 6 - rpm 4/ 18/11
  8571  
  8572         frmS plashScree n.StatusLa bel.Captio n := 'Load ing exam l ist...';
  8573         frmS PlashScree n.GaugeLoa dSite.Prog ress := 75 ;
  8574         frmS plashScree n.Repaint;
  8575         FMLi sterExams. GetList(li stExams);                                              // Get Exa ms
  8576  
  8577         //Lo ad Institu tions Used  to be her e...
  8578         lstI nstitution s.Items.Cl ear;
  8579         frmR OFinder.OR ListBoxSit es.Items.C lear;
  8580  
  8581         frmS PlashScree n.GaugeLoa dSite.Prog ress := 10 0;
  8582         frmS plashScree n.Repaint;
  8583  
  8584         {Loa d lab test s}
  8585         //fr mLabGraph. FMListBoxL abs.GetLis t;
  8586         //ti merLoadLab s.Enabled: =True;
  8587  
  8588         If E SSOVersion  = False T hen
  8589         Begi n
  8590           {G et DTime}
  8591           // CAPRI_Code CR95  - jc s - 05/20/ 2010
  8592           if  not CallR PC(RPCBrok er1, 'XWB  GET VARIAB LE VALUE',  ['DTIME'] , nil, Tru e) then
  8593              exit;
  8594  
  8595           Ti meOutVal : = StrToInt (RPCBroker 1.Results[ 0]);
  8596           If  TimeOutVa l < 600 Th en
  8597              TimeOutVal  := 600;
  8598         End;
  8599  
  8600         Time OutTimer.E nabled :=  True;
  8601  
  8602         //If  Pos('@',u serfileman code)>0 th en Editele ctronicSig natureCode 1.Visible: =True;
  8603  
  8604         If P os('@', us erfilemanc ode) > 0 T hen
  8605         Begi n
  8606           ac tToolsExam ListParame ters.Visib le := True ;
  8607           ac tToolsCPRS CosigUtil. Visible :=  True;
  8608           // TabCPWorks heets.Visi ble:=True;
  8609           // TabCPWorks heets.Enab led:=True;
  8610           // TabCPWorks heets.TabV isible:=Tr ue;
  8611           // UnsignedCP Worksheets 1.Visible: =True;
  8612         End;
  8613  
  8614              //Check fo r mail
  8615         If f rmMailMan  = Nil Then
  8616           fr mMailMan : = TfrmMail Man.Create (frmMain);
  8617         frmM ailMan.Str ingGridMai lboxMessag es.RowCoun t := 0;
  8618         frmM ailMan.Str ingGridMai lboxMessag es.Cells[0 , 0] := '' ;                     // Clear t hese in ca se no mess ages are i n the mail box
  8619         frmM ailMan.Str ingGridMai lboxMessag es.Cells[1 , 0] := '' ;
  8620         frmM ailMan.Str ingGridMai lboxMessag es.Cells[2 , 0] := '' ;
  8621         frmM ailMan.Str ingGridMai lboxMessag es.Cells[3 , 0] := '' ;
  8622         frmM ailMan.Str ingGridMai lboxMessag es.Cells[4 , 0] := '' ;
  8623         frmM ailMan.Str ingGridMai lboxMessag es.Cells[5 , 0] := '' ;                     // Not use d for now
  8624         frmM ailMan.Str ingGridMai lboxMessag es.Cells[6 , 0] := '' ;
  8625  
  8626         frmM ailMan.btn RefreshCli ck(Applica tion);
  8627         //No w check to  see if th ey have a  forwarding  e-mail ad dress in
  8628         //fi le 200.  I f not, pro mpt them.
  8629         If E SSOVersion  = True Th en
  8630           If  lowercase (localemai laddress)  <> lowerca se(homeema iladdress)  Then
  8631           Be gin
  8632              FMFiler2.A ddFDA('200 ', AuthorI EN, '.151' , HomeEMai lAddress);
  8633              LocalEMail Address :=  lowercase (homeemail address);
  8634              Try
  8635                If Not f mfiler2.Up date Then
  8636                Begin
  8637                  fmfile r2.Display Errors;
  8638                End;
  8639                ShowMess ageCAPRI(' Remote e-m ail addres s for this  system ha s been' +  char(13) +  'updated  to match y our home s erver pref erence:' +  char(13)  + HomeEmai lAddress);
  8640              Except
  8641                Begin
  8642                  Showme ssageCAPRI ('Couldn'' t set remo te e-mail  address.') ;
  8643                  If RPC Broker1.Co nnected =  False Then
  8644                  Begin
  8645                    Show messageCAP RI('Not co nnected to  a server  due to dat a transmis sion failu re.  Exiti ng applica tion.');
  8646                    appl ication.Te rminate;
  8647                    appl ication.te rminate;
  8648                  End;
  8649                End;
  8650              End;
  8651  
  8652           En d;
  8653  
  8654         frmS PlashScree n.GaugeLoa dSite.Fore Color := c lYellow;
  8655         frmA lerts := T frmAlerts. Create(frm Main);
  8656         if I sCCRUser t hen begin
  8657   //         frmSplashS creen.Stat usLabel.Ca ption := ' Checking A lert: Mani fests avai lable for  Pending /  Under Revi ew...';
  8658           fr mSplashScr een.Status Label.Capt ion := 'Ch ecking Ale rt: Vendor  exam requ ests ready  for downl oad...'; / / CodeCR73 0 rpk 6/2/ 2015
  8659           fr mSPlashScr een.GaugeL oadSite.Pr ogress :=  20;
  8660           fr mSplashScr een.Repain t;
  8661           fr mAlerts.bt nManifests .Show;
  8662           fr mAlerts.ed tManifests .Show;
  8663           fr mAlerts.sh pManifests .Show;                                                 // rpk 11/ 5/2014
  8664           fr mManifests  := TfrmMa nifests.Cr eate(frmMa in);
  8665           tr y
  8666              ManifestCn t := frmMa nifests.ge tManifestC nt;
  8667   //           edtstr : = 'Unable  to retriev e vendor e xam reques ts pending  review.';
  8668              edtstr :=  'Unable to  retrieve  vendor exa m requests  ready for  download. '; // Code CR730 rpk  6/2/2015
  8669              if Manifes tCnt >= 0  then begin
  8670                case Man ifestCnt o f
  8671   //               0: e dtstr := ' You have n o vendor e xam reques ts pending  review.';
  8672   //               1: e dtstr := ' You have 1  vendor ex am request s pending  review.';
  8673                  0: edt str := 'Yo u have no  vendor exa m requests  ready for  download. '; // Code CR730 rpk  6/2/2015
  8674                  1: edt str := 'Yo u have 1 v endor exam  requests  ready for  download.' ; // CodeC R730 rpk 6 /2/2015
  8675                else
  8676   //               edts tr := 'You  have ' +  IntToStr(M anifestCnt ) + ' vend or exam re quests pen ding revie w.';
  8677                  edtstr  := 'You h ave ' + In tToStr(Man ifestCnt)  + ' vendor  exam requ ests ready  for downl oad.'; //  CodeCR730  rpk 6/2/20 15
  8678                end;
  8679              end;
  8680              frmAlerts. edtManifes ts.Text :=  edtstr;
  8681              frmAlerts. btnManifes ts.Enabled  := Manife stCnt > 0;
  8682              frmAlerts. edtManifes ts.Enabled  := Manife stCnt > 0;
  8683           fi nally
  8684              FreeAndNil (frmManife sts);                                                  // rpk 7/1 1/2014
  8685           en d;
  8686         end
  8687         else  begin
  8688           fr mAlerts.bt nManifests .Hide;
  8689           fr mAlerts.ed tManifests .Hide;
  8690           fr mAlerts.sh pManifests .Hide;                                                 // rpk 11/ 5/2014
  8691         end;
  8692  
  8693         frmS plashScree n.StatusLa bel.Captio n := 'Chec king Alert : CPRS co- signature  status...' ;
  8694         frmS PlashScree n.GaugeLoa dSite.Prog ress := 40 ;
  8695         frmS plashScree n.Repaint;
  8696         // C heck for d ocuments r eady to be  transferr ed from TI U to AMIE
  8697         If a ctToolsCPR SCosigUtil .visible =  true Then
  8698         Begi n
  8699           fr mAlerts.bu ttonResolv e.Show;                                                // rpk 11/ 6/2014
  8700           fr mAlerts.ed itResolve. Show;                                                  // rpk 11/ 6/2014
  8701   //         frmAlerts. shape4.Vis ible := fa lse;
  8702           fr mAlerts.sh pResolve.S how;                                                   // rpk 11/ 6/2014
  8703           fr mUncosigne d := TfrmU ncosigned. Create(frm Main);
  8704           fr mUncosigne d.buttonSe archClick( Applicatio n);
  8705           If  piece(frm Uncosigned .labelRead y.caption,  ' ', 1) =  '0' Then
  8706           Be gin
  8707              frmAlerts. editResolv e.Text :=  'There are  no CPRS c o-signed d ocuments r eady for t ransfer to  AMIE.';
  8708              frmAlerts. editResolv e.Enabled  := False;
  8709              frmAlerts. ButtonReso lve.Enable d := False ;
  8710           En d
  8711           El se
  8712              If piece(f rmUncosign ed.labelRe ady.captio n, ' ', 1)  = '1' The n
  8713              Begin
  8714                frmAlert s.editReso lve.Text : = 'There i s 1 CPRS c o-signed d ocument re ady for tr ansfer to  AMIE.';
  8715                frmAlert s.editReso lve.Enable d := True;
  8716                frmAlert s.ButtonRe solve.Enab led := Tru e;
  8717              End
  8718              Else
  8719              Begin
  8720                frmAlert s.editReso lve.Text : = 'There a re ' + pie ce(frmUnco signed.lab elReady.ca ption, ' ' , 1) + ' C PRS co-sig ned docume nts ready  for transf er to AMIE .';
  8721                frmAlert s.editReso lve.Enable d := True;
  8722                frmAlert s.ButtonRe solve.Enab led := Tru e;
  8723              End;
  8724         End
  8725         Else
  8726         Begi n
  8727           //  Hide this  one
  8728           fr mAlerts.bu ttonResolv e.Visible  := false;
  8729           fr mAlerts.ed itResolve. Visible :=  false;
  8730   //         frmAlerts. shape4.Vis ible := fa lse;
  8731           fr mAlerts.sh pResolve.V isible :=  false;
  8732   //         frmAlerts. BitBtnCont inue.top : = 162;
  8733   //         frmAlerts. Height :=  240;
  8734   // have st opped movi ng Continu e button a nd resizin g Alerts f orm; just  leave Reso lve row hi dden; rpk  11/6/2014
  8735   //         frmAlerts. BitBtnCont inue.top : = frmAlert s.BitBtnCo ntinue.top  - 50;  //  rpk 11/5/ 2014
  8736   //         frmAlerts. Height :=  frmAlerts. Height - 4 4;
  8737           // frmAlerts. height:=fr mAlerts.bi tBtnContin ue.Top+frm Alerts.bit BtnContinu e.Height+1 6;
  8738         End;
  8739  
  8740         frmS plashScree n.StatusLa bel.Captio n := 'Chec king Alert : Unsigned  templates ...';
  8741   //      fr mSPlashScr een.GaugeL oadSite.Pr ogress :=  50;
  8742         frmS PlashScree n.GaugeLoa dSite.Prog ress := 60 ;
  8743         frmS plashScree n.Repaint;
  8744  
  8745         // C heck for f orms needi ng signatu re
  8746         time outtimer.e nabled :=  true;
  8747         Unsi gnedView : = TUnsigne dView.Crea te(frmMain );
  8748         Unsi gnedView.B utton5Clic k(Applicat ion);
  8749  
  8750         If ( (UnsignedV iew.FMList BoxIPR1.It ems.Count  > 0) And ( ReadOnlyMo de = False )) Then
  8751         Begi n
  8752           //  Duplicate  check for  documents  needing s ignature,  same as in  alerts
  8753           fr mAlerts.Bu ttonUnsign edClick(fr mMain);
  8754         End;
  8755  
  8756         // C heck for f orms needi ng signatu re if user  has acces s to the w orksheet t ab
  8757         For  xx := 0 To  UserKeys. Count - 1  Do
  8758           If  (UserKeys [xx] = 'DV BA CAPRI W ORKSHEET T AB') Or
  8759              (UserKeys[ xx] = 'DVB A CAPRI WO RKSHEET ')  Then
  8760           Be gin
  8761  
  8762              Flag := Fa lse;
  8763              //For xx:= 0 to UserK eys.Count- 1 do ShowM essageCAPR I(userkeys [xx]);
  8764              If UserKey s.Count >  0 Then
  8765              Begin
  8766                //For xx :=0 to Use rKeys.Coun t-1 do  Sh owMessageC APRI(UserK eys[xx]);
  8767                For yy : = 0 To Use rKeys.Coun t - 1 Do
  8768                  If (Us erKeys[yy]  = 'DVBAB  CPWM REVIE WER') Or
  8769                    (Use rKeys[yy]  = 'DVBAB C PWM REVIE' ) Then
  8770                  Begin
  8771                    flag  := true;
  8772                  End;
  8773              End;
  8774              If Flag =  True Then
  8775              Begin
  8776                frmSplas hScreen.Sh ow;
  8777                frmSplas hScreen.St atusLabel. Caption :=  'Checking  Alert: Te mplates re ady for re view...';
  8778   //             frmSPl ashScreen. GaugeLoadS ite.Progre ss := 75;
  8779                frmSPlas hScreen.Ga ugeLoadSit e.Progress  := 80;
  8780                frmSplas hScreen.Re paint;
  8781  
  8782                Unsigned View.Butto n4Click(fr mMain);
  8783                If ((Uns ignedView. FMListBoxI PR1.Items. Count > 0)  And (Read OnlyMode =  False)) T hen
  8784                Begin
  8785                  If Uns ignedView. FMListBoxI PR1.Items. Count = 1  Then
  8786                    frmA lerts.edit Review.Tex t := 'Ther e is 1 tem plate requ iring revi ew.'
  8787                  Else
  8788                  Begin
  8789                    zz : = 0;
  8790                    For  x := 0 To  UnsignedVi ew.FMListB oxIPR1.Ite ms.Count -  1 Do
  8791                      If  Copy(Unsi gnedView.F MListBoxIP R1.Items[x ], 1, 1) < > '!' Then
  8792                         inc(zz);
  8793                    If z z > 1 Then
  8794                      fr mAlerts.ed itReview.T ext := 'Th ere are '  + inttostr (zz) + ' t emplates r equiring r eview.';
  8795                    If z z = 1 Then
  8796                      fr mAlerts.Ed itReview.T ext := 'Th ere is 1 t emplate re quiring re view.';
  8797                  End;
  8798                  frmAle rts.button Review.ena bled := Tr ue;
  8799                  frmAle rts.editRe view.enabl ed := True ;
  8800                End
  8801                Else
  8802                Begin
  8803                  frmAle rts.editRe view.enabl ed := fals e;
  8804                  frmAle rts.editRe view.text  := 'There  are no tem plates req uiring rev iew.';
  8805                  frmAle rts.button Review.ena bled := Fa lse;
  8806                End;
  8807              End
  8808              Else
  8809              Begin
  8810                frmAlert s.editRevi ew.enabled  := false;
  8811                frmAlert s.editRevi ew.text :=  'You do n ot have te mplate "re viewer" pr ivileges.' ;
  8812                frmAlert s.buttonRe view.enabl ed := Fals e;
  8813              End;
  8814           En d;
  8815  
  8816         frmS plashScree n.StatusLa bel.Captio n := 'Chec king Alert : CPRS un- cosigned d ocuments.. .';
  8817         frmS PlashScree n.GaugeLoa dSite.Prog ress := 10 0;
  8818         frmS plashScree n.Repaint;
  8819         frmT IUCosign : = TfrmTIUC osign.Crea te(Nil);
  8820         frmT IUCosign.G etCosignat ureAlerts;
  8821  
  8822       End;
  8823  
  8824       If Scr eenReaderA ctive = Tr ue Then
  8825         frmM ain.Captio n := 'CAPR I'
  8826       Else
  8827         frmM ain.Captio n := Progr amNameCapt ion + ' Co nnected To  ' + Upper case(RPCBr oker1.ANUS trServer)  + ' (Serve r:' + RPCB roker1.ANU RPCServer  + '  Volum e:' + RPCB roker1.ANU RPCVolume  + '  UCI:'  + RPCBrok er1.ANURPC UCI + '  P ort:' + RP CBroker1.A NURPCPort  +
  8828           ') ';
  8829  
  8830       labeld ivision.ca ption := ' ';
  8831       If ESS OVersion =  True Then
  8832       Begin
  8833         labe ldivision. visible :=  true;
  8834         RPCB roker1.Rem oteProcedu re := 'DVB AB SET DIV ISION';
  8835         RPCB roker1.Par am[1].Valu e := Remot eUserDivis ionNumber;
  8836         RPCB roker1.Par am[1].PTyp e := liter al;
  8837  
  8838         Try
  8839           RP CBroker1.C all;
  8840         Exce pt
  8841           On  EBrokerEr ror Do
  8842           Be gin
  8843              ANURemoteP rocedureCa llInProgre ss := Fals e;
  8844              AnimateLog o(False);
  8845              StatusBarL oadPt.Capt ion := 'RP C DVBAB SE T DIVISION  could not  be access ed!';
  8846              StatusBarL oadPt.Repa int;
  8847              Applicatio n.Processm essages;
  8848              ShowMessag eCAPRI('DV BAB SET DI VISION cou ld not be  accessed!' );
  8849           En d;
  8850         End;
  8851         Try
  8852           If  piece(rpc broker1.re sults[0],  '^', 1) =  '0' Then
  8853           Be gin
  8854              LabelDivis ion.Captio n := 'Divi sion: Set  division f ailed!';
  8855              Showmessag eCAPRI('WA RNING:  Th ere was a  problem se tting the  user''s di vision.  S ome report s may not  function c orrectly.   ' + piece (rpcbroker 1.results[ 0], '^', 2 ));
  8856           En d
  8857           El se
  8858           Be gin
  8859              // User's  division I EN is in p iece 1, bu t we don't  need it r ight now.
  8860              LabelDivis ion.captio n := 'Divi sion: ' +  piece(rpcb roker1.res ults[0], ' ^', 2);
  8861           En d;
  8862         Exce pt
  8863           Be gin
  8864           En d;
  8865         End;
  8866       End
  8867       Else
  8868       Begin
  8869         // N on-remote  mode
  8870         labe lDivision. Caption :=  'Division : ' + User Division;
  8871       End;
  8872       PanelD ivision.Wi dth := lab elDivision .Width + 8 ;
  8873  
  8874       If lab elDivision .Caption =  '' Then
  8875       Begin
  8876         Show messageCAP RI('WARNIN G:  There  was a prob lem settin g the user ''s divisi on.  Pleas e check th e host sys tem and lo g in again .  If the  problem co ntinues, n otify your  IT suppor t service. ');
  8877         time rhalt.enab led := tru e;
  8878       End;
  8879  
  8880       Panel1 .Visible : = True;
  8881       Switch ToSite :=  '';                                                               //Clear th is, just i n case it  was previo usly set
  8882       Animat eLogo(Fals e);
  8883  
  8884       If RPC Broker1.Co nnected =  False Then
  8885       Begin
  8886         frmM ain.Captio n := 'CAPR I not Conn ected'
  8887       End;
  8888     End
  8889     Else
  8890     Begin
  8891       TimeOu tVal := 0;
  8892       TimeOu tTimer.Ena bled := Fa lse;
  8893       RPCBro ker1.Conne cted := Fa lse;
  8894       ClearF orm;                                                                         //CodeCR24 8 - rpm 3/ 8/12 - cle ar the hea der and ta b set
  8895       Panel1 .Visible : = False;
  8896       Animat eLogo(Fals e);
  8897     End;
  8898     If Assig ned(frmSpl ashScreen)  Then
  8899     Begin
  8900       frmSpl ashScreen. Hide;
  8901       frmSpl ashScreen. release;
  8902       frmSpl ashScreen  := Nil;
  8903     End;
  8904     If Assig ned(frmAle rts) Then
  8905     Begin
  8906       If (fr mAlerts.bu ttonUnsign ed.enabled  = true) O r (frmAler ts.buttonR eview.enab led = true )
  8907         Or ( frmAlerts. buttonUnco signed.ena bled = tru e) Or (frm Alerts.but tonResolve .enabled =  true)
  8908         Or ( frmAlerts. btnManifes ts.enabled  = true)                                    // 2014-11 -03 LMS Fi x bug to s how alert  dialog whe n manifest s are avai lable
  8909         Then
  8910       Begin
  8911         frmA lerts.Show Modal;
  8912       End;
  8913       frmAle rts.Hide;
  8914       frmAle rts.releas e;
  8915       frmAle rts := Nil ;
  8916     End;
  8917  
  8918     If frmMa in.Visible  Then
  8919       //Sele ctPatient1 Click(Send er);
  8920       actFil eSelectPat ientExecut e(Sender);
  8921  
  8922     For x :=  1 To 100  Do
  8923       applic ation.proc essmessage s;
  8924  
  8925     If Assig ned(frmTIU Cosign) Th en
  8926     Begin
  8927       FreeAn dNil(frmTI UCosign);
  8928     End;
  8929     If Assig ned(frmUnc osigned) T hen
  8930     Begin
  8931       frmUnc osigned.Hi de;
  8932       Try
  8933         frmU ncosigned. release;
  8934       Except
  8935       End;
  8936       frmUnc osigned :=  Nil;
  8937     End;
  8938     If Unsig nedView <>  Nil Then
  8939     Begin
  8940       Try
  8941         Unsi gnedView.R elease;
  8942       Except
  8943       End;
  8944       Unsign edView :=  Nil;
  8945     End;
  8946     switchto site := '' ;
  8947     Contexto rChangeMes sage := '' ;
  8948     CCOWBrea kLink := F alse;
  8949  
  8950     // Check  if CPEP h as been no tified tha t this use d has used  this vers ion before
  8951     // Only  do it one  time.
  8952     tempstri ng2 := ver sion;
  8953     If pos(' *', tempst ring2) > 0  Then
  8954       Repeat
  8955         temp string2 :=  copy(temp string2, 1 , pos('*',  tempstrin g2) - 1) +  '_' + cop y(tempstri ng2, pos(' *', tempst ring2) + 1 , 255);
  8956       Until  pos('*', t empstring2 ) = 0;
  8957     If Not f ileexists( tempdir +  tempstring 2 + '.vali dated') Th en
  8958     Begin
  8959       tempst ring := '' ;
  8960       tempst ring := au thorname +  '^' + Use rDivision  + '^' + Us erDivision Number + ' ^' + versi on;
  8961       aStrea m := TMemo ryStream.C reate;
  8962       formNe ws.GetURL( 'http://vh atvhcpepa/ cgi-bin/ca pri_track. pl?' + tem pstring, a Stream);
  8963       formNe ws.RichEdi tNews.Line s.LoadFrom Stream(aSt ream);
  8964       formNe ws.RichEdi tNews.Line s.SaveToFi le(tempdir  + tempstr ing2 + '.v alidated') ;
  8965       formNe ws.RichEdi tNews.Line s.Clear;
  8966       formNe ws.GetURL( 'http://'  + newsURL  + 'NewsHea ders.txt',  aStream);
  8967       formNe ws.RichEdi tNews.Line s.LoadFrom Stream(aSt ream);
  8968       aStrea m := nil;
  8969     End;
  8970   End;
  8971  
  8972   procedure  TfrmMain.a ctFileConn ectUpdate( Sender: TO bject);
  8973   begin
  8974     {jcs - C APRI_CodeC R61 - Rear ranged cod e, since t he 'connec t' menu op tion
  8975     has a de pendancy o n the stat e of the ' switch sit es' menu,  which in t urn as a
  8976     dependan cy on the  'connect'  menu, set  the captio n of the ' connect' m enu first,
  8977     then upd ate the 's witch site s' menu (a dded line  of code),  then set ' connect'
  8978     menu acc ordingly.
  8979     }
  8980     If RPCBr oker1.Conn ected = Tr ue Then
  8981       actFil eConnect.c aption :=  '&Disconne ct...'
  8982     else
  8983       actFil eConnect.c aption :=  '&Connect. ..';
  8984  
  8985     actFileS witchSites Update(app lication);
  8986  
  8987     If (assi gned(frmNe wExam)) or  (assigned (frmViewEx am)) or (a ssigned(fr mNew7131))  or
  8988       (assig ned(frmVie w7131)) or  (actFileS witchSites .Enabled =  True) the n
  8989       actFil eConnect.E nabled :=  False
  8990     else
  8991       actFil eConnect.E nabled :=  True;
  8992  
  8993   end;
  8994  
  8995   procedure  TfrmMain.a ctFilePrin terSetupEx ecute(Send er: TObjec t);
  8996   begin
  8997     formPrin t.ButtonPr interSetup Click(appl ication);
  8998   end;
  8999  
  9000   procedure  TfrmMain.a ctFilePrin terSetupUp date(Sende r: TObject );
  9001   begin
  9002     If nopri nting = tr ue Then ac tFilePrint erSetup.En abled := F alse
  9003     else
  9004       actFil ePrinterSe tup.Enable d := True;
  9005   end;
  9006  
  9007   procedure  TfrmMain.a ctFilePrin tExecute(S ender: TOb ject);
  9008   Var
  9009     vIn, vOu t: OleVari ant;
  9010   begin
  9011     if ANURe moteProced ureCallInP rogress =  True Then
  9012       exit;
  9013  
  9014     if Page9 5Control1. ActivePage  = TabVist AWeb Then
  9015     begin
  9016       WebBro wser1.Cont rolInterfa ce.ExecWB( OLECMDID_P RINTPREVIE W, OLECMDE XECOPT_DON TPROMPTUSE R, vIn, vO ut);
  9017       exit;
  9018     end;
  9019  
  9020     if Forma tReport(Se nder) then                                                        //CodeCR35 3 - rpm 5/ 8/12
  9021     begin
  9022       // Sen d to print  preview o r printer,  depending  on how th e procedur e
  9023       // is  called
  9024       if sen der = actF ilePrintPr eview then
  9025       begin
  9026         form Print.butt onPreviewC lick(Appli cation);
  9027       end
  9028       else
  9029       begin
  9030         form Print.butt onPrintCli ck(Applica tion);
  9031       end;
  9032  
  9033       Cleanu pAfterRepo rt(Sender) ;                                                      //CodeCR35 3 - rpm 5/ 8/12
  9034     end;
  9035   end;
  9036  
  9037   {========= ========== ========== ========== ========== ========== ========== ===
  9038    GetServer DateTime
  9039    This func tion retri eves the c urrent dat e/time fro m the conn ected
  9040    remote sy stem in "H H:MM:SS am /pm" forma t. Refacto red from
  9041    actPrintF ileExecute  for reuse .
  9042  
  9043    Input: no ne
  9044    Output:   returns fo rmatted da te/time on  success;
  9045              otherwise,  returns e mpty strin g
  9046  
  9047    CodeCR353  - rpm 4/3 0/12
  9048    ========= ========== ========== ========== ========== ========== ========== ===}
  9049  
  9050   function T frmMain.Ge tServerDat eTime(): S tring;
  9051   begin
  9052     RPCBroke r1.RemoteP rocedure : = 'DVBAB D ATETIME';
  9053     try
  9054       RPCBro ker1.Call;
  9055     except
  9056       on EBr okerError  do
  9057       begin
  9058         ANUR emoteProce dureCallIn Progress : = False;
  9059         Anim ateLogo(Fa lse);
  9060         Stat usBarLoadP t.Caption  := 'RPC DV BAB DATETI ME could n ot be acce ssed!';
  9061         Stat usBarLoadP t.Repaint;
  9062         Appl ication.Pr ocessmessa ges;
  9063         Show MessageCAP RI('DVBAB  DATETIME c ould not b e accessed !');
  9064       end;
  9065     end;
  9066     if (RPCB roker1.Res ults.Count  > 0) then
  9067       Result  := RPCBro ker1.Resul ts[0]
  9068     else
  9069       Result  := '';
  9070   end;
  9071  
  9072   {========= ========== ========== ========== ========== ========== ========== ====
  9073    GetFooter Descriptio n
  9074    This func tion evalu ates the s elected ta b or form  and return s footer
  9075    descripti on text fo r reportin g.  This c ode refact ored from
  9076    actFilePr intExecute  and conta ins a numb er of shor t-circuits .
  9077  
  9078    Input: Se nder - for m object
  9079    Output: f ootDescrip  - footer  descriptio n passed b y referenc e
  9080            E rrorText -  error mes sage text
  9081            f unction re sult retur ns True on  success;  otherwise,  returns F alse
  9082  
  9083    CodeCR353  - rpm 4/3 0/12
  9084    ========= ========== ========== ========== ========== ========== ========== ===}
  9085  
  9086   function T frmMain.Ge tFooterDes cription(S ender: TOb ject; var  footDescri p: String;  var Error Text: Stri ng): Boole an;
  9087   begin
  9088     if Assig ned(Sender ) and (Sen der = PNCS Form) then
  9089     begin                                                                                 {PNCS Exam  report}
  9090       Page95 Control1.A ctivePage  := TabCPWo rksheets;
  9091       footDe scrip := ' UNSIGNED/D RAFT C&P T emplate';
  9092     end                                                                                   {PNCS Exam  report}
  9093     else if  Assigned(S ender) and  ((Sender  = FormTIUD isplay) OR  (Sender =  TIUSignFo rm)) Then  // CodeCR4 25 JRL 11/ 13/12 -- a dded TIUSi gnForm opt ion
  9094     begin                                                                                 {CPRS Docu ment view}
  9095       Page95 Control1.A ctivePage  := TabCPWo rksheets;
  9096       footde scrip := ' CLIN DOC:  Progress N ote';
  9097     end                                                                                   {CPRS Docu ment view}
  9098     else If  Assigned(S ender) and  (Sender =  frmExamDe tails) The n
  9099     Begin                                                                                 {Exam Deta ils form}
  9100       If frm ExamDetail s.RichEdit ExamReport .Visible =  False The n
  9101         Erro rText := ' This exam  cannot be  printed ye t.'
  9102       else
  9103         foot descrip :=  'C&P Exam  Results:  ' + frmExa mDetails.F MExamType. Text;
  9104     End                                                                                   {Exam Deta ils form}
  9105     else If  Assigned(S ender) and  (Sender =  frmGenera teBlankTem plate) The n
  9106     Begin                                                                                 {Blank Tem plate form }
  9107       footde scrip := ' Blank Temp late: ' +  Piece(frmG enerateBla nkTemplate .ListBoxTe mplates.It ems[frmGen erateBlank Template.L istBoxTemp lates.Item Index], '^ ', 1);
  9108     End                                                                                   {Blank Tem plate form }
  9109     else
  9110     begin                                                                                 {All other  senders}
  9111       if Pag e95Control 1.ActivePa ge = TabRe ports Then
  9112       begin
  9113         if O RReportsAv ailable.It emIndex =  -1 Then
  9114         begi n
  9115           Er rorText :=  'Please s elect a re port type  first.';
  9116         end
  9117         else
  9118           fo otdescrip  := 'REPORT : ' + ORRe portsAvail able.Items [OrReports Available. ItemIndex] ;
  9119       end
  9120       else i f Page95Co ntrol1.Act ivePage =  TabDoD the n
  9121       begin
  9122         // P atch 193 -  Remove Do D tab and  associated  code once  Patch 193  is instal led JRL 7/ 20/16
  9123         If n ot IsPatch Installed( 'DVBA*2.7* 193') then
  9124         begi n // Patch  192 or ea rlier
  9125           if  ORListBox DoDReportT ypes.ItemI ndex = -1  then
  9126           be gin
  9127              ErrorText  := 'Please  select a  report typ e first.';
  9128           en d
  9129           el se
  9130              footdescri p := 'FHIE : ' + Piec e(ORListBo xDoDReport Types.Item s[ORListBo xDoDReport Types.Item Index], '^ ', 1);
  9131         end  // IsPatch Installed
  9132       end
  9133       else i f (Page95C ontrol1.Ac tivePage =  AdminDocu ments) the n
  9134       begin
  9135         if ( Tab95Contr ol3.Tabs[T ab95Contro l3.TabInde x] = '&V)   Address')  then
  9136           fo otdescrip  := 'Addres s';
  9137  
  9138         if ( Tab95Contr ol3.Tabs[T ab95Contro l3.TabInde x] = '&W)   Appointme nts') Then
  9139           fo otdescrip  := lblAppt Status.Cap tion;
  9140       end
  9141       else i f Page95Co ntrol1.Act ivePage =  TabClinica lDocuments  Then
  9142       begin                                                                               {Clinical  Documents}
  9143         if ( (lstDocs.I temIndex =  -1) And ( DocType <>  'DIET'))  And (DocTy pe <> 'MUL TI') Then
  9144         begi n
  9145           Er rorText :=  'Please s elect a cl inical doc ument to p rint.';
  9146         end
  9147         else
  9148         begi n                                                                            {Clinical  Document T ypes}
  9149           If  DocType =  'PN' Then
  9150              footdescri p := 'CLIN  DOC: Prog ress Note'
  9151           el se If DocT ype = 'DS'  Then
  9152              footdescri p := 'CLIN  DOC: Disc harge Summ ary'
  9153           el se If DocT ype = 'CN'  Then
  9154              footdescri p := 'CLIN  DOC: Cons ult'
  9155           el se If DocT ype = 'VS'  Then
  9156              footdescri p := 'CLIN  DOC: Vita l Signs ('  + lstDocs .Items[lst Docs.ItemI ndex] + ') '
  9157           el se If DocT ype = 'MED S' Then
  9158              footdescri p := 'CLIN  DOC: Medi cations ('  + lstDocs .Items[lst Docs.ItemI ndex] + ') '
  9159           el se If DocT ype = 'LAB ' Then
  9160              footdescri p := 'CLIN  DOC: Labs  (' + lstD ocs.Items[ lstDocs.It emIndex] +  ')'
  9161           el se If DocT ype = 'IMA GING' Then
  9162              footdescri p := 'CLIN  DOC: Imag ing'
  9163           el se If DocT ype = 'DIE T' Then
  9164              footdescri p := 'CLIN  DOC: Diet '
  9165           el se If DocT ype = 'NUT ASSESS' Th en
  9166              footdescri p := 'CLIN  DOC: Nutr itional As sessment ( ' + lstDoc s.Items[ls tDocs.Item Index] + ' )'
  9167           el se If DocT ype = 'ORD ERS' Then
  9168              footdescri p := 'CLIN  DOC: Orde rs (' + ls tDocs.Item s[lstDocs. ItemIndex]  + ')'
  9169           el se If DocT ype = 'PRO CEDURES' T hen
  9170              footdescri p := 'CLIN  DOC: Proc edure'
  9171           el se If DocT ype = 'PRO BLEM LIST'  Then
  9172              footdescri p := 'CLIN  DOC: Prob lem List ( ' + lstDoc s.Items[ls tDocs.Item Index] + ' )'
  9173           el se If DocT ype = 'MUL TI' Then
  9174              footdescri p := 'CLIN  DOC: Mult i-Document ';
  9175         end;                                                                              {Clinical  Document T ypes}
  9176       End                                                                                 {Clinical  Documents}
  9177       else I f Page95Co ntrol1.Act ivePage =  TabHealthS ummaries T hen
  9178       Begin                                                                               {Health Su mmaries}
  9179         if ( ORHealthSu mmaryUserL ist.ItemIn dex = -1)  and
  9180           (H SMemoLocal .Lines.Cou nt = 0) Th en
  9181         begi n
  9182           Er rorText :=  'Please s elect a he alth summa ry type fi rst.';
  9183         end
  9184         else
  9185         begi n
  9186           If  (ORHealth SummaryUse rList.Item Index > -1 ) Then
  9187              footdescri p := 'HEAL TH SUMMARY  (' + Tab9 5Control2. Tabs[Tab95 Control2.T abIndex] +  '): ' + O RHealthSum maryUserLi st.Items[O rHealthSum maryUserLi st.ItemInd ex]
  9188           El se
  9189              footdescri p := 'HEAL TH SUMMARY  (' + Tab9 5Control2. Tabs[Tab95 Control2.T abIndex] +  '): Adhoc  Report';
  9190         end;
  9191       End;                                                                                {Health Su mmaries}
  9192     End;                                                                                  {All other  senders}
  9193  
  9194     if (Erro rText <> ' ') then
  9195       Result  := False
  9196     else
  9197       Result  := True;
  9198   end;
  9199  
  9200   {========= ========== ========== ========== ========== ========== ========== ===
  9201    FormatRep ort
  9202    This over loaded fun ction acts  as a wrap per and se ts the ref erence
  9203    parameter s required  to allow  normal rep orting to  use the re factored
  9204    FormatRep ort functi on.
  9205    Input:  S ender - ob ject makin g the call
  9206    Output: f unction re sult retur ns True on  success;  otherwise  returns Fa lse.
  9207  
  9208    CodeCR353  - rpm 5/8 /12
  9209    ========= ========== ========== ========== ========== ========== ========== ===}
  9210  
  9211   function T frmMain.Fo rmatReport (Sender: T Object): B oolean;
  9212   var
  9213     footdesc rip: Strin g;
  9214     DtTm: St ring;
  9215     Division : String;
  9216   begin
  9217     footdesc rip := '';
  9218     DtTm :=  '';
  9219     Division  := '';
  9220     Result : = FormatRe port(Sende r, footDes crip, DtTm , Division );
  9221   end;
  9222  
  9223   {========= ========== ========== ========== ========== ========== ========== ===
  9224    FormatRep ort
  9225    This over loaded fun ction form ats text i nto report  format.   Refactored  from
  9226    actFilePr intExecute  for re-us e for Virt ual VA tra nsmission.
  9227    Input:
  9228      Sender  - object m aking the  call
  9229      footDes crip - pas sed by ref erence: de scription  retrieved  from GetFo oterDescri ption
  9230      DtTm -  passed by  reference:  current s erver Date /Time
  9231      Divisio n - passed  by refere nce: user' s DUZ(2) v alue
  9232  
  9233    Output: f unction re sult retur ns True on  success;  otherwise  returns Fa lse.
  9234  
  9235    CodeCR353  - rpm 5/8 /12
  9236    ========= ========== ========== ========== ========== ========== ========== ===}
  9237  
  9238   function T frmMain.Fo rmatReport (Sender: T Object; va r footdesc rip: Strin g;
  9239     var DtTm : String;
  9240     var Divi sion: Stri ng): Boole an;
  9241   const
  9242     REPORT_N OTCODED =  'Printing  has not ye t been cod ed for thi s page.';
  9243   var
  9244     errorTex t: String;
  9245   begin
  9246     //Get fo oter text  and valida te tab sel ections
  9247     if GetFo oterDescri ption(Send er, footde scrip, err orText) th en                    //CodeCR35 3 - rpm 4/ 30/12
  9248     begin                                                                                 {GetFooter  OK}
  9249       if foo tdescrip < > '' Then
  9250       begin                                                                               {FooterTex t defined}
  9251         {Get  Date}
  9252         DtTm  := GetSer verDateTim e();                                                   //CodeCR35 3 - rpm 4/ 30/12
  9253         {Get  Division}
  9254         if C allRPC(RPC Broker1, ' XWB GET VA RIABLE VAL UE', ['DUZ ("2")'], n il, True)  then
  9255           Di vision :=  RPCBroker1 .Results[0 ];
  9256  
  9257         //Fo rmat Foote r
  9258         Form atReportFo oter(Sende r, footdes crip, DtTm , Division );
  9259  
  9260         Anim ateLogo(Tr ue);
  9261         Stat usBarLoadP t.Caption  := 'Printi ng...';
  9262         Stat usBarLoadP t.Repaint;
  9263         Appl ication.Pr ocessmessa ges;
  9264  
  9265         //Fo rmat Repor t
  9266         Form atReportBo dy(Sender) ;
  9267  
  9268         Anim ateLogo(Fa lse);
  9269         Stat usBarLoadP t.Caption  := 'Sendin g...';
  9270         Stat usBarLoadP t.Repaint;
  9271         Resu lt := True ;
  9272       end                                                                                 {FooterTex t defined}
  9273       else
  9274       begin                                                                               {FooterTex t undefine d}
  9275         Show MessageCAP RI(REPORT_ NOTCODED);
  9276         Resu lt := Fals e;
  9277       end;                                                                                {FooterTex t undefine d}
  9278     end                                                                                   {GetFooter  OK}
  9279     else
  9280     begin                                                                                 {GetFooter  failed}
  9281       if err orText <>  '' then
  9282       begin
  9283         Show MessageCAP RI(errorTe xt);
  9284       end;
  9285       Result  := False;
  9286     end;                                                                                  {GetFooter  failed}
  9287   end;
  9288  
  9289   {========= ========== ========== ========== ========== ========== ========== ===
  9290    FormatRep ortBody
  9291    This proc edure popu lates the  QuickRepor t memo con trol with  the report
  9292    text.  Re factored f rom actFil ePrintExec ute.
  9293    Input:  S ender - fo rm
  9294    Output: n one
  9295  
  9296    //CodeCR3 53 - rpm 4 /30/12
  9297    ========= ========== ========== ========== ========== ========== ========== ====}
  9298  
  9299   procedure  TfrmMain.F ormatRepor tBody(Send er: TObjec t);
  9300   var
  9301     x, y: In teger;
  9302   begin
  9303     formPrin t.QRMemoRe port.Paren tRichEdit  := Nil;
  9304     formPrin t.QRMemoRe port.Lines .Clear;
  9305     formPrin t.QRMemoRe port.Font. Size := 11 ;                                           //default  font size
  9306  
  9307     if Assig ned(Sender ) and (Sen der = PNCS Form) Then
  9308     begin                                                                                 {PNCS Exam  report}
  9309       formPr int.QRMemo Report.Par entRichEdi t := PNCSF orm.xSampl eReportOut put;
  9310     end                                                                                   {PNCS Exam  report}
  9311     else if  Assigned(S ender) and  (Sender =  FormTIUDi splay) The n
  9312     begin                                                                                 {CPRS Docu ment view}
  9313       If for mTIUDispla y.SpeedBut tonCAPRI.D own = True  Then
  9314       Begin
  9315         form Print.QRMe moReport.P arentRichE dit := for mTIUDispla y.MemoDocs ;
  9316       End
  9317       Else
  9318         If f ormTIUDisp lay.MemoDo cs.Lines.C ount > 0 T hen
  9319         Begi n
  9320           Fo r y := 0 T o formTIUD isplay.Mem oDocs.Line s.Count -  1 Do
  9321           Be gin
  9322              formPrint. QRMemoRepo rt.Lines.A dd(formTIU Display.Me moDocs.Lin es[y]);
  9323           En d;
  9324         End;
  9325     end                                                                                   {CPRS Docu ment view}
  9326     else If  Assigned(S ender) and  (Sender =  frmExamDe tails) The n
  9327     Begin                                                                                 {Exam Deta ils form}
  9328       If frm ExamDetail s.FMExamDe tailsComme ntsMemo.FM Field = '7 0' Then
  9329       Begin
  9330         // C heck for p roper font  on printe r for 132  column pri ntouts
  9331         If f rmExamDeta ils.RichEd itExamRepo rt.Lines.C ount > 0 T hen
  9332           Fo r y := 0 T o frmExamD etails.Ric hEditExamR eport.Line s.Count -  1 Do
  9333           Be gin
  9334              If Length( frmExamDet ails.RichE ditExamRep ort.Lines[ y]) > 80 T hen
  9335              Begin
  9336                formPrin t.QRMemoRe port.Font. Size := 7;
  9337              End;
  9338           En d;
  9339         //
  9340         form Print.QRMe moReport.L ines.Add(' DATE OF EX AM:         ' + frmEx amDetails. FMDateOfEx am.Text);
  9341         form Print.QRMe moReport.L ines.Add(' EXAMINING  PHYSICIAN:  ' + frmEx amDetails. FMPhysicia n.Text);
  9342         form Print.QRMe moReport.L ines.Add(' STATUS:                ' + frmEx amDetails. FMExamStat us.Text);
  9343         form Print.QRMe moReport.L ines.Add('  ');
  9344         For  y := 0 To  frmExamDet ails.RichE ditExamRep ort.Lines. Count - 1  Do
  9345         Begi n
  9346           fo rmPrint.QR MemoReport .Lines.Add (frmExamDe tails.Rich EditExamRe port.Lines [y]);
  9347         End;
  9348       End;
  9349       If frm ExamDetail s.FMExamDe tailsComme ntsMemo.FM Field = '7 1' Then
  9350       Begin
  9351         form Print.QRMe moReport.P arentRichE dit := frm ExamDetail s.RichEdit ExamReport ;
  9352         frmE xamDetails .RichEditE xamReport. Lines.Inse rt(0, ' ') ;
  9353         frmE xamDetails .RichEditE xamReport. Lines.Inse rt(0, 'STA TUS:               '  + frmExamD etails.FME xamStatus. Text);
  9354         frmE xamDetails .RichEditE xamReport. Lines.Inse rt(0, 'EXA MINING PHY SICIAN: '  + frmExamD etails.FMP hysician.T ext);
  9355         frmE xamDetails .RichEditE xamReport. Lines.Inse rt(0, 'DAT E OF EXAM:         '  + frmExamD etails.FMD ateOfExam. Text);
  9356       End;
  9357     End                                                                                   {Exam Deta ils form}
  9358     else If  Assigned(S ender) and  (Sender =  frmGenera teBlankTem plate) The n
  9359     Begin                                                                                 {Blank Tem plate form }
  9360       If frm GenerateBl ankTemplat e.xSampleR eportOutpu t.Lines.Co unt > 0 Th en
  9361         For  y := 0 To  frmGenerat eBlankTemp late.xSamp leReportOu tput.Lines .Count - 1  Do
  9362         Begi n
  9363           fo rmPrint.QR MemoReport .Lines.Add (frmGenera teBlankTem plate.xSam pleReportO utput.Line s[y]);
  9364         End;
  9365     End                                                                                   {Blank Tem plate form }
  9366     else if  (Page95Con trol1.Acti vePage = A dminDocume nts) then                        {Admin tab }
  9367     begin                                                                                 {Admin Tab }
  9368       if (Ta b95Control 3.Tabs[Tab 95Control3 .TabIndex]  = '&V)  A ddress') t hen
  9369       begin                                                                               {Address s ubtab}
  9370         form Print.QRMe moReport.L ines.Add(' PATIENT: '  + Panel1. Caption);
  9371         form Print.QRMe moReport.L ines.Add('  ');
  9372         form Print.QRMe moReport.L ines.Add(' ** PERMANE NT ADDRESS  **');
  9373         form Print.QRMe moReport.L ines.Add(' ADDRESS: '  + fmEditS treet1.tex t);
  9374         form Print.QRMe moReport.L ines.Add('          '  + fmEditS treet2.tex t);
  9375         form Print.QRMe moReport.L ines.Add('          '  + fmEditS treet3.tex t);
  9376         form Print.QRMe moReport.L ines.Add('    CITY: '  + fmEditC ity.text);
  9377         form Print.QRMe moReport.L ines.Add('   STATE: '  + fmEditS tate.text) ;
  9378         form Print.QRMe moReport.L ines.Add('     ZIP: '  + fmEditZ ip.text);
  9379         form Print.QRMe moReport.L ines.Add('  COUNTY: '  + CountyF ake.text);
  9380         form Print.QRMe moReport.L ines.Add('   PHONE: '  + fmEditP hone.text) ;
  9381         form Print.QRMe moReport.L ines.Add(' OFFICE PHO NE: ' + fm EditOffice .text);
  9382         form Print.QRMe moReport.L ines.Add('  ');
  9383         form Print.QRMe moReport.L ines.Add(' ** TEMPORA RY ADDRESS  **');
  9384         form Print.QRMe moReport.L ines.Add(' TEMP ADDRE SS ACTIVE?  ' + fmEdi t1.text);
  9385         form Print.QRMe moReport.L ines.Add(' START DATE : ' + fmEd it10.text) ;
  9386         form Print.QRMe moReport.L ines.Add('  STOP DATE : ' + fmEd it11.text) ;
  9387         form Print.QRMe moReport.L ines.Add(' ADDRESS: '  + fmEdit2 .text);
  9388         form Print.QRMe moReport.L ines.Add('          '  + fmEdit3 .text);
  9389         form Print.QRMe moReport.L ines.Add('          '  + fmEdit4 .text);
  9390         form Print.QRMe moReport.L ines.Add('    CITY: '  + fmEdit5 .text);
  9391         form Print.QRMe moReport.L ines.Add('   STATE: '  + fmEdit6 .text);
  9392         form Print.QRMe moReport.L ines.Add('     ZIP: '  + fmEdit7 .text);
  9393         form Print.QRMe moReport.L ines.Add('  COUNTY: '  + fmEdit8 .text);
  9394         form Print.QRMe moReport.L ines.Add('   PHONE: '  + fmEdit9 .text);
  9395       end                                                                                 {Address s ubtab}
  9396       else i f (Tab95Co ntrol3.Tab s[Tab95Con trol3.TabI ndex] = '& W)  Appoin tments') t hen
  9397       begin                                                                               {Appointme nts subtab }
  9398         for  y := 0 to  MemoAppoin tments.Lin es.Count -  1 do
  9399         begi n
  9400           fo rmPrint.QR MemoReport .Lines.Add (MemoAppoi ntments.Li nes[y]);
  9401         end;
  9402       end;                                                                                {Appointme nts subtab }
  9403     end                                                                                   {Admin Tab }
  9404     else If  Page95Cont rol1.Activ ePage = Ta bClinicalD ocuments T hen
  9405     Begin                                                                                 {Clinical  Documents}
  9406       For y  := 0 To Me moDocs.Lin es.Count -  1 Do
  9407       Begin
  9408         form Print.QRMe moReport.L ines.Add(M emoDocs.Li nes[y]);
  9409       End;
  9410     End                                                                                   {Clinical  Documents}
  9411     else If  Page95Cont rol1.Activ ePage = Ta bReports T hen
  9412     Begin                                                                                 {Reports T ab}
  9413       If ORR eportsAvai lable.Item s[ORReport sAvailable .ItemIndex ] = 'C&P E xam Detail ' Then
  9414       Begin
  9415         For  y := 0 To  ReportMemo .Lines.Cou nt - 1 Do
  9416         Begi n
  9417           fo rmPrint.QR MemoReport .Lines.Add (ReportMem o.Lines[y] );
  9418         End;
  9419       End
  9420       Else
  9421         For  y := 0 To  ReportMemo .Lines.Cou nt - 1 Do
  9422         Begi n
  9423           fo rmPrint.QR MemoReport .Lines.Add (ReportMem o.Lines[y] );
  9424         End;
  9425     End                                                                                   {Reports T ab}
  9426     else If  Page95Cont rol1.Activ ePage = Ta bDoD Then
  9427     Begin 
  9428       // Pat ch 193 - R emove DoD  tab and as sociated c ode once P atch 193 i s installe d JRL 7/20 /16
  9429       If not  IsPatchIn stalled('D VBA*2.7*19 3') then
  9430       begin  // Patch 1 92 and ear lier                                                                               {DoD  Tab}
  9431         For  y := 0 To  RichEditDO DReport.Li nes.Count  - 1 Do
  9432         Begi n
  9433           fo rmPrint.QR MemoReport .Lines.Add (RichEditD ODReport.L ines[y]);
  9434         End;
  9435       end;
  9436     End                                                                                   {DoD Tab}
  9437     else If  Page95Cont rol1.Activ ePage = Ta bHealthSum maries The n
  9438     Begin                                                                                 {Health Su mmaries}
  9439       TempHS Memo.Clear ;
  9440       // Det ermine loc al or remo te health  summary
  9441       If Tab 95Control2 .TabIndex  = 0 Then
  9442       Begin
  9443         If H SMemoLocal .Lines.Cou nt > 0 The n
  9444           Fo r x := 0 T o HSMemoLo cal.Lines. Count - 1  Do
  9445              TempHSMemo .Add(remov etrailings paces(HSMe moLocal.Li nes[x]));
  9446       End
  9447       Else
  9448       Begin
  9449         If H SMemo.Line s.Count >  0 Then
  9450           Fo r x := 0 T o HSMemo.L ines.Count  - 1 Do
  9451              TempHSMemo .Add(remov etrailings paces(HSMe mo.Lines[x ]));
  9452       End;
  9453  
  9454       For y  := 0 To Te mpHSMemo.C ount - 1 D o
  9455       Begin
  9456         form Print.QRMe moReport.L ines.Add(T empHSMemo[ y]);
  9457       End;
  9458     End                                                                                   {Health Su mmaries}
  9459     else If  Assigned(S ender) and  (Sender =  TIUSignFo rm) Then                         // CodeCR4 23 JRL 11/ 13/12
  9460     Begin {T IUSign For m}                                                                // CodeCR4 23 JRL 11/ 13/12
  9461       For y  := 0 To TI USignForm. TIUtoVVAPr ogressNote s.Count -  1 Do                  // CodeCR4 23 JRL 11/ 13/12
  9462       Begin                                                                               // CodeCR4 23 JRL 11/ 13/12
  9463         form Print.QRMe moReport.L ines.Add(T IUSignForm .TIUtoVVAP rogressNot es[y]);    //   11/13 /12
  9464       End;                                                                                // CodeCR4 23 JRL 11/ 13/12
  9465     End; {TI USign Form }                                                                 // CodeCR4 23 JRL 11/ 13/12
  9466  
  9467   end;
  9468  
  9469   {========= ========== ========== ========== ========== ========== ========== ===
  9470    FormatRep ortFooter
  9471    This proc edure popu lates the  QuickRepor t footer l abels.  Re factored
  9472    from actF ilePrintEx ecute.
  9473    Input:  S ender - fo rm
  9474            f ootDescrip  - documen t descript ion
  9475            D tTm - curr ent server  date/time
  9476            D ivision
  9477    Output: n one
  9478  
  9479    //CodeCR3 53 - rpm 4 /30/12
  9480    ========= ========== ========== ========== ========== ========== ========== ====}
  9481  
  9482   procedure  TfrmMain.F ormatRepor tFooter(Se nder: TObj ect; footD escrip, Dt Tm,
  9483     Division : String);
  9484   begin
  9485  
  9486     //rra 95 9449 if co ming in th rough pncs  form use  patient in fo from th at form
  9487     {Patient  Name}
  9488     if PNCSF orm <> Nil  then
  9489       formPr int.QRLabe l3.Caption  := Copy(P NCSForm.xF MPatientNa me.Caption  + ' SSN#'  + PNCSFor m.xFMSSN.C aption + '                                                                                         ', 1, 51)
  9490     else
  9491       formPr int.QRLabe l3.Caption  := Copy(P anel1.Capt ion + '                                                                                        ',  1, 51);
  9492     formPrin t.QRLabel1 .Caption : = footdesc rip;
  9493     formPrin t.QRLabel4 .Caption : = 'Printed  on: ' + D tTm;
  9494     formPrin t.QRLabel6 .Caption : = 'Divisio n: ' + Div ision;
  9495     formPrin t.QRLabel5 .Caption : = 'System:  ' + Upper case(RPCBr oker1.ANUS trServer);
  9496   end;
  9497  
  9498   {========= ========== ========== ========== ========== ========== ========== ===
  9499    CleanupAf terReport
  9500    This proc edure is r efactored  from actFi lePrintExe cute and p erforms an y
  9501    cleanup r equired fo llowing re port produ ction.
  9502    Input:  S ender - ob ject that  called act PrintFileE xecute
  9503  
  9504    //CodeCR3 53 - rpm 4 /30/12
  9505    ========= ========== ========== ========== ========== ========== ========== ====}
  9506  
  9507   procedure  TfrmMain.C leanupAfte rReport(Se nder: TObj ect);
  9508   begin
  9509     formPrin t.QRMemoRe port.Lines .Clear;
  9510  
  9511     {Remove  the 4 line s inserted  into the  original t ext of
  9512      the Exa m Details  by FormatR eportBody}
  9513     if Assig ned(Sender ) and
  9514       (Sende r = frmExa mDetails)  and
  9515       (frmEx amDetails. FMExamDeta ilsComment sMemo.FMFi eld = '71' ) then
  9516     begin
  9517       frmExa mDetails.R ichEditExa mReport.Li nes.Delete (0);
  9518       frmExa mDetails.R ichEditExa mReport.Li nes.Delete (0);
  9519       frmExa mDetails.R ichEditExa mReport.Li nes.Delete (0);
  9520       frmExa mDetails.R ichEditExa mReport.Li nes.Delete (0);
  9521     end;
  9522   end;
  9523  
  9524   procedure  TfrmMain.a ctFilePrin tPreviewEx ecute(Send er: TObjec t);
  9525   begin
  9526     If ANURe moteProced ureCallInP rogress =  True Then
  9527       exit;
  9528     actFileP rintExecut e(actFileP rintPrevie w);
  9529     //Print1 Click(Prin terSetup1) ;
  9530     //formPr int.button PreviewCli ck(Applica tion);
  9531     exit;
  9532   end;
  9533  
  9534   procedure  TfrmMain.a ctFilePrin tPreviewUp date(Sende r: TObject );
  9535   begin
  9536     If (nopr inting = t rue) or (G ifImageVis taYellow.V isible = T rue) or (f rmPatientL ist <> nil ) then
  9537       actFil ePrintPrev iew.Enable d := false
  9538     else
  9539       actFil ePrintPrev iew.Enable d := true;
  9540  
  9541   end;
  9542  
  9543   procedure  TfrmMain.a ctFilePrin tUpdate(Se nder: TObj ect);
  9544   begin
  9545     If (nopr inting = t rue) or (G ifImageVis taYellow.V isible = T rue) or (f rmPatientL ist <> nil ) then
  9546       actFil ePrint.Ena bled := Fa lse
  9547     else
  9548       actFil ePrint.Ena bled := Tr ue;
  9549   end;
  9550  
  9551   procedure  TfrmMain.a ctFileQuit Execute(Se nder: TObj ect);
  9552   Var
  9553     boCanClo se: Boolea n;
  9554   Begin
  9555     boCanClo se := Fals e;
  9556     FormClos eQuery(Sen der, boCan Close);
  9557     If boCan Close Then  Close();
  9558   end;
  9559  
  9560   procedure  TfrmMain.a ctFileRepo rtsExecute (Sender: T Object);
  9561   Var
  9562     x: integ er;
  9563     foundfla g: boolean ;
  9564   Begin
  9565  
  9566     If ANURe moteProced ureCallInP rogress =  True Then
  9567       exit;
  9568  
  9569     If ReadO nlyMode =  True Then
  9570     Begin
  9571       ShowMe ssageCAPRI ('Access t o reports  is not all owed in re ad only mo de.');
  9572       exit;
  9573     End;
  9574  
  9575     If assig ned(frmRep orts) = fa lse Then
  9576       frmRep orts := Tf rmReports. Create(sel f);
  9577  
  9578     If essov ersion = t rue Then
  9579     Begin
  9580       // Mak e sure use r can be o n current  site befor e running  a report
  9581       foundf lag := fal se;
  9582       If for mESSOSelec t.slUserSi tes.Count  > 0 Then                                    //CodeCR77
  9583         For  x := 0 To  formESSOSe lect.slUse rSites.Cou nt - 1 Do
  9584           If  uppercase (piece(for mESSOSelec t.slUserSi tes[x], '^ ', 2)) = u ppercase(R PCBroker1. Server) Th en
  9585              foundflag  := true;
  9586       If fou ndflag <>  true Then
  9587       Begin
  9588         Show messageCAP RI('You do  not have  direct acc ess to thi s site.  P lease use  FILE | SWI TCH SITES  and pick a  different  site prio r to runni ng a repor t.');
  9589         exit ;
  9590       End;
  9591     End;
  9592  
  9593     frmRepor ts.FormRes ize(applic ation);
  9594     If frmRO Finder.ORL istBoxSite s.Items.Co unt = 0 Th en
  9595       LoadIn stitutions ;
  9596     frmRepor ts.FMRouti ngLocation .Items :=  listmedica lCenterDiv ision;
  9597     frmRepor ts.FMRouti ngLocation 2.Items :=  listmedic alCenterDi vision;
  9598     frmRepor ts.FMRegio nalOfficeN umber.Item s.Clear;
  9599     // Set u p division ...
  9600     searchfo rstring :=  UserDivis ion;
  9601     frmRepor ts.FMRegio nalOfficeN umberEnter (Applicati on);
  9602     searchfo rstring :=  '';
  9603  
  9604     (*
  9605     If frmMa in.lstInst itutions.I tems.Count >0 then
  9606       For x: =0 to frmM ain.lstIns titutions. Items.Coun t-1 do
  9607         frmR eports.FMR egionalOff iceNumber. Items.Add( Copy(frmMa in.lstInst itutions.I tems[x],1, Pos('^',fr mMain.lstI nstitution s.Items[x] )-1));
  9608     frmRepor ts.FMRegio nalOfficeN umber.Text :=UserDivi sion;
  9609     frmRepor ts.FMRegio nalOfficeN umberExit( Applicatio n);
  9610   *)
  9611     frmRepor ts.Height  := frmMain .Height -  32;
  9612     frmRepor ts.Top :=  7 + frmMai n.Top + (( frmMain.He ight - frm Reports.He ight) Div  2);
  9613     frmRepor ts.Width : = frmMain. Width - 75 ;
  9614     frmRepor ts.Left :=  frmMain.L eft + ((fr mMain.Widt h - frmRep orts.Width ) Div 2);
  9615  
  9616     Contexto rChangeMes sage := 'Y ou are vie wing repor ts.  If yo u continue , CAPRI wi ll drop ou t of the c linical co ntext.';
  9617     CCOWBrea kLink := T rue;
  9618  
  9619     frmRepor ts.ReportM emo.Lines. Clear;
  9620     frmRepor ts.ORRepor tsAvailabl e.ItemInde x := -1;
  9621     frmRepor ts.ORRepor tsAvailabl e2.ItemInd ex := -1;
  9622     frmRepor ts.ShowMod al;
  9623     Contexto rChangeMes sage := '' ;
  9624     CCOWBrea kLink := F alse;
  9625     Try
  9626       frmROF inder.Hide ;
  9627     Except
  9628     End;
  9629  
  9630     //frmRep orts := ni l;
  9631  
  9632   end;
  9633  
  9634   procedure  TfrmMain.a ctFileRepo rtsUpdate( Sender: TO bject);
  9635   begin
  9636     If (User HasNewStyl eRestricte dList > 0)  or (GifIm ageVistaYe llow.Visib le = True)  or (frmPa tientList  <> nil) th en
  9637       actFil eReports.E nabled :=  False
  9638     else
  9639       actFil eReports.E nabled :=  True;
  9640   end;
  9641  
  9642   {========= ========== ========== ========== ========== ========== ========== ===
  9643    actFileRe trieveVirt ualVAExecu te
  9644    This acti on handler  processes  the Retri eve from V irtual VA  option.
  9645  
  9646    CodeCR424  - rpm 11/ 13/12
  9647    ========= ========== ========== ========== ========== ========== ========== ===}
  9648  
  9649   procedure  TfrmMain.a ctFileRetr ieveVirtua lVAExecute (Sender: T Object);
  9650   var
  9651     frmVVAGe tDocs: Tfr mVVARetrie val;
  9652   const
  9653     {securit y key mimi cs the VBA  Common Se curity Use r Manageme nt (CSUM)
  9654      credent ial 'VA Ho spital' ro le used to  control a ccess to r estricted
  9655      Virtual  VA docume nts}
  9656     VAHospit alRoleKey  = 'DVBA VV A HOSPITAL  ROLE';
  9657   begin
  9658     frmVVAGe tDocs := T frmVVARetr ieval.Crea te(self);
  9659     try
  9660       frmVVA GetDocs.ed bClaimNum. Text := pa tientSSN;
  9661       frmVVA GetDocs.ed bPatientNa me.Text :=  patientNa me;
  9662   //  frmVVA GetDocs.ed bDOB.Text  := LabelDO B.Caption;
  9663       frmVVA GetDocs.ed bDOB.Text  := StringR eplace(Lab elDOB.Capt ion, 'DOB:  ', ' ', [ rfReplaceA ll]); // r emove the  DOB portio n of the c aption
  9664       //repl ace comma  in name wi th undersc ore, becau se comma i s a delimi ter in web  service
  9665       frmVVA GetDocs.VV AUserID :=  StringRep lace(RPCBr oker1.User .Name, ',' , '_', [rf ReplaceAll ]);
  9666       frmVVA GetDocs.VV ASecToken  := FVirtua lVAToken;
  9667       frmVVA GetDocs.VV AURL := FV irtualVAUR L;
  9668       frmVVA GetDocs.VV ADocDir :=  GetTempDi r;
  9669       frmVVA GetDocs.Is VAHospital Role := Is UserKeyInL ist(VAHosp italRoleKe y);
  9670       if frm VVAGetDocs .GetAndFor matDocumen tList then
  9671         frmV VAGetDocs. ShowModal;
  9672     finally
  9673       FreeAn dNil(frmVV AGetDocs);
  9674     end;
  9675   end;
  9676  
  9677   {========= ========== ========== ========== ========== ========== ========== ===
  9678    actFileRe trieveVirt ualVAUpdat e
  9679    This acti on handler  disables  Retrieve f rom Virtua l VA when  no Virtual  VA
  9680    URL or Se curity tok en is avai lable.
  9681  
  9682    CodeCR424  - rpm 11/ 13/12
  9683    ========= ========== ========== ========== ========== ========== ========== ===}
  9684  
  9685   procedure  TfrmMain.a ctFileRetr ieveVirtua lVAUpdate( Sender: TO bject);
  9686   begin
  9687     if (FVir tualVAURL  = '') or
  9688       (FVirt ualVAToken  = '') The n
  9689       actFil eRetrieveV irtualVA.E nabled :=  False
  9690     else
  9691       actFil eRetrieveV irtualVA.E nabled :=  True;
  9692   end;
  9693  
  9694   {========= ========== ========== ========== ========== ========== ========== ===
  9695    actFileRe trieveDocs VLERDASExe cute
  9696    This acti on handler  processes  the Retri eve from V irtual VA  option.
  9697  
  9698    CodeCR567  - Securit y Keys JRL  05/18/14
  9699    CodeCRXXX  - Retriev e Docs xxx  00/00/00
  9700    ========= ========== ========== ========== ========== ========== ========== ===}
  9701  
  9702   procedure  TfrmMain.a ctFileRetr ieveDocsVL ERDASExecu te(Sender:  TObject);
  9703   var
  9704     frmVlerG etExams: T frmVlerGet Exams;
  9705   begin
  9706        // Up date Execu te method  for "Get D ocs from V LER DAS"
  9707     // ShowM essageCAPR I('Get Doc s from VLE R DAS wind ow goes he re');                   // Stub  testing co de - remov e
  9708  
  9709     frmVlerG etExams :=  TfrmVlerG etExams.Cr eate(self) ;
  9710     try
  9711  
  9712       frmVle rGetExams. ShowModal;
  9713     finally
  9714       FreeAn dNil(frmVl erGetExams );
  9715     end;
  9716   end;                                                                                    // when pr ocedure ge ts written
  9717  
  9718   {========= ========== ========== ========== ========== ========== ========== ===
  9719    actFileRe trieveDocs VLERDASUpd ate
  9720    This acti on handler  disables  Retrieve f rom VLER D AS when no  VLER DAS
  9721    URL or Se curity tok en is avai lable.
  9722  
  9723    CodeCR567  - Securit y Keys JRL  05/18/14
  9724    ========= ========== ========== ========== ========== ========== ========== ===}
  9725  
  9726   procedure  TfrmMain.a ctFileRetr ieveDocsVL ERDASUpdat e(Sender:  TObject);
  9727   begin
  9728      // Upda te Execute  method fo r "Get Doc s from VLE R DAS"
  9729   //  if (TI dHTTPVler. GetVlerDas URL() = '' ) then                     // Co deCR566 LM S No longe r Main for m member.
  9730   //    actF ileRetriev eVirtualVA .Enabled : = False
  9731   //  else
  9732   //    actF ileRetriev eVirtualVA .Enabled : = True;
  9733     actFileR etrieveDoc sVLERDAS.E nabled :=  (TIdHTTPVl er.GetVler DasURL() < > '');     // rpk 1/7 /2015
  9734   end;
  9735  
  9736   procedure  TfrmMain.a ctFileSele ctPatientE xecute(Sen der: TObje ct);
  9737   var
  9738     lastIEN:  String;
  9739   begin
  9740     if IsPNC SOpen() th en                                                                //CodeCR19 7 - rpm 11 /2/11 - do n't allows  patient s witch when  template  open
  9741       Exit;
  9742  
  9743     lastIEN  := Patient IEN;                                                              // CodeCR5 71 - LMS i f patient  changed, t hen refres h PatientI nfoBucket
  9744  
  9745     if FIsDo DUser then                                                                   //CodeCR13 1 - rpm 10 /26/10 - a dd DoD Use r check
  9746       ShowPa tientList( Sender, pf DoD)
  9747     else
  9748       ShowPa tientList( Sender, pf Normal);                                               //CodeCR12 4 -MER 07/ 2010
  9749  
  9750     ReverseE xamRequest SortOrder  := False;                                              // CodeCR7 08 rpk 8/2 7/2015
  9751   //  Revers eAdminSort Order := F alse;                                                    // CodeC R708 rpk 8 /27/2015
  9752     cbxSortE xamReq.Ite mIndex :=  0;                                                     // CodeCR7 08 rpk 8/2 8/2015
  9753  
  9754     If (Pati entIEN <>  lastIEN) T hen
  9755       If ass igned(FPat ientInfoBu cket) Then
  9756         Free AndNil(FPa tientInfoB ucket);                                                // DONE: / / LMS - Re lease old  patient in fo. New on e will be  selected a s needed.
  9757   end;
  9758  
  9759   procedure  TfrmMain.a ctFileSele ctPatientU pdate(Send er: TObjec t);
  9760   begin
  9761     If (GifI mageVistaY ellow.Visi ble = True ) or (frmN ewExam <>  nil) or (f rmViewExam  <> nil) o r
  9762       (frmPa tientList  <> nil) or  (frmNew71 31 <> nil)  or (frmVi ew7131 <>  nil) then
  9763       actFil eSelectPat ient.Enabl ed := Fals e
  9764     else
  9765       actFil eSelectPat ient.Enabl ed := True ;
  9766  
  9767   end;
  9768  
  9769   procedure  TfrmMain.a ctFileSwit chSitesUpd ate(Sender : TObject) ;
  9770   begin
  9771     if (GifI mageVistaY ellow.Visi ble = True ) or (actF ileConnect .Caption =  '&Connect ...') or
  9772       (EssoV ersion = F alse) then
  9773       actFil eSwitchSit es.Enabled  := False
  9774     else
  9775       actFil eSwitchSit es.Enabled  := True;
  9776   end;
  9777  
  9778   {========= ========== ========== ========== ========== ========== ========== ===
  9779    actFileTr ansmitVirt ualVAExecu te
  9780    This acti on handler  processes  text into  a PDF fil e and tran smits the
  9781    PDF file  to the Vir tual VA cl aims syste ms at the  VBA.
  9782  
  9783    CodeCR353  - rpm 5/1 /12
  9784    ========= ========== ========== ========== ========== ========== ========== ===}
  9785  
  9786   procedure  TfrmMain.a ctFileTran smitVirtua lVAExecute (Sender: T Object);
  9787   var
  9788     DtTm: St ring;
  9789     currentD ivision, l ocalStatio n: String;
  9790     footDesc rip: Strin g;
  9791     SendVVA:  TfrmVirtu alVA;
  9792     fileSize Bytes: Lon gInt;
  9793     SendFile : Boolean;
  9794     buffer:  string;
  9795   const
  9796     MAX_SIZE  = 1572864 0;                                                                //The maxi mum file s ize in byt es to prev ent exceed ing 15 mb  files.
  9797     DOC_TYPE  = 344;                                                                      //CAPRI
  9798     DOC_TYPE _CP = 356;                                                                   //C&P Exam s    // Co deCR539 JR L 09/27/13
  9799     DOC_CATE GORY = 44;                                                                   //Medical  Records
  9800     DOC_SUBJ ECT = 'Cli nical Docu ments';
  9801     DOC_SOUR CE = 'CAPR IVISTA';
  9802     DOC_TYPE _DOD = 89;                                                                   // DoD Tab                   //  CodeCR425  JRL 10/19/ 12
  9803     DOC_CATE GORY_DOD =  51;                                                              // DoD Cat egory        // CodeC R425 JRL 1 0/19/12
  9804     DOC_SOUR CE_COMMENT _DOD = 'BH IE FHIE';                                              // CodeCR4 25 JRL 11/ 13/12
  9805     DOC_DOD_ SUBJECT =  'DoD Docum ents';                                                 // CodeCR4 25 JRL 01/ 0/12
  9806   begin
  9807     VVARetra nsmit := T RUE;                                                              // CodeCR7 10 JRL 6/1 1/15
  9808     while VV ARetransmi t do                                                              // CodeCR7 10 JRL 6/1 1/15
  9809     begin                                                                                 // CodeCR7 10 JRL 6/1 1/15
  9810       VVARet ransmit :=  FALSE;                                                           // CodeCR7 10 JRL 6/1 1/15
  9811  
  9812       DtTm : = '';
  9813       curren tDivision  := '';
  9814       localS tation :=  '';
  9815       footde scrip := ' ';
  9816       SendVV A := TfrmV irtualVA.C reate(self );
  9817   //  SendVV A.Position  := poOwne rFormCente r;
  9818       SendVV A.Position  := poScre enCenter;  // rra I82 33197FY16   Patch 193  7/20/16
  9819       //do w e want to  delete the  temporary  PDF file  after tran smission?
  9820       SendVV A.vvaWSC.I sDeleteFil e := NOT F NoDeleteVV A;
  9821       try
  9822         if F ormatRepor t(Sender,  footdescri p, DtTm, c urrentDivi sion) then
  9823         try                                                                               {ReportOK}
  9824           if  (formprin t.QRMemoRe port.Lines .Count > 0 ) then
  9825           be gin                                                                          {Report Te xt availab le}
  9826              SendVVA.vv aWSC.LoadT ext(formPr int.QRMemo Report);
  9827              //Create P DF file
  9828              with SendV VA.vvaWSC. VVAReport  do
  9829              begin
  9830                FooterDe sc := foot Descrip;
  9831                if (form PRint.QRMe moReport.F ont.Size =  7) then
  9832                  FontSi ze := 7
  9833                else
  9834                  FontSi ze := 10;
  9835                FontName  := 'Couri er New';
  9836                PrintDat e := DtTm;
  9837                SystemNa me := Uppe rcase(RPCB roker1.ANU StrServer) ;
  9838                Division  := curren tDivision;
  9839                Patient. FullName : = patientN ame;
  9840                Patient. SSN := pat ientSSN;
  9841              end;
  9842              fileSizeBy tes := Sen dVVA.vvaWS C.CreateXm itFile(Sen dVVA.vvaWS C.vvaRepor t);
  9843  
  9844              // copy th e file to  the heap f or vler da s use
  9845              if fileSiz eBytes > 0  then
  9846              begin
  9847                PdfMemor yStream :=  TMemorySt ream.Creat e;
  9848                try
  9849                  if Sen der is TFo rm then                                                // CodeCR5 65 JRL 07/ 31/14
  9850                  begin                                                                    // CodeCR5 65 JRL 07/ 31/14
  9851                    if ( Sender as  TForm).Nam e = 'TIUSi gnForm' th en                    // CodeCR5 65 JRL 07/ 31/14
  9852                    begi n                                                                 // CodeCR5 65 JRL 07/ 31/14
  9853                      TI USignForm. FinalRepor t := TMemo ryStream.C reate;                // CodeCR5 65 JRL 7/2 0/14
  9854                      TI USignForm. FinalRepor t.LoadFrom File(SendV VA.vvaWSC. vvaReport. VVADoc.Out putFilePat h + 'c' +  SendVVA.vv aWSC.vvaRe port.VVADo c.OutputFi leName); / / CodeCR56 5 JRL 7/20 /14  (Save  report fo r cosigned  exams)
  9855                    end;
  9856                  end;                                                                     // CodeCR5 38 JRL 07/ 31/14
  9857  
  9858   ////           PdfMem oryStream. LoadFromFi le(SendVVA .vvaWSC.vv aReport.VV ADoc.Outpu tFilePath  + SendVVA. vvaWSC.vva Report.VVA Doc.Output FileName);
  9859                  // Rea d compress ed PDF int o memory t o send to  VLER/DAS.
  9860                  PdfMem oryStream. LoadFromFi le(SendVVA .vvaWSC.vv aReport.VV ADoc.Outpu tFilePath  + 'c' + Se ndVVA.vvaW SC.vvaRepo rt.VVADoc. OutputFile Name); //  CodeCR559  JRL 3/17/1 4
  9861                   // Sa ve final r eport - it  may be ne eded for c osignature  report
  9862                except
  9863                  on E:  Exception  do
  9864                  begin
  9865                    Mess ageDlg('PD F report c ould not b e copied a nd will NO T be sent  to VLER.',  mtError,  [mbOK], 0) ;
  9866                    Free AndNil(Pdf MemoryStre am);
  9867                  end;
  9868                end;
  9869              end;
  9870  
  9871              (*  The re quirements  limit Vir tual VA PD F format f iles to 15  MB. *)
  9872              if (fileSi zeBytes <  MAX_SIZE)  then
  9873              begin                                                                        {Does not  exceed siz e limit}
  9874  
  9875                // CodeC R538: If c oming from  TIUSign f orm, don't  ask for c onfirmatio n
  9876                // for t he automat ic transmi ssion to V VA.  Comin g from any  other for m
  9877                // or co ntrol is m anual so c onfirm sen ding
  9878                SendFile  := FALSE;                                                        // CodeCR5 38 JRL 11/ 18/13
  9879                if Sende r is TForm  then                                                  // CodeCR5 38 JRL 11/ 18/13
  9880                begin                                                                      // CodeCR5 38 JRL 11/ 18/13
  9881                  if (Se nder as TF orm).Name  = 'TIUSign Form' then                       // CodeCR5 38 JRL 11/ 18/13
  9882                    Send File := TR UE                                                     // CodeCR5 38 JRL 11/ 18/13
  9883                end;                                                                       // CodeCR5 38 JRL 11/ 18/13
  9884  
  9885                if SendF ile = FALS E then                                                 // CodeCR5 38 JRL 11/ 18/13
  9886                begin                                                                      // CodeCR5 38 JRL 11/ 18/13
  9887                  if Sen dVVA.vvaWS C.IsConfir medToSend( patientNam e) then               // CodeCR5 38 JRL 11/ 18/13
  9888                    Send File := TR UE                                                     // CodeCR5 38 JRL 11/ 18/13
  9889                  else                                                                     // CodeCR5 38 JRL 11/ 18/13
  9890                    Send File := FA LSE                                                    // CodeCR5 38 JRL 11/ 18/13
  9891                end;                                                                       // CodeCR5 38 JRL 11/ 18/13
  9892  
  9893                if SendF ile then                                                          // CodeCR5 38 JRL 11/ 18/13
  9894                begin                                                                      // CodeCR5 38 JRL 11/ 15/13
  9895                  {Get L ocal Stati on name an d number}
  9896                  localS tation :=  GetDivisio n(False, R PCBroker1) ;
  9897  
  9898                  {Popul ate fields  required  to transmi t to the V irtual VA  web
  9899                  servic e}
  9900                  with S endVVA.vva WSC.VVARep ort do
  9901                  begin
  9902                    VVAD oc.DocCate gory := DO C_CATEGORY ;
  9903                    VVAD oc.Source  := DOC_SOU RCE;
  9904                    buff er := Piec e(localSta tion, '^',  2) + ' ('  + Piece(l ocalStatio n, '^', 3)  + ')';
  9905                    VVAD oc.SourceC omment :=  RemoveSpec ialCharact ers(buffer );         // CodeCR5 22 JRL 11/ 21/13
  9906                    VVAD oc.User :=  RPCBroker 1.User.Nam e;
  9907                    VVAD oc.URL :=  FVirtualVA URL;
  9908                    VVAD oc.SecToke n := FVirt ualVAToken ;
  9909                    {Use  C&P Docum ent type a nd Exam as  subject f or C&P Exa ms}
  9910                    if ( Sender = f rmExamDeta ils) then
  9911                    begi n
  9912                      VV ADoc.DocTy pe := DOC_ TYPE_CP;
  9913                      bu ffer := fr mExamDetai ls.FMExamT ype.Text;
  9914                      VV ADoc.Subje ct := Remo veSpecialC haracters( buffer);              // CodeCR5 22 JRL 11/ 21/13
  9915                    end
  9916                    else  if Page95 Control1.A ctivePage  = TabDOD t hen                   // CodeCR4 25 JRL 10/ 19/12
  9917                    begi n  
  9918                      //  Patch 193  - Remove  DoD tab an d associat ed code on ce Patch 1 93 is inst alled JRL  7/20/16
  9919                      If  not IsPat chInstalle d('DVBA*2. 7*193') th en
  9920                      be gin // Pat ch 192 and  earlier                                                                                 // CodeCR 425 JRL 10 /19/12
  9921                         VVADoc.Doc Type := DO C_TYPE_DOD ;                                  // CodeC R425 JRL 1 0/19/12
  9922                         VVADoc.Doc Category : = DOC_CATE GORY_DOD;                          // CodeC R425 JRL 1 0/19/12
  9923                         VVADoc.Sub ject := DO C_DOD_SUBJ ECT;                               // CodeC R425 JRL 1 0/19/12
  9924                         VVADoc.Sou rceComment  := DOC_SO URCE_COMME NT_DOD;                 // CodeC R425 JRL 1 1/9/12
  9925                      en d;
  9926                    end                                                                    // CodeCR4 25 JRL 10/ 19/12
  9927                    else  if (Sende r = TIUSig nForm) the n                                // CodeCR5 39 JRL 09/ 27/13 C&P  Exam Title
  9928                    begi n                                                                 // CodeCR5 39 JRL 09/ 27/13
  9929                      VV ADoc.DocTy pe := DOC_ TYPE_CP;                                    // CodeCR5 39 JRL 09/ 27/13
  9930                      bu ffer := TI USignForm. ParentExam Title;                           // CodeCR5 22 JRL 11/ 21/13
  9931                      VV ADoc.Subje ct := Remo veSpecialC haracters( buffer);              // CodeCR5 22 JRL 11/ 21/13
  9932                    end                                                                    // CodeCR5 39 JRL 09/ 27/13
  9933                    else                                                                   {Default t o CAPRI (3 44) and 'C linical Do cuments'}
  9934                    begi n
  9935                      VV ADoc.DocTy pe := DOC_ TYPE;
  9936                      VV ADoc.Subje ct := DOC_ SUBJECT;
  9937                    end;
  9938                  end;
  9939                  if VAU tils.Scree nReaderAct ive then                                    //508 comp liance
  9940                    Send VVA.Active Control :=  SendVVA.e dVirtualVA Title;
  9941                  SendVV A.ShowModa l;
  9942                end; {OK ToSend}                                                           // CodeCR5 38 JRL 11/ 15/13
  9943              end                                                                          {Does not  exceed lin e count li mit}
  9944              else                                                                         {Exceeds l ine count  limit}
  9945              begin
  9946                ShowMess ageCAPRI(' The docume nt file co ntains '
  9947                  + Send VVA.vvaWSC .FormatByt eSize(file SizeBytes)
  9948                  + ', w hich excee ds the 15  MB'
  9949                  + ' ma ximum file  size allo wed.');
  9950              end;
  9951           en d                                                                            {Report Te xt availab le}
  9952           el se                                                                           {NO Report  Text avai lable}
  9953           be gin
  9954              ShowMessag eCAPRI('No  text to s end to Vir tual VA.') ;
  9955           en d;
  9956         fina lly
  9957           Cl eanupAfter Report(Sen der);
  9958         end;                                                                              {ReportOK}
  9959       finall y
  9960         Free AndNil(Sen dVVA);
  9961         Anim ateLogo(Fa lse);                                                             // rra 998 063 change  status ba ck to read y
  9962         Stat usBarLoadP t.Caption  := 'Ready. ';                                          // rra 998 063
  9963         Stat usBarLoadP t.Repaint;                                                        // rra 998 063
  9964         Appl ication.Pr ocessmessa ges;                                                   // rra 998 063
  9965       end;
  9966     end;                                                                                  // while V VARetransm it     //  CodeCR710  JRL 6/11/1 5
  9967   end;
  9968  
  9969   {========= ========== ========== ========== ========== ========== ========== ===
  9970    actFileTr ansmitVirt ualVAUpdat e
  9971    This acti on handler  disables  Transmit t o Virtual  VA when th e VistaWeb
  9972    tab is th e active t ab or no V irtual VA  URL is ava ilable.
  9973  
  9974    CodeCR353  - rpm 5/7 /12
  9975    ========= ========== ========== ========== ========== ========== ========== ===}
  9976  
  9977   procedure  TfrmMain.a ctFileTran smitVirtua lVAUpdate( Sender: TO bject);
  9978   begin
  9979     if (FVir tualVAURL  = '') or
  9980       (FVirt ualVAToken  = '') or
  9981       (Page9 5Control1. ActivePage  = TabVist AWeb) Then
  9982       actFil eTransmitV irtualVA.E nabled :=  False
  9983     else
  9984       actFil eTransmitV irtualVA.E nabled :=  True;
  9985   end;
  9986  
  9987   procedure  TfrmMain.a ctHelpAbou tExecute(S ender: TOb ject);
  9988   begin
  9989     If ANURe moteProced ureCallInP rogress =  True Then
  9990       exit;
  9991     frmAbout Form := Tf rmAboutFor m.Create(f rmMain);
  9992     frmAbout Form.butto n1.Font :=  Panel1.Fo nt;
  9993     frmAbout Form.butto n1.Height  := Panel1. Height;
  9994     frmAbout Form.butto n1.Top :=  frmAboutFo rm.height  - panel1.h eight * 2  - 16;
  9995     frmAbout Form.Top : = 7 + frmM ain.Top +  ((frmMain. Height - f rmAboutFor m.Height)  Div 2);
  9996     frmAbout Form.Left  := frmMain .Left + (( frmMain.Wi dth - frmA boutForm.W idth) Div  2);
  9997     frmAbout Form.Edit1 .Text := V ersionUser ;
  9998     frmAbout Form.ShowM odal;
  9999     frmAbout Form.relea se;
  10000     frmAbout Form := Ni l;
  10001   end;
  10002  
  10003   procedure  TfrmMain.a ctHelpAbou tUpdate(Se nder: TObj ect);
  10004   begin
  10005     If (GifI mageVistaY ellow.Visi ble = true ) or (frmN ewExam <>  nil) or
  10006       (frmVi ewExam <>  nil) or (f rmPatientL ist <> nil ) then
  10007       actHel pAbout.Ena bled := fa lse
  10008     else
  10009       actHel pAbout.Ena bled := Tr ue;
  10010   end;
  10011  
  10012   procedure  TfrmMain.a ctHelpAudi tUtilExecu te(Sender:  TObject);
  10013   Var
  10014     tempstrs erver, tem pstrport:  String;
  10015     tempUser IEN: Strin g;
  10016   Begin
  10017     TempStrS erver := U ppercase(R PCBroker1. ANUStrServ er);
  10018     TempStrP ort := RPC Broker1.AN UStrPort;
  10019     TempUser IEN := Aut horIEN;
  10020     AuthorIE N := UserD UZHomeServ er;
  10021  
  10022     ESSOConn ecting :=  True;
  10023     AuditInP rogress :=  True;
  10024     RPCBroke r1.Connect ed := Fals e;
  10025     RPCBroke r1.Server  := RPCBrok er1.ANUStr ServerHome ;
  10026     RPCBroke r1.Listene rPort := S trtoInt(RP CBroker1.A NUStrPortH ome);
  10027     //RPCBro ker1.Conne cted := Tr ue;   BSE  mod - rpm  1/8/09
  10028     //If Not  Authorize dOption('D VBA CAPRI  GUI AUDIT  TRAIL') Th en   BSE m od - rpm 1 /8/09
  10029     if not C onnectToSe rver('DVBA  CAPRI GUI  AUDIT TRA IL') then
  10030     Begin
  10031       ShowMe ssageCAPRI ('Could no t use opti on "DVBA C APRI GUI A UDIT TRAIL !"');
  10032       applic ation.term inate;
  10033     End;
  10034     ESSOConn ecting :=  False;
  10035  
  10036     If ANURe moteProced ureCallInP rogress =  True Then
  10037       exit;
  10038  
  10039     frmAudit Trail := T frmAuditTr ail.create (frmMain);
  10040     frmAudit Trail.Show ;
  10041     frmAudit Trail.Brin gToFront;
  10042     frmAudit Trail.Hide ;
  10043  
  10044     Contexto rChangeMes sage := 'Y ou are run ning an au dit report .  If you  continue,  CAPRI will  drop out  of the cli nical cont ext.';
  10045     CCOWBrea kLink := T rue;
  10046     frmAudit Trail.Show Modal;
  10047     Contexto rChangeMes sage := '' ;
  10048     CCOWBrea kLink := F alse;
  10049  
  10050     frmAudit Trail.rele ase;
  10051     frmAudit Trail := N il;
  10052  
  10053     //Connec t back to  remote her e
  10054     AuthorIE N := TempU serIEN;
  10055     ESSOConn ecting :=  True;
  10056     RPCBroke r1.Connect ed := Fals e;
  10057     RPCBroke r1.Server  := TempStr Server;
  10058     RPCBroke r1.Listene rPort := S trtoInt(Te mpStrPort) ;
  10059     //RPCBro ker1.Conne cted := Tr ue;  BSE m od - rpm 1 /8/09
  10060     //If Not  Authorize dOption('D VBA CAPRI  GUI') Then   BSE mod  - rpm 1/8/ 09
  10061     if not C onnectToSe rver('DVBA  CAPRI GUI ') then
  10062     Begin
  10063       ShowMe ssageCAPRI ('Could no t use opti on "DVBA C APRI GUI!" ');
  10064       applic ation.term inate;
  10065     End;
  10066     ESSOConn ecting :=  False;
  10067     AuditInP rogress :=  False;
  10068   end;
  10069  
  10070   procedure  TfrmMain.a ctHelpAudi tUtilUpdat e(Sender:  TObject);
  10071   begin
  10072   //FYI, thi s code wil l get trig gered rega rdless of  the state  of THIS me nu item,
  10073   //enabled,  disabled,  visible o r not. The  update ev ents trigg er for eac h menu opt ion, in
  10074   //the orde r displaye d, top - d own. Thus,  this code  will work  for all m enus that  fall
  10075   //under th is one.
  10076   //UserFile manCode sh ould have  been set w hen we con nected
  10077  
  10078     If (ESSO Version =  True) and  (frmPatien tList = ni l) and ((P os('@', us erfilemanc ode) > 0)  Or
  10079       (Pos(' u', userfi lemancode)  > 0) Or ( Pos('U', u serfileman code) > 0) ) Then
  10080     Begin
  10081       actHel pCheckConn ections.Vi sible := T rue;
  10082       actHel pEditRemot eUser.Visi ble := Tru e;
  10083       actHel pEditPatie ntLists.Vi sible := T rue;
  10084       actHel pConsRepor ts.Visible  := True;
  10085       actHel pAuditUtil .Visible : = True;
  10086     End
  10087     else
  10088     begin
  10089       actHel pCheckConn ections.Vi sible := f alse;
  10090       //N8.V isible :=  false;
  10091       actHel pEditRemot eUser.Visi ble := fal se;
  10092       actHel pEditPatie ntLists.Vi sible := f alse;
  10093       actHel pConsRepor ts.Visible  := false;
  10094       actHel pAuditUtil .Visible : = false;
  10095     end;
  10096   end;
  10097  
  10098   procedure  TfrmMain.a ctHelpCAPR ITrainingE xecute(Sen der: TObje ct);
  10099   begin
  10100     //CAPRI_ CodeCR95   - jcs - 05 /20/2010
  10101     if not C allRPC(RPC Broker1, ' DVBAB GET  URL', ['2' ], nil) th en
  10102       exit;
  10103  
  10104     If RPCBr oker1.Resu lts.Count  > 0 Then
  10105     Begin
  10106       xHyper linkLabel1 .targetURL  := RPCBro ker1.Resul ts[0];
  10107       xHyper linkLabel1 .Navigate;
  10108     End;
  10109   end;
  10110  
  10111   procedure  TfrmMain.a ctHelpChec kConnectio nsExecute( Sender: TO bject);
  10112   Var
  10113     TempStrS erver: Str ing;
  10114     TempStrP ort: Integ er;
  10115     RemoteDa taTimer: B oolean;
  10116   Begin
  10117     If ANURe moteProced ureCallInP rogress =  True Then
  10118       exit;
  10119     RemoteDa taTimer :=  TimerRemo teData.Ena bled;
  10120     TimerRem oteData.En abled := f alse;
  10121     timeoutt imer.enabl ed := fals e;
  10122  
  10123     //Store  connection  date
  10124     TempStrS erver := R PCBroker1. Server;
  10125     TempStrP ort := RPC Broker1.Li stenerPort ;
  10126  
  10127     frmCheck RemoteConn ections :=  TfrmCheck RemoteConn ections.Cr eate(frmMa in);
  10128     Contexto rChangeMes sage := 'Y ou are che cking remo te connect ions.  If  you contin ue, CAPRI  will drop  out of the  clinical  context.';
  10129     CCOWBrea kLink := T rue;
  10130     frmCheck RemoteConn ections.Sh owmodal;                                               // Check f or cancel  button and  exit
  10131     Contexto rChangeMes sage := '' ;
  10132     CCOWBrea kLink := F alse;
  10133  
  10134     //Reconn ect to ori ginal host
  10135     RPCBroke r1.Server  := TempStr Server;
  10136     RPCBroke r1.Listene rPort := T empStrPort ;
  10137  
  10138     If Not C onnectToSe rver('DVBA  CAPRI GUI ') Then
  10139     Begin
  10140       ShowMe ssageCAPRI ('Could no t use opti on "DVBA C APRI GUI!" ');
  10141       applic ation.term inate;
  10142     End;
  10143     If RPCBr oker1.Conn ected = Fa lse Then
  10144     Begin
  10145       ShowMe ssageCAPRI ('Could no t use opti on "DVBA C APRI GUI!" ');
  10146       applic ation.term inate;
  10147     End;
  10148  
  10149     frmCheck RemoteConn ections.re lease;
  10150     frmCheck RemoteConn ections :=  Nil;
  10151     timeoutt imer.enabl ed := true ;
  10152     TimerRem oteData.En abled := R emoteDataT imer;
  10153   end;
  10154  
  10155   procedure  TfrmMain.a ctHelpCons ReportsExe cute(Sende r: TObject );
  10156   Var
  10157     TempStrS erver: Str ing;
  10158     TempStrP ort: Integ er;
  10159     RemoteDa taTimer: B oolean;
  10160   Begin
  10161  
  10162     If ANURe moteProced ureCallInP rogress =  True Then
  10163       exit;
  10164     RemoteDa taTimer :=  TimerRemo teData.Ena bled;
  10165     TimerRem oteData.En abled := f alse;
  10166     timeoutt imer.enabl ed := fals e;
  10167  
  10168     //Store  connection  data
  10169     TempStrS erver := R PCBroker1. Server;
  10170     TempStrP ort := RPC Broker1.Li stenerPort ;
  10171  
  10172     frmRemot eReports : = TfrmRemo teReports. Create(frm Main);
  10173     Contexto rChangeMes sage := 'Y ou are run ning conso lidated re ports.  If  you conti nue, CAPRI  will drop  out of th e clinical  context.' ;
  10174     CCOWBrea kLink := T rue;
  10175     frmRemot eReports.S howmodal;                                                         // Check f or cancel  button and  exit
  10176     Contexto rChangeMes sage := '' ;
  10177     CCOWBrea kLink := F alse;
  10178  
  10179     ESSOConn ecting :=  True;
  10180     //Reconn ect to ori ginal host
  10181     RPCBroke r1.Server  := TempStr Server;
  10182     RPCBroke r1.Listene rPort := T empStrPort ;
  10183  
  10184     If Not C onnectToSe rver('DVBA  CAPRI GUI ') Then
  10185     Begin
  10186       ShowMe ssageCAPRI ('Could no t use opti on "DVBA C APRI GUI!" ');
  10187       applic ation.term inate;
  10188     End;
  10189     If RPCBr oker1.Conn ected = Fa lse Then
  10190     Begin
  10191       ShowMe ssageCAPRI ('Could no t use opti on "DVBA C APRI GUI!" ');
  10192       applic ation.term inate;
  10193     End;
  10194     ESSOConn ecting :=  False;
  10195  
  10196     frmRemot eReports.r elease;
  10197     frmRemot eReports : = Nil;
  10198     timeoutt imer.enabl ed := true ;
  10199     TimerRem oteData.En abled := R emoteDataT imer;
  10200   end;
  10201  
  10202   procedure  TfrmMain.a ctHelpEdit PatientLis tsExecute( Sender: TO bject);
  10203   Var
  10204     TempStrS erver: Str ing;
  10205     TempStrP ort: Integ er;
  10206   Begin
  10207     If ANURe moteProced ureCallInP rogress =  True Then
  10208       exit;
  10209  
  10210     timeoutt imer.enabl ed := fals e;
  10211  
  10212     ESSOConn ecting :=  True;
  10213  
  10214     TempStrS erver := R PCBroker1. Server;
  10215     TempStrP ort := RPC Broker1.Li stenerPort ;
  10216     RPCBroke r1.Connect ed := Fals e;
  10217     RPCBroke r1.Server  := homeser ver;
  10218     RPCBroke r1.Listene rPort := S trToInt(ho meport);
  10219     //RPCBro ker1.Conne cted := Tr ue;  BSE m od - rpm 1 /8/09
  10220  
  10221     If Not C onnectToSe rver('DVBA  CAPRI GUI ') Then
  10222     Begin
  10223       ShowMe ssageCAPRI ('Could no t use opti on "DVBA C APRI GUI!" ');
  10224       applic ation.term inate;
  10225     End;
  10226     If RPCBr oker1.Conn ected = Fa lse Then
  10227     Begin
  10228       ShowMe ssageCAPRI ('Could no t use opti on "DVBA C APRI GUI!" ');
  10229       applic ation.term inate;
  10230     End;
  10231     ESSOConn ecting :=  False;
  10232  
  10233     If Not a ssigned(fr mEditPatie ntLists) T hen
  10234       frmEdi tPatientLi sts := tfr mEditPatie ntLists.Cr eate(frmma in);
  10235  
  10236     frmEditP atientList s.Timer1.E nabled :=  True;
  10237     Contexto rChangeMes sage := 'Y ou are edi ting user  site acces s.  If you  continue,  CAPRI wil l drop out  of the cl inical con text.';
  10238  
  10239     CCOWBrea kLink := T rue;
  10240  
  10241     frmEditP atientList s.Showmoda l;
  10242  
  10243     Contexto rChangeMes sage := '' ;
  10244     CCOWBrea kLink := F alse;
  10245  
  10246     ESSOConn ecting :=  True;
  10247     RPCBroke r1.Connect ed := Fals e;
  10248     RPCBroke r1.Server  := TempStr Server;
  10249     RPCBroke r1.Listene rPort := T empStrPort ;
  10250     //RPCBro ker1.Conne cted := Tr ue;  BSE m od - rpm 1 /8/09
  10251  
  10252     If Not C onnectToSe rver('DVBA  CAPRI GUI ') Then
  10253     Begin
  10254       ShowMe ssageCAPRI ('Could no t use opti on "DVBA C APRI GUI!" ');
  10255       applic ation.term inate;
  10256     End;
  10257     If RPCBr oker1.Conn ected = Fa lse Then
  10258     Begin
  10259       ShowMe ssageCAPRI ('Could no t use opti on "DVBA C APRI GUI!" ');
  10260       applic ation.term inate;
  10261     End;
  10262  
  10263     ESSOConn ecting :=  False;
  10264     timeoutt imer.enabl ed := true ;
  10265   end;
  10266  
  10267   procedure  TfrmMain.a ctHelpEdit RemoteUser Execute(Se nder: TObj ect);
  10268   Var
  10269     TempStrS erver: Str ing;
  10270     TempStrP ort: Integ er;
  10271   Begin
  10272     If ANURe moteProced ureCallInP rogress =  True Then
  10273       exit;
  10274     frmRemot eUserSites Editor :=  tfrmRemote UserSitesE ditor.Crea te(frmmain );
  10275     timeoutt imer.enabl ed := fals e;
  10276  
  10277     //Store  connection  data
  10278     TempStrS erver := R PCBroker1. Server;
  10279     TempStrP ort := RPC Broker1.Li stenerPort ;
  10280     ESSOConn ecting :=  True;
  10281     RPCBroke r1.Connect ed := Fals e;
  10282     RPCBroke r1.Server  := homeser ver;
  10283     RPCBroke r1.Listene rPort := S trToInt(ho meport);
  10284     //RPCBro ker1.Conne cted := Tr ue;   BSE  mod - rpm  1/8/09
  10285     If Not C onnectToSe rver('DVBA  CAPRI GUI ') Then
  10286     Begin
  10287       ShowMe ssageCAPRI ('Could no t use opti on "DVBA C APRI GUI!" ');
  10288       applic ation.term inate;
  10289     End;
  10290     If RPCBr oker1.Conn ected = Fa lse Then
  10291     Begin
  10292       ShowMe ssageCAPRI ('Could no t use opti on "DVBA C APRI GUI!" ');
  10293       applic ation.term inate;
  10294     End;
  10295     ESSOConn ecting :=  False;
  10296  
  10297     frmCheck RemoteConn ections :=  TfrmCheck RemoteConn ections.Cr eate(frmMa in);
  10298     frmRemot eUserSites Editor.Tim er1.Enable d := True;
  10299     Contexto rChangeMes sage := 'Y ou are edi ting user  site acces s.  If you  continue,  CAPRI wil l drop out  of the cl inical con text.';
  10300     CCOWBrea kLink := T rue;
  10301     frmRemot eUserSites Editor.Sho wmodal;
  10302     Contexto rChangeMes sage := '' ;
  10303     CCOWBrea kLink := F alse;
  10304  
  10305     ESSOConn ecting :=  True;
  10306     //Reconn ect to ori ginal host
  10307     RPCBroke r1.Connect ed := Fals e;
  10308     RPCBroke r1.Server  := TempStr Server;
  10309     RPCBroke r1.Listene rPort := T empStrPort ;
  10310     //RPCBro ker1.Conne cted := Tr ue;  BSE m od - rpm 1 /8/09
  10311  
  10312     If Not C onnectToSe rver('DVBA  CAPRI GUI ') Then
  10313     Begin
  10314       ShowMe ssageCAPRI ('Could no t use opti on "DVBA C APRI GUI!" ');
  10315       applic ation.term inate;
  10316     End;
  10317     If RPCBr oker1.Conn ected = Fa lse Then
  10318     Begin
  10319       ShowMe ssageCAPRI ('Could no t use opti on "DVBA C APRI GUI!" ');
  10320       applic ation.term inate;
  10321     End;
  10322     ESSOConn ecting :=  False;
  10323  
  10324     timeoutt imer.enabl ed := true ;
  10325     frmRemot eUserSites Editor.Rel ease;
  10326     frmRemot eUserSites Editor :=  Nil;
  10327   end;
  10328  
  10329   procedure  TfrmMain.a ctHelpEdtC ancelReaso nsExecute( Sender: TO bject);               // CodeCR6 98 - RPK 3 /24/2015
  10330   begin
  10331     frmEdtCa ncelReason s := TfrmE dtCancelRe asons.Crea te(Applica tion);
  10332     try
  10333       frmEdt CancelReas ons.ShowMo dal;
  10334     finally
  10335       FreeAn dNil(frmEd tCancelRea sons);
  10336     end;
  10337   end;                                                                                    // CodeCR6 98 - RPK 3 /24/2015
  10338  
  10339   { procedur e TfrmMain .actHelpEd tCancelRea sonsUpdate (Sender: T Object);                // CodeC R698 - RPK  3/24/2015
  10340   var
  10341     bret: Bo olean;
  10342   begin
  10343     if IsPat chInstalle d('DVBA*2. 7*190') th en begin
  10344       bret : = IsUserKe y('DVBA CA PRI EXAMCA NC');
  10345       actHel pEdtCancel Reasons.En abled := b ret;
  10346       actHel pEdtCancel Reasons.Vi sible := b ret;
  10347     end;
  10348                                                                                    end; } // CodeCR6 98 - RPK 3 /24/2015
  10349  
  10350   procedure  TfrmMain.a ctHelpEdtI nsuffReaso nsExecute( Sender: TO bject);               // CodeCR6 98 - RPK 3 /30/2015
  10351   begin
  10352     frmEdtIn suffReason s := TfrmE dtInsuffRe asons.Crea te(Applica tion);
  10353     try
  10354       frmEdt InsuffReas ons.ShowMo dal;
  10355     finally
  10356       FreeAn dNil(frmEd tInsuffRea sons);
  10357     end;
  10358   end;                                                                                   
  10359  
  10360   // ------- ---------- ---------- ---------- ---------- ---------- ---------- ----------
  10361   // Menu It em: Manage  Routing R easons                         P atch 193 J RL 7/29/16
  10362   // ------- ---------- ---------- ---------- ---------- ---------- ---------- ----------
  10363   procedure  TfrmMain.a ctHelpEdtR erouteReas onsExecute (Sender: T Object);
  10364   begin
  10365     frmEdtRe RouteReaso ns := Tfrm EdtReRoute Reasons.Cr eate(Appli cation);
  10366     try
  10367       frmEdt ReRouteRea sons.ShowM odal;
  10368     finally
  10369       FreeAn dNil(frmEd tReRouteRe asons);
  10370     end;
  10371   end;
  10372  
  10373   // CodeCR6 98 - RPK 3 /30/2015
  10374  
  10375   { procedur e TfrmMain .actHelpEd tInsuffRea sonsUpdate (Sender: T Object);                // CodeC R698 - RPK  3/30/2015
  10376   var
  10377     bret: Bo olean;
  10378   begin
  10379     if IsPat chInstalle d('DVBA*2. 7*190') th en begin
  10380       bret : = IsUserKe y('DVBA CA PRI EXAMIN SUFF');
  10381       actHel pEdtInsuff Reasons.En abled := b ret;
  10382       actHel pEdtInsuff Reasons.Vi sible := b ret;
  10383     end;
  10384                                                                                     end;  }// CodeCR 698 - RPK  3/30/2015
  10385  
  10386   procedure  TfrmMain.a ctHelpRPCB rokerHisto ryExecute( Sender: TO bject);
  10387   begin
  10388     frmBroke rHistoryBu ffer.showm odal;
  10389   end;
  10390  
  10391   procedure  TfrmMain.a ctHelpRPCB rokerHisto ryUpdate(S ender: TOb ject);
  10392   begin
  10393     If (Pos( '@', userf ilemancode ) > 0) the n
  10394       actHel pRPCBroker History.vi sible := t rue
  10395     else
  10396       actHel pRPCBroker History.vi sible := f alse;
  10397   end;
  10398  
  10399  
  10400   //-------- ---------- ---------- ---------- ---------- ---------- ---------- ----------
  10401   // Help Me nu - Manag e VR&E Rou ting Reaso ns                     Patch197  JRL 2/9/17
  10402   //-------- ---------- ---------- ---------- ---------- ---------- ---------- ----------
  10403   procedure  TfrmMain.a ctHelpEdtV RERerouteR easonsExec ute(Sender : TObject) ;
  10404   begin
  10405     // Inser t Patch 19 7 code her e JRL 2/8/ 17
  10406     frmEdtVR ReRouteRea sons := Tf rmEdtVRReR outeReason s.Create(N il);
  10407     try
  10408       frmEdt VRReRouteR easons.Sho wModal;
  10409     finally
  10410       FreeAn dNil(frmEd tVRReRoute Reasons);
  10411     end;
  10412   end;
  10413  
  10414   procedure  TfrmMain.A ctionMainM enuBar1Ent erMenuLoop (Sender: T Object);
  10415   begin
  10416     {The fol lowing is  a workarou nd for a c ouple of d efects in  the TActio nMainMenuB ar.
  10417      When th e Windows  setting is  checkd to  'Hide und erline let ters for k eyboard
  10418      naviati on until I  press the  Alt key'  (windows X P), for so me reason,  when the
  10419      mouse i s used to  navigate t he menu, a ny menu op tion that  contains a n '&', suc h
  10420      as 'C&P ', display s as 'CP_' . When usi ng the key board, eve rything is  fine.
  10421      The obv ious solut ion was to  enable Pe rsistentHo tKeys on t he control , to alway s
  10422      force t he shortcu t keys to  display, w hich bypas ses the de fect. Howe ver,
  10423      Persist entHotKeys  keeps get ting disab led at run  time afte r each dis play of a
  10424      menu. S o, the wor karound to  both prob lems is to  keep rese tting Pers istentHotK eys
  10425      to true  each time  the menu  is accesse d, now whe n the Wind ows option  is checke d,
  10426      the '&'  in a menu  option di splays as  it is supp ose to via  th mouse,  AND, the
  10427      shortcu t keys onl y display  when the A LT key s p ressed (go  figured?)
  10428      jcs - C APRI_CodeC R60
  10429     }
  10430     ActionMa inMenuBar1 .Persisten tHotKeys : = True;
  10431   end;
  10432  
  10433   procedure  TfrmMain.a ctPopEditC heckSpelli ngExecute( Sender: TO bject);
  10434   Var
  10435     msg: TMs g;
  10436     handled:  Boolean;
  10437   Begin
  10438     handled  := false;
  10439     msg.mess age := WM_ KEYUP;
  10440     msg.wPar am := VK_F 7;
  10441     AppMessa ge(msg, ha ndled);
  10442  
  10443   end;
  10444  
  10445   procedure  TfrmMain.a ctPopEditC opyExecute (Sender: T Object);
  10446   begin
  10447     Sender : = screen.A ctiveContr ol;
  10448  
  10449     If Sende r.ClassTyp e = TMemo  Then
  10450     Begin
  10451       (Sende r As TMemo ).CopyToCl ipboard;
  10452     End
  10453     Else
  10454       If Sen der.ClassT ype = TEdi t Then
  10455       Begin
  10456         (Sen der As TEd it).CopyTo Clipboard;
  10457       End
  10458       Else
  10459         If S ender.Clas sType = TR ichEdit Th en
  10460         Begi n
  10461           (S ender As T RichEdit). CopyToClip board;
  10462         End
  10463         Else
  10464           Sl eep(1);                                                                      //Showmess age('Unkno wn class t ype: '+Sen der.ClassN ame);
  10465   end;
  10466  
  10467   procedure  TfrmMain.a ctPopEditC utExecute( Sender: TO bject);
  10468   begin
  10469     Sender : = screen.A ctiveContr ol;
  10470  
  10471     If Sende r.ClassTyp e = TMemo  Then
  10472     Begin
  10473       (Sende r As TMemo ).CutToCli pboard;
  10474     End
  10475     Else
  10476       If Sen der.ClassT ype = TEdi t Then
  10477       Begin
  10478         (Sen der As TEd it).CutToC lipboard;
  10479       End
  10480       Else
  10481         If S ender.Clas sType = TR ichEdit Th en
  10482         Begi n
  10483           (S ender As T RichEdit). CutToClipb oard;
  10484         End
  10485         Else
  10486           Sl eep(1);                                                                      //Showmess age('Unkno wn class t ype: '+Sen der.ClassN ame);
  10487   end;
  10488  
  10489   procedure  TfrmMain.a ctPopEditL oadExamExe cute(Sende r: TObject );
  10490   Var
  10491     x: integ er;
  10492     date1, d ate2, date 3: String;
  10493   Begin
  10494     frmExamR equestComm ents := Tf rmExamRequ estComment s.create(p ncsform);
  10495  
  10496     { Get AM IE Exam Re quests}
  10497     frmExamR equestComm ents.FMExa mRequestLi ster1.Part List.Clear ;
  10498     frmExamR equestComm ents.FMExa mRequestLi ster1.Part List.Add(P NCSForm.xP atientIENS .Caption);
  10499     frmExamR equestComm ents.FMExa mRequestLi stbox.GetL ist;
  10500     // Make  sure data  is correct  for Patie ntIEN
  10501     If frmEx amRequestC omments.FM ExamReques tListbox.I tems.Count  > 0 Then
  10502       For x  := frmExam RequestCom ments.FMEx amRequestL istbox.Ite ms.Count -  1 Downto  0 Do
  10503       Begin
  10504         If P os(PNCSFor m.xPatient IENS.Capti on + '  ',  frmExamRe questComme nts.FMExam RequestLis tbox.Items [x]) <> 1  Then
  10505           fr mExamReque stComments .FMExamReq uestListbo x.Items.De lete(x);
  10506       End;
  10507     // Refor mat data
  10508     // Don't  show comp lete or ca ncelled ex ams
  10509     If frmEx amRequestC omments.FM ExamReques tListbox.I tems.Count  > 0 Then
  10510       For x  := frmExam RequestCom ments.FMEx amRequestL istbox.Ite ms.Count -  1 Downto  0 Do
  10511       Begin
  10512         frmE xamRequest Comments.F MExamReque stListbox. Items[x] : = Copy(frm ExamReques tComments. FMExamRequ estListbox .Items[x],  Pos('  ',  frmExamRe questComme nts.FMExam RequestLis tbox.Items [x]) + 4,  255);
  10513           //  Strip pat ient IEN;
  10514         Date 1 := Copy( frmExamReq uestCommen ts.FMExamR equestList box.Items[ x], 1, Pos ('  ', frm ExamReques tComments. FMExamRequ estListbox .Items[x])  - 1);
  10515         frmE xamRequest Comments.F MExamReque stListbox. Items[x] : = Copy(frm ExamReques tComments. FMExamRequ estListbox .Items[x],  Pos('  ',  frmExamRe questComme nts.FMExam RequestLis tbox.Items [x]) + 4,  500);
  10516         Date 2 := Copy( frmExamReq uestCommen ts.FMExamR equestList box.Items[ x], 1, Pos ('  ', frm ExamReques tComments. FMExamRequ estListbox .Items[x])  - 1);
  10517         frmE xamRequest Comments.F MExamReque stListbox. Items[x] : = Copy(frm ExamReques tComments. FMExamRequ estListbox .Items[x],  Pos('  ',  frmExamRe questComme nts.FMExam RequestLis tbox.Items [x]) + 4,  500);
  10518         Date 3 := Copy( frmExamReq uestCommen ts.FMExamR equestList box.Items[ x], 1, 254 );
  10519         If D ate2 <> ''  Then
  10520           fr mExamReque stComments .FMExamReq uestListbo x.Items[x]  := Copy(F MDateTimeC onvert(Dat e1) + '                      ',  1, 20) + '   |  ' + F MDateTimeC onvert(Dat e2)
  10521         Else
  10522           If  Date3 <>  '' Then
  10523              frmExamReq uestCommen ts.FMExamR equestList box.Items[ x] := Copy (FMDateTim eConvert(D ate1) + '                      ' , 1, 20) +  '  |  ' +  FMDateTim eConvert(D ate3) + '  [EXAM CANC ELED]'
  10524           El se
  10525              frmExamReq uestCommen ts.FMExamR equestList box.Items[ x] := Copy (FMDateTim eConvert(D ate1) + '                      ' , 1, 20) +  '    ';
  10526         //Fi x single d igit date  and move o ver
  10527         If C opy(frmExa mRequestCo mments.FME xamRequest Listbox.It ems[x], 6,  1) = ','  Then
  10528           fr mExamReque stComments .FMExamReq uestListbo x.Items[x]  := Copy(f rmExamRequ estComment s.FMExamRe questListb ox.Items[x ], 1, 4) +  ' ' + Cop y(frmExamR equestComm ents.FMExa mRequestLi stbox.Item s[x], 5,
  10529              15) + Copy (frmExamRe questComme nts.FMExam RequestLis tbox.Items [x], 21, 9 9);
  10530         If ( Date2 <> ' ') Or (Dat e3 <> '')  Then
  10531           fr mExamReque stComments .FMExamReq uestListbo x.Items.De lete(x);
  10532       End;
  10533  
  10534     If frmEx amRequestC omments.FM ExamReques tListbox.I tems.Count  > 0 Then
  10535     Begin
  10536       frmExa mRequestCo mments.FME xamRequest Listbox.It emIndex :=  0;
  10537       frmExa mRequestCo mments.FME xamRequest ListboxCli ck(Applica tion);
  10538     End;
  10539  
  10540     If frmEx amRequestC omments.Sh owModal =  mrOK Then
  10541     Begin
  10542       clipbo ard.SetTex tBuf(pchar (frmExamRe questComme nts.FMComm entsMemo.T ext));
  10543       Sender  := screen .ActiveCon trol;
  10544       If Sen der.ClassT ype = TMem o Then
  10545       Begin
  10546         (Sen der As TMe mo).PasteF romClipboa rd;
  10547       End
  10548       Else
  10549         If S ender.Clas sType = TE dit Then
  10550         Begi n
  10551           (S ender As T Edit).Past eFromClipb oard;
  10552         End
  10553         Else
  10554           If  Sender.Cl assType =  TRichEdit  Then
  10555           Be gin
  10556              (Sender As  TRichEdit ).PasteFro mClipboard ;
  10557           En d
  10558           El se
  10559              Showmessag e('Cannot  load the c omments in to this co ntrol clas s type: '  + Sender.C lassName);
  10560     End;
  10561  
  10562     frmExamR equestComm ents.Relea se;
  10563  
  10564   end;
  10565  
  10566   procedure  TfrmMain.a ctPopEditP asteExecut e(Sender:  TObject);
  10567   begin
  10568     Sender : = screen.A ctiveContr ol;
  10569  
  10570     If Sende r.ClassTyp e = TMemo  Then
  10571     Begin
  10572       (Sende r As TMemo ).PasteFro mClipboard ;
  10573     End
  10574     Else
  10575       If Sen der.ClassT ype = TEdi t Then
  10576       Begin
  10577         (Sen der As TEd it).PasteF romClipboa rd;
  10578       End
  10579       Else
  10580         If S ender.Clas sType = TR ichEdit Th en
  10581         Begi n
  10582           (S ender As T RichEdit). PasteFromC lipboard;
  10583         End
  10584         Else
  10585           Sl eep(1);                                                                      //Showmess age('Unkno wn class t ype: '+Sen der.ClassN ame);
  10586   end;
  10587  
  10588   procedure  TfrmMain.a ctPopEditS electAllEx ecute(Send er: TObjec t);
  10589   begin
  10590     Sender : = screen.A ctiveContr ol;
  10591  
  10592     If Sende r.ClassTyp e = TMemo  Then
  10593     Begin
  10594       (Sende r As TMemo ).SelectAl l;
  10595     End
  10596     Else
  10597       If Sen der.ClassT ype = TEdi t Then
  10598       Begin
  10599         (Sen der As TEd it).Select All;
  10600       End
  10601       Else
  10602         If S ender.Clas sType = TR ichEdit Th en
  10603         Begi n
  10604           (S ender As T RichEdit). SelectAll;
  10605         End
  10606         Else
  10607           Sl eep(1);                                                                      //Showmess age('Unkno wn class t ype: '+Sen der.ClassN ame);
  10608   end;
  10609  
  10610   procedure  TfrmMain.a ctPopEditU ndoExecute (Sender: T Object);
  10611   begin
  10612     Sender : = screen.A ctiveContr ol;
  10613  
  10614     If Sende r.ClassTyp e = TMemo  Then
  10615     Begin
  10616       (Sende r As TMemo ).Undo;
  10617     End
  10618     Else
  10619       If Sen der.ClassT ype = TEdi t Then
  10620       Begin
  10621         (Sen der As TEd it).Undo;
  10622       End
  10623       Else
  10624         If S ender.Clas sType = TR ichEdit Th en
  10625         Begi n
  10626           (S ender As T RichEdit). Undo;
  10627         End
  10628         Else
  10629           Sl eep(1);                                                                      //Showmess age('Unkno wn class t ype: '+Sen der.ClassN ame);
  10630   end;
  10631  
  10632   procedure  TfrmMain.a ctPopEditU ndoUpdate( Sender: TO bject);
  10633   Var
  10634     tempcont rol: tcont rol;
  10635   Begin
  10636     tempcont rol := Nil ;
  10637     Sender : = screen.A ctiveContr ol;
  10638  
  10639     //PopupE ditmenu.Dr awModule : = BcCustom DrawModule 1;
  10640     If Sende r.ClassTyp e = TMemo  Then
  10641     Begin
  10642     End
  10643     Else
  10644       If Sen der.ClassT ype = TEdi t Then
  10645       Begin
  10646       End
  10647       Else
  10648         If S ender.Clas sType = TR ichEdit Th en
  10649         Begi n
  10650         End
  10651         Else
  10652         Begi n
  10653           ac tPopEditCu t.Enabled  := False;
  10654           ac tPopEditCo py.Enabled  := False;
  10655           ac tPopEditDe lete.Enabl ed := Fals e;
  10656           ac tPopEditSe lectAll.En abled := F alse;
  10657           ac tPopEditCh eckSpellin g.Enabled  := False;
  10658           ac tPopEditPa ste.Enable d := False ;
  10659           ac tPopEditUn do.Enabled  := False;
  10660           ac tPopEditLo adExam.Ena bled := Fa lse;
  10661           ex it;
  10662         End;
  10663  
  10664     Try
  10665       actPop EditCut.En abled := T rue;
  10666       actPop EditCopy.E nabled :=  True;
  10667       actPop EditDelete .Enabled : = True;
  10668       actPop EditSelect All.Enable d := True;
  10669       actPop EditCheckS pelling.En abled := T rue;
  10670       actPop EditPaste. Enabled :=  True;
  10671       actPop EditUndo.E nabled :=  True;
  10672       actPop EditLoadEx am.Enabled  := True;
  10673  
  10674       If cli pboard.AsT ext = '' T hen
  10675         actP opEditPast e.Enabled  := False;
  10676  
  10677       tempco ntrol := F indDragTar get(mouse. cursorpos,  true);
  10678  
  10679       If Not  assigned( tempcontro l) Then
  10680         Exit ;
  10681  
  10682       If ((A ssigned(te mpcontrol. owner)) An d (upperca se(tempcon trol.owner .name) = ' XPANELBASE CONTROL'))  Then // E T 060531
  10683         actP opEditLoad Exam.Enabl ed := True
  10684       Else
  10685         actP opEditLoad Exam.Enabl ed := Fals e;
  10686  
  10687       If tem pControl.C lassType =  TMemo The n
  10688       Begin
  10689         If ( tempContro l As TMemo ).Seltext  = '' Then
  10690         Begi n
  10691           ac tPopEditCu t.Enabled  := False;
  10692           ac tPopEditCo py.Enabled  := False;
  10693           ac tPopEditDe lete.Enabl ed := Fals e;
  10694         End;
  10695         If ( tempContro l As TMemo ).Text = ' ' Then
  10696           ac tPopEditSe lectAll.En abled := F alse;
  10697         If ( tempContro l As TMemo ).Text = ' ' Then
  10698           ac tPopEditCh eckSpellin g.Enabled  := False;
  10699       End
  10700       Else
  10701         If t empControl .ClassType  = TEdit T hen
  10702         Begi n
  10703           If  (tempCont rol As TEd it).Seltex t = '' The n
  10704           Be gin
  10705              actPopEdit Cut.Enable d := False ;
  10706              actPopEdit Copy.Enabl ed := Fals e;
  10707              actPopEdit Delete.Ena bled := Fa lse;
  10708           En d;
  10709           If  (tempCont rol As TEd it).Text =  '' Then
  10710              actPopEdit SelectAll. Enabled :=  False;
  10711           If  (tempCont rol As TEd it).Text =  '' Then
  10712              actPopEdit CheckSpell ing.Enable d := False ;
  10713         End
  10714         Else
  10715           If  sender.cl asstype =  TPopupActi onBar Then
  10716           Be gin
  10717              If (tempCo ntrol As T RichEdit). Seltext =  '' Then
  10718              Begin
  10719                actPopEd itCut.Enab led := Fal se;
  10720                actPopEd itCopy.Ena bled := Fa lse;
  10721                actPopEd itDelete.E nabled :=  False;
  10722              End;
  10723              If (tempCo ntrol As T RichEdit). SelText =  '' Then
  10724                actPopEd itSelectAl l.Enabled  := False;
  10725              If (tempCo ntrol As T RichEdit). Text = ''  Then
  10726                actPopEd itCheckSpe lling.Enab led := Fal se
  10727              Else
  10728                actPopEd itCheckSpe lling.Enab led := Tru e;
  10729  
  10730              actPopEdit SelectAll. Enabled :=  True;
  10731  
  10732              If (tempCo ntrol As T RichEdit). ReadOnly =  True Then
  10733              Begin
  10734                actPopEd itCut.Enab led := Fal se;
  10735                actPopEd itCopy.Ena bled := Fa lse;
  10736                actPopEd itDelete.E nabled :=  False;
  10737                actPopEd itSelectAl l.Enabled  := False;
  10738                actPopEd itCheckSpe lling.Enab led := Fal se;
  10739                actPopEd itPaste.En abled := F alse;
  10740              End;
  10741  
  10742           En d
  10743           El se
  10744     Except
  10745       On E:  Exception  Do
  10746         Show Message(te mpControl. Name + ' h as issues' );
  10747     End;
  10748   end;
  10749  
  10750   procedure  TfrmMain.a ctPopTempD eleteExecu te(Sender:  TObject);
  10751   begin
  10752     ButtonIP RDeleteCli ck(Applica tion);
  10753   end;
  10754  
  10755   procedure  TfrmMain.a ctPopTempD eleteUpdat e(Sender:  TObject);
  10756   begin
  10757     If ListB oxIPR1.Ite mIndex = - 1 Then
  10758     Begin
  10759       actPop TempDelete .Enabled : = False;
  10760       actPop TempTogNew .Enabled : = False;
  10761       actPop TempTogGre en.Enabled  := False;
  10762       actPop TempTogExc lamation.E nabled :=  False;
  10763     End
  10764     Else
  10765     Begin
  10766       actPop TempDelete .Enabled : = True;
  10767       actPop TempTogNew .Enabled : = True;
  10768       actPop TempTogGre en.Enabled  := True;
  10769       actPop TempTogExc lamation.E nabled :=  True;
  10770     End;
  10771     FMListbo xIPR1.Item Index := F MListBoxIP R1.Items.C ount - 1 -  ListBoxIP R1.ItemInd ex;
  10772   end;
  10773  
  10774   procedure  TfrmMain.a ctPopTempT ogExclamat ionExecute (Sender: T Object);
  10775   Var
  10776     temptext : String;
  10777     item: in teger;
  10778     tempstri ng: String ;
  10779     tempID:  String;
  10780   Begin
  10781     tempID : = '';
  10782     item :=  FMListBoxI PR1.ItemIn dex;
  10783     temptext  := FMList BoxIPR1.It ems[item];
  10784     If TempT ext[1] = ' *' Then
  10785     Begin
  10786       TempID  := '*';
  10787       TempTe xt := Copy (TempText,  2, length (temptext) );
  10788     End;
  10789     If (Temp Text[37] =  'Y') Then
  10790     Begin
  10791       tempst ring := 'N ';
  10792     End
  10793     Else
  10794     Begin
  10795       tempst ring := 'Y ';
  10796     End;
  10797     temptext [37] := te mpstring[1 ];
  10798     FMListBo xIPR1.Item s[item] :=  tempid +  temptext;
  10799     ListBoxI PR1.Items[ ListBoxIPR 1.Items.Co unt - item  - 1] := t empid + te mptext;
  10800     ListBoxI PR1DrawIte m(ListBoxI PR1, ListB oxIPR1.Ite mIndex, Li stBoxIPR1. ItemRect(L istBoxIPR1 .ItemIndex ), [odSele cted]);
  10801     If temps tring = 'Y ' Then
  10802       tempst ring := '1 '
  10803     Else
  10804       tempst ring := '0 ';
  10805     frmmain. fmfiler1.A ddFDA('396 .17', FMLi stBoxIPR1. GetSelecte dRecord.IE N, '21', t empstring) ;
  10806     If Not f rmmain.fmf iler1.Upda te Then
  10807     Begin
  10808       frmmai n.fmfiler1 .DisplayEr rors;
  10809       ShowMe ssageCAPRI ('There wa s an error  setting t he flag.') ;
  10810     End;
  10811   end;
  10812  
  10813   procedure  TfrmMain.a ctPopTempT ogGreenExe cute(Sende r: TObject );
  10814   Var
  10815     temptext : String;
  10816     item: in teger;
  10817     tempstri ng: String ;
  10818     tempID:  String;
  10819   Begin
  10820     tempID : = '';
  10821     item :=  FMListBoxI PR1.ItemIn dex;
  10822     temptext  := FMList BoxIPR1.It ems[item];
  10823     If TempT ext[1] = ' *' Then
  10824     Begin
  10825       TempID  := '*';
  10826       TempTe xt := Copy (TempText,  2, length (temptext) );
  10827     End;
  10828     If (Temp Text[36] =  'Y') Then
  10829     Begin
  10830       tempst ring := 'N ';
  10831     End
  10832     Else
  10833     Begin
  10834       tempst ring := 'Y ';
  10835     End;
  10836     temptext [36] := te mpstring[1 ];
  10837     FMListBo xIPR1.Item s[item] :=  tempid +  temptext;
  10838     ListBoxI PR1.Items[ ListBoxIPR 1.Items.Co unt - item  - 1] := t empid + te mptext;
  10839     ListBoxI PR1DrawIte m(ListBoxI PR1, ListB oxIPR1.Ite mIndex, Li stBoxIPR1. ItemRect(L istBoxIPR1 .ItemIndex ), [odSele cted]);
  10840     If temps tring = 'Y ' Then
  10841       tempst ring := '1 '
  10842     Else
  10843       tempst ring := '0 ';
  10844     frmmain. fmfiler1.A ddFDA('396 .17', FMLi stBoxIPR1. GetSelecte dRecord.IE N, '20', t empstring) ;
  10845     If Not f rmmain.fmf iler1.Upda te Then
  10846     Begin
  10847       frmmai n.fmfiler1 .DisplayEr rors;
  10848       ShowMe ssageCAPRI ('There wa s an error  setting t he flag.') ;
  10849     End;
  10850   end;
  10851  
  10852   procedure  TfrmMain.a ctPopTempT ogNewExecu te(Sender:  TObject);
  10853   Var
  10854     temptext : String;
  10855     item: in teger;
  10856     tempchar : char;
  10857     tempid:  String;
  10858   Begin
  10859     tempid : = '';
  10860     item :=  FMListBoxI PR1.ItemIn dex;
  10861     temptext  := FMList BoxIPR1.It ems[item];
  10862     If TempT ext[1] = ' *' Then
  10863     Begin
  10864       TempID  := '*';
  10865       TempTe xt := Copy (TempText,  2, length (temptext) );
  10866     End;
  10867     If (Temp Text[35] =  'Y') Or ( TempText[3 5] = ' ')  Or (TempTe xt[35] = ' ') Then
  10868     Begin
  10869       tempch ar := 'N';
  10870     End
  10871     Else
  10872     Begin
  10873       tempch ar := 'Y';
  10874     End;
  10875     temptext [35] := te mpchar;
  10876     FMListBo xIPR1.Item s[item] :=  tempid +  temptext;
  10877     ListBoxI PR1.Items[ ListBoxIPR 1.Items.Co unt - item  - 1] := t empid + te mptext;
  10878     ListBoxI PR1DrawIte m(ListBoxI PR1, ListB oxIPR1.Ite mIndex, Li stBoxIPR1. ItemRect(L istBoxIPR1 .ItemIndex ), [odSele cted]);
  10879     If tempc har = 'Y'  Then
  10880       tempch ar := '1'
  10881     Else
  10882       tempch ar := '0';
  10883     frmmain. fmfiler1.A ddFDA('396 .17', FMLi stBoxIPR1. GetSelecte dRecord.IE N, '19', t empchar);
  10884     If Not f rmmain.fmf iler1.Upda te Then
  10885     Begin
  10886       frmmai n.fmfiler1 .DisplayEr rors;
  10887       ShowMe ssageCAPRI ('There wa s an error  setting t he flag.') ;
  10888     End;
  10889   end;
  10890  
  10891  
  10892   procedure  TfrmMain.a ctToolsAMI EExecute(S ender: TOb ject);
  10893   begin
  10894     //CAPRI_ CodeCR95   - jcs - 05 /20/2010
  10895     if not C allRPC(RPC Broker1, ' DVBAB GET  URL', ['1' ], nil) th en
  10896       exit;
  10897  
  10898     If RPCBr oker1.Resu lts.Count  > 0 Then
  10899     Begin
  10900       xHyper linkLabel1 .targetURL  := RPCBro ker1.Resul ts[0];
  10901       // Ove rride bad  URL in Vis tA code fo r the time  being
  10902       If xHy perlinkLab el1.target URL = 'htt p://152.12 4.238.193/ bl/21/rati ng/Medical /exams/ind ex.htm' Th en
  10903           xHyperlink Label1.tar getURL :=  'http://vb aw.vba. DNS     /bl/21/rat ing/Medica l/exams/in dex.htm';
  10904       xHyper linkLabel1 .Navigate;
  10905     End;
  10906   end;
  10907  
  10908   procedure  TfrmMain.a ctToolsBri ngExamToFr ontExecute (Sender: T Object);
  10909   begin
  10910     PNCSForm .WindowSta te := wsNo rmal;
  10911     PNCSForm .BringToFr ont;
  10912   end;
  10913  
  10914   procedure  TfrmMain.a ctToolsBri ngExamToFr ontUpdate( Sender: TO bject);
  10915   begin
  10916     if (PNCS Form <> ni l) then
  10917       actToo lsBringExa mToFront.E nabled :=  True
  10918     else
  10919       actToo lsBringExa mToFront.E nabled :=  False;
  10920   end;
  10921  
  10922   procedure  TfrmMain.a ctToolsCha ngeAddress Execute(Se nder: TObj ect);
  10923   Var
  10924     tempstrs erver, tem pstrport:  String;
  10925     tempaddr ess: Strin g;
  10926   Begin
  10927     If EssoV ersion = F alse Then
  10928     Begin
  10929       {Get U ser E-Mail  Address o n Local Se rver}
  10930       RPCBro ker1.Remot eProcedure  := 'DVBAB  MAIL INIT ';
  10931       RPCBro kerCall;
  10932       Try
  10933         RPCB roker1.Cal l;
  10934       Except
  10935         On E BrokerErro r Do
  10936         Begi n
  10937           AN URemotePro cedureCall InProgress  := False;
  10938           An imateLogo( False);
  10939           St atusBarLoa dPt.Captio n := 'RPC  DVBAB MAIL  INIT coul d not be a ccessed!';
  10940           St atusBarLoa dPt.Repain t;
  10941           Ap plication. Processmes sages;
  10942           Sh owMessageC APRI('DVBA B MAIL INI T could no t be acces sed!');
  10943         End;
  10944       End;
  10945  
  10946       //Modi fy Dialog  For Local  System For warding In fo
  10947       frmFor wardingAdd ress := Tf rmForwardi ngAddress. Create(frm Main);
  10948       frmFor wardingAdd ress.Edit1 .text := l ocalemaila ddress;
  10949  
  10950       //jcs  - this doe sn't make  too much s ense, when  you exit  and renent er CAPRI,  this menu  option
  10951       //will  be enable d again? L ikewise, t here are a  couple of  other eve nts that w ill enable  the
  10952       //men  also, and  LocalEmail Address ma y be chang ed below a lso?
  10953  
  10954       //If L ocalEmailA ddress = ' ' Then
  10955       //  Ch angeForwar dingAddres s1.Enabled  := False;
  10956  
  10957       frmFor wardingAdd ress.Edit1 .text := ' NONE SPECI FIED';
  10958       frmFor wardingAdd ress.Radio Button3.Ch ecked := T rue;
  10959       frmFor wardingAdd ress.Radio Button1.Ca ption := l owercase(P iece(RPCBr oker1.Resu lts[0], '^ ', 1));
  10960       frmFor wardingAdd ress.label 4.Visible  := False;
  10961       frmFor wardingAdd ress.ShowM odal;
  10962       If frm Forwarding Address.Ra dioButton3 .Checked =  True Then
  10963       Begin
  10964         frmF orwardingA ddress.Rel ease;
  10965         frmF orwardingA ddress :=  Nil;
  10966         exit ;
  10967       End;
  10968       If frm Forwarding Address.Ra dioButton1 .Checked =  True Then
  10969       Begin
  10970         // U se home se rver addre ss
  10971         loca lemailaddr ess := frm Forwarding Address.ra diobutton1 .caption
  10972       End;
  10973       If frm Forwarding Address.Ra dioButton2 .Checked =  True Then
  10974       Begin
  10975         // U se specifi ed e-mail  address
  10976         loca lemailaddr ess := frm Forwarding Address.ed itOtherEma ilAddress. text;
  10977       End;
  10978       If frm Forwarding Address.Ra dioButton4 .Checked =  True Then
  10979       Begin
  10980         loca lemailaddr ess := '';
  10981       End;
  10982       // Upd ate .151 f ield next
  10983       FMFile r2.AddFDA( '200', Aut horIEN, '. 151', lowe rcase(loca lemailaddr ess));
  10984       If Not  fmfiler2. Update The n
  10985       Begin
  10986         fmfi ler2.Displ ayErrors;
  10987       End;
  10988       frmFor wardingAdd ress.Relea se;
  10989       frmFor wardingAdd ress := Ni l;
  10990       exit;
  10991     End;
  10992     If EssoV ersion = T rue Then
  10993     Begin
  10994       //Conn ect to Hom e Server
  10995       TempSt rServer :=  Uppercase (RPCBroker 1.ANUStrSe rver);
  10996       TempSt rPort := R PCBroker1. ANUStrPort ;
  10997       RPCBro ker1.Conne cted := Fa lse;
  10998       RPCBro ker1.Serve r := RPCBr oker1.ANUS trServerHo me;
  10999       RPCBro ker1.Liste nerPort :=  StrtoInt( RPCBroker1 .ANUStrPor tHome);
  11000       AuditI nProgress  := True;
  11001       //RPCB roker1.Con nected :=  True;  BSE  mod - rpm  1/8/09
  11002       //If N ot Authori zedOption( 'DVBA CAPR I GUI') Th en  BSE mo d - rpm 1/ 8/09
  11003       if not  ConnectTo Server('DV BA CAPRI G UI') then
  11004       Begin
  11005         Show MessageCAP RI('Could  not use op tion "DVBA  CAPRI GUI !"');
  11006         appl ication.te rminate;
  11007       End;
  11008       RPCBro ker1.Remot eProcedure  := 'DVBAB  MAIL INIT ';
  11009       RPCBro kerCall;
  11010       Try
  11011         RPCB roker1.Cal l;
  11012       Except
  11013         On E BrokerErro r Do
  11014         Begi n
  11015           AN URemotePro cedureCall InProgress  := False;
  11016           An imateLogo( False);
  11017           St atusBarLoa dPt.Captio n := 'RPC  DVBAB MAIL  INIT coul d not be a ccessed!';
  11018           St atusBarLoa dPt.Repain t;
  11019           Ap plication. Processmes sages;
  11020           Sh owMessageC APRI('DVBA B MAIL INI T could no t be acces sed!');
  11021         End;
  11022       End;
  11023       tempad dress := l owercase(P iece(RPCBr oker1.Resu lts[0], '^ ', 1));
  11024  
  11025       //Conn ect back t o local se rver
  11026       RPCBro ker1.Conne cted := Fa lse;
  11027       RPCBro ker1.Serve r := TempS trServer;
  11028       RPCBro ker1.Liste nerPort :=  StrtoInt( TempStrPor t);
  11029       //RPCB roker1.Con nected :=  True;  BSE  mod - rpm  1/8/09
  11030       //If N ot Authori zedOption( 'DVBA CAPR I GUI') Th en  BSE mo d - rpm 1/ 8/09
  11031       if not  ConnectTo Server('DV BA CAPRI G UI') then
  11032       Begin
  11033         Show MessageCAP RI('Could  not use op tion "DVBA  CAPRI GUI !"');
  11034         appl ication.te rminate;
  11035       End;
  11036  
  11037       AuditI nProgress  := False;
  11038  
  11039       //Modi fy Dialog  For Remote  System Fo rwarding
  11040       frmFor wardingAdd ress := Tf rmForwardi ngAddress. Create(frm Main);
  11041       frmFor wardingAdd ress.Edit1 .text := l ocalemaila ddress;
  11042       frmFor wardingAdd ress.Radio Button4.Vi sible := F alse;
  11043       frmFor wardingAdd ress.Radio Button3.Ch ecked := T rue;
  11044       frmFor wardingAdd ress.Radio Button1.Ca ption := t empaddress ;
  11045       frmFor wardingAdd ress.ShowM odal;
  11046       If frm Forwarding Address.Ra dioButton3 .Checked =  True Then
  11047       Begin
  11048         frmF orwardingA ddress.Rel ease;
  11049         frmF orwardingA ddress :=  Nil;
  11050         exit ;
  11051       End;
  11052       If frm Forwarding Address.Ra dioButton1 .Checked =  True Then
  11053       Begin
  11054         // U se home se rver addre ss
  11055         loca lemailaddr ess := frm Forwarding Address.ra diobutton1 .caption
  11056       End;
  11057       If frm Forwarding Address.Ra dioButton2 .Checked =  True Then
  11058       Begin
  11059         // U se specifi ed e-mail  address
  11060         loca lemailaddr ess := frm Forwarding Address.ed itOtherEma ilAddress. text;
  11061       End;
  11062       // Upd ate .151 f ield next
  11063       FMFile r2.AddFDA( '200', Aut horIEN, '. 151', lowe rcase(loca lemailaddr ess));
  11064       Try
  11065         If N ot fmfiler 2.Update T hen
  11066         Begi n
  11067           fm filer2.Dis playErrors ;
  11068         End;
  11069         Show MessageCAP RI('Remote  e-mail ad dress for  this syste m has been ' + char(1 3) + 'upda ted to mat ch your ho me server  preference :' + char( 13) + loca lemailaddr ess);
  11070       Except
  11071         Begi n
  11072           Sh owmessageC APRI('Coul dn''t set  remote e-m ail addres s on this  system.');
  11073           If  RPCBroker 1.Connecte d = False  Then
  11074           Be gin
  11075              Showmessag eCAPRI('No t connecte d to a ser ver due to  data tran smission f ailure.  E xiting app lication.' );
  11076              applicatio n.Terminat e;
  11077              applicatio n.terminat e;
  11078           En d;
  11079         End;
  11080       End;
  11081       //Now  update hom e server t oo
  11082       TempSt rServer :=  Uppercase (RPCBroker 1.ANUStrSe rver);
  11083       TempSt rPort := R PCBroker1. ANUStrPort ;
  11084       AuditI nProgress  := True;
  11085       RPCBro ker1.Conne cted := Fa lse;
  11086       RPCBro ker1.Serve r := RPCBr oker1.ANUS trServerHo me;
  11087       RPCBro ker1.Liste nerPort :=  StrtoInt( RPCBroker1 .ANUStrPor tHome);
  11088       //RPCB roker1.Con nected :=  True;  BSE  mod - rpm  1/8/09
  11089       //If N ot Authori zedOption( 'DVBA CAPR I GUI') Th en  BSE mo d - rpm 1/ 8/09
  11090       if not  ConnectTo Server('DV BA CAPRI G UI') then
  11091       Begin
  11092         Show MessageCAP RI('Could  not use op tion "DVBA  CAPRI GUI !"');
  11093         appl ication.te rminate;
  11094       End;
  11095       // Upd ate .151 f ield
  11096       FMFile r2.AddFDA( '200', Use rDUZHomeSe rver, '.15 1', lowerc ase(locale mailaddres s));
  11097       If Not  fmfiler2. Update The n
  11098       Begin
  11099         fmfi ler2.Displ ayErrors;
  11100       End;
  11101       homeem ailaddress  := locale mailaddres s;
  11102       // Con nect back  to local s erver
  11103       RPCBro ker1.Conne cted := Fa lse;
  11104       RPCBro ker1.Serve r := TempS trServer;
  11105       RPCBro ker1.Liste nerPort :=  StrtoInt( TempStrPor t);
  11106       //RPCB roker1.Con nected :=  True;  BSE  mod - rpm  1/8/09
  11107       //If N ot Authori zedOption( 'DVBA CAPR I GUI') Th en  BSE mo d -  rpm 1 /8/09
  11108       if not  ConnectTo Server('DV BA CAPRI G UI') then
  11109       Begin
  11110         Show MessageCAP RI('Could  not use op tion "DVBA  CAPRI GUI !"');
  11111         appl ication.te rminate;
  11112       End;
  11113       FMGets 1.IENS :=  AuthorIEN;
  11114       FMGets 1.GetData;
  11115       frmFor wardingAdd ress.Relea se;
  11116       frmFor wardingAdd ress := Ni l;
  11117       AuditI nProgress  := False;
  11118       exit;
  11119     End;
  11120   end;
  11121  
  11122   procedure  TfrmMain.a ctToolsCha ngeAddress Update(Sen der: TObje ct);
  11123   begin
  11124     if (GifI mageVistaY ellow.Visi ble) or (f rmPatientL ist <> nil ) then
  11125       actToo lsChangeAd dress.Enab led := Fal se
  11126     else
  11127       actToo lsChangeAd dress.Enab led := tru e;
  11128   end;
  11129  
  11130   procedure  TfrmMain.a ctToolsCPR SCosigUtil Execute(Se nder: TObj ect);
  11131   begin
  11132     frmUncos igned := T frmUncosig ned.Create (frmMain);
  11133     frmUncos igned.Show ;
  11134     frmUncos igned.butt onSearchCl ick(Applic ation);
  11135     frmUncos igned.Hide ;
  11136     frmUncos igned.Show Modal;
  11137     Contexto rChangeMes sage := 'Y ou are man aging cosi gned works heets.  If  you conti nue, CAPRI  will drop  out of th e clinical  context.' ;
  11138     CCOWBrea kLink := T rue;
  11139     frmUncos igned.Rele ase;
  11140     Contexto rChangeMes sage := '' ;
  11141     CCOWBrea kLink := F alse;
  11142   end;
  11143  
  11144   procedure  TfrmMain.a ctToolsCPR SCosigUtil Update(Sen der: TObje ct);
  11145   begin
  11146     if (GifI mageVistaY ellow.Visi ble = True ) or (frmP atientList  <> nil) t hen
  11147       actToo lsCPRSCosi gUtil.Enab led := Fal se
  11148     else
  11149       actToo lsCPRSCosi gUtil.Enab led := Tru e;
  11150   end;
  11151  
  11152   procedure  TfrmMain.a ctToolsEdi tCPReports Execute(Se nder: TObj ect);
  11153   begin
  11154     frmManag eReports : = tFrmMana geReports. create(frm Main);
  11155     frmManag eReports.E xamRequest RefreshCli ck(applica tion);
  11156     frmManag eReports.S howModal;
  11157     frmManag eReports.R elease;
  11158     frmManag eReports : = Nil;
  11159     ExamRequ estRefresh Click(Appl ication);
  11160   end;
  11161  
  11162   procedure  TfrmMain.a ctToolsEdi tCPReports Update(Sen der: TObje ct);
  11163   Var
  11164     x: integ er;
  11165     showedit : boolean;
  11166   Begin
  11167     showedit  := false;
  11168  
  11169     actTools EditCPRepo rts.Visibl e := False ;
  11170     actTools ManageTemp lateDef.Vi sible := F alse;
  11171  
  11172     If UserK eys.Count  > 0 Then
  11173     Begin
  11174       For x  := 0 To Us erKeys.Cou nt - 1 Do
  11175         If ( UserKeys[x ] = 'DVBA  CAPRI EXAM  LIST EDIT ') Or
  11176           (U serKeys[x]  = 'DVBA C APRI EXAM  LIST E') T hen
  11177           sh owedit :=  true;
  11178       For x  := 0 To Us erKeys.Cou nt - 1 Do
  11179         If ( UserKeys[x ] = 'DVBAB  CPWM REVI EWER') Or
  11180           (U serKeys[x]  = 'DVBAB  CPWM REVIE ') Then
  11181           sh owedit :=  true;
  11182       For x  := 0 To Us erKeys.Cou nt - 1 Do
  11183         If ( UserKeys[x ] = 'DVBA  C SUPERVIS OR') Then
  11184           sh owedit :=  true;
  11185     End;
  11186     If showe dit = true  Then
  11187       actToo lsManageTe mplateDef. Visible :=  True;
  11188     If Pos(' @', userfi lemancode)  > 0 Then
  11189     Begin
  11190       ShowEd it := true ;
  11191     End;
  11192     If Patie ntIEN <> ' ' Then
  11193       If Sho wEdit = Tr ue Then
  11194       Begin
  11195         actT oolsEditCP REports.Vi sible := T rue;
  11196         //jc s - FYI, t he origina l caption  can not co ntain '&&' , if it do es, the se tting
  11197         //of  the capti on below w ill fail f or some re ason.
  11198         actT oolsEditCP Reports.Ca ption := ' Manage C&& P Exam Req uests for  ' + Patien tName;
  11199       End;
  11200  
  11201     if (GifI mageVistaY ellow.Visi ble = True ) or (frmP atientList  <> nil) t hen
  11202       actToo lsEditCPRe ports.Enab led := Fal se
  11203     else
  11204       actToo lsEditCPRe ports.Enab led := Tru e;
  11205   end;
  11206  
  11207   procedure  TfrmMain.a ctToolsEdi tEsigExecu te(Sender:  TObject);
  11208   begin
  11209     Contexto rChangeMes sage := 'Y ou are edi ting signa ture code.   If you c ontinue, C APRI will  drop out o f the clin ical conte xt.';
  11210     CCOWBrea kLink := T rue;
  11211     frmElect ronicSigna tureCode : = TfrmElec tronicSign atureCode. Create(frm Main);
  11212     frmElect ronicSigna tureCode.S howmodal;
  11213     frmElect ronicSigna tureCode.R elease;
  11214     Contexto rChangeMes sage := '' ;
  11215     CCOWBrea kLink := F alse;
  11216   end;
  11217  
  11218   procedure  TfrmMain.a ctToolsExa mListParam etersExecu te(Sender:  TObject);
  11219   Var
  11220     x, y, z:  integer;
  11221     xx, yy,  zz: intege r;
  11222     foundfla g: boolean ;
  11223     tempSite s: TString List;
  11224     IEN, ZIE N: String;
  11225   Begin
  11226     If ANURe moteProced ureCallInP rogress =  True Then
  11227       exit;
  11228     AnimateL ogo(True);
  11229     StatusBa rLoadPt.Ca ption := ' Populating  exam assi gnment dia log.';
  11230     StatusBa rLoadPt.Re paint;
  11231     Applicat ion.Proces smessages;
  11232     tempSite s := TStri ngList.Cre ate;
  11233     tempSite s.Clear;
  11234     frmSiteE xamList :=  TfrmSiteE xamList.Cr eate(frmMa in);
  11235     //Set up  exams lis t
  11236     frmSiteE xamList.FM ExamsList. Items := L istExams;
  11237     If frmSi teExamList .FMExamsLi st.Items.C ount > 0 T hen
  11238       For x  := frmSite ExamList.F MExamsList .Items.Cou nt - 1 Dow nto 0 Do
  11239         If P os('  I',  frmSiteExa mList.FMEx amsList.It ems[x]) >  0 Then
  11240           fr mSiteExamL ist.FMExam sList.Item s.Delete(x );
  11241  
  11242     // Make  sure CAPRI  DIVISION  EXAM LIST  FILE conta ins an ent ry in .01  for each d ivision
  11243     // The s ite may ha ve added a  new divis ion.
  11244     frmSiteE xamList.FM ListerCust omExamList DivisionsL istBox.FML ister := F MListerMed icalCenter Division;
  11245     frmSiteE xamList.FM ListerCust omExamList DivisionsL istBox.Get List;
  11246     If frmSi teExamList .FMListerC ustomExamL istDivisio nsListBox. Items.Coun t = 0 Then
  11247     Begin
  11248       ShowMe ssageCAPRI ('No divis ions can b e located  in VistA.   Exiting t his functi on.');
  11249       frmSit eExamList. Release;
  11250       frmSit eExamList  := Nil;
  11251       TempHS Memo.Free;
  11252       exit;
  11253     End;
  11254     // Get c urrent lis t of divis ions
  11255     For x :=  0 To frmS iteExamLis t.FMLister CustomExam ListDivisi onsListBox .Items.Cou nt - 1 Do
  11256     Begin
  11257       frmSit eExamList. FMListerCu stomExamLi stDivision sListBox.I temIndex : = x;
  11258       tempSi tes.Add(fr mSiteExamL ist.FMList erCustomEx amListDivi sionsListB ox.GetSele ctedRecord .IEN);
  11259     End;
  11260     // Now g et list of  divisions  defined i n the CAPR I DIVISION  EXAM LIST  FILE
  11261     frmSiteE xamList.FM ListerCust omExamList DivisionsL istBox.FML ister := f rmSiteExam List.FMLis terCustomE xamListDiv isions;
  11262     frmSiteE xamList.FM ListerCust omExamList DivisionsL istBox.Get List;
  11263     // Find  IEN and sh ow that in  the list
  11264     If frmSi teExamList .FMListerC ustomExamL istDivisio nsListBox. Items.Coun t > 0 Then
  11265       For y  := 0 To fr mSiteExamL ist.FMList erCustomEx amListDivi sionsListB ox.Items.C ount - 1 D o
  11266       Begin
  11267         frmS iteExamLis t.FMLister CustomExam ListDivisi onsListBox .ItemIndex  := y;
  11268         frmS iteExamLis t.CustomEx amListDivi sions.IENS  := frmSit eExamList. FMListerCu stomExamLi stDivision sListBox.G etSelected Record.IEN ;
  11269         frmS iteExamLis t.CustomEx amListDivi sions.GetD ata;
  11270         frmS iteExamLis t.FMLister CustomExam ListDivisi onsListBox .Items[y]  := frmSite ExamList.C ustomExamL istDivisio ns.GetFiel d('.01').F MDBInterna l;
  11271       End;
  11272     // Compa re the two  lists and  add medic al center  divisions  that are m issing
  11273     For x :=  0 To temp Sites.Coun t - 1 Do
  11274     Begin
  11275       foundf lag := fal se;
  11276       If frm SiteExamLi st.FMListe rCustomExa mListDivis ionsListBo x.Items.Co unt > 0 Th en
  11277         For  y := 0 To  frmSiteExa mList.FMLi sterCustom ExamListDi visionsLis tBox.Items .Count - 1  Do
  11278         Begi n
  11279           If  foundflag  = false T hen
  11280           Be gin
  11281              If tempSit es[x] = fr mSiteExamL ist.FMList erCustomEx amListDivi sionsListB ox.Items[y ] Then
  11282              Begin
  11283                foundfla g := true;
  11284              End;
  11285           En d;
  11286         End;
  11287       If Fou ndFlag = F alse Then
  11288       Begin
  11289         Stat usBarLoadP t.Caption  := 'Settin g up new d ivision: I EN ' + tem pSites[x];
  11290         Stat usBarLoadP t.Repaint;
  11291         Appl ication.Pr ocessmessa ges;
  11292         frmS iteExamLis t.FMEditCA PRIDivisio nExamList. Text := '` ' + tempSi tes[x];
  11293         frmS iteExamLis t.FMEditCA PRIDivisio nExamList. IENS := '+ 1,';
  11294         If f rmSiteExam List.FMEdi tCAPRIDivi sionExamLi st.Validat e Then
  11295         Begi n
  11296           FM Filer1.Add ChgdContro l(frmSiteE xamList.FM EditCAPRID ivisionExa mList);
  11297           fr mSiteExamL ist.FMEdit CAPRIDivis ionExamLis t.Text :=  frmSiteExa mList.FMEd itCAPRIDiv isionExamL ist.FMCtrl External;
  11298         End
  11299         Else
  11300         Begi n
  11301           fr mMain.FMVa lidator1.D isplayErro rs;
  11302           fr mSiteExamL ist.FMEdit CAPRIDivis ionExamLis t.Text :=  frmSiteExa mList.FMEd itCAPRIDiv isionExamL ist.FMTag;
  11303           ex it;
  11304         End;
  11305         If N ot frmMain .FMValidat or1.Valida te Then
  11306         Begi n
  11307           FM Filer1.Dis playErrors ;
  11308           ex it;
  11309         End
  11310         Else
  11311           If  Not FMFil er1.Update  Then
  11312           Be gin
  11313              ShowMessag eCAPRI('Th ere was a  problem po pulating n ew divisio ns.');
  11314              exit;
  11315           En d;
  11316         IEN  := FMFiler 1.FindIEN( '+1,') + ' ,';
  11317         // P atch 193 -  New divis ions shoul d be set t o inactive  instead o f active.
  11318         // T his keeps  VBA users  from erron eously sen ding reque sts to new  divisions
  11319         // t hat are no t prepared  to receiv e them.  I nitially R emedy INC0 0000129024 6
  11320         // b ut not a d efect.  In corporated  into Patc h 193 requ irements.
  11321         // P atch 193 R RA 7/18/16
  11322         If I sPatchInst alled('DVB A*2.7*193' ) then                                      // Patch 1 93 RRA 7/1 8/16
  11323         begi n                                                                            // Patch 1 93 RRA 7/1 8/16
  11324           FM Filer1.Add FDA('396.1 5', IEN, ' 4', 'Y');                                   // Patch 1 93 RRA 7/1 8/16
  11325           if  not FMFil er1.Update  then                                                  // Patch 1 93 RRA 7/1 8/16
  11326           be gin                                                                          // Patch 1 93 RRA 7/1 8/16
  11327              ShowMessag eCAPRI('Th ere was a  problem up dating new  divisions .');       // Patch 1 93 RRA 7/1 8/16
  11328              exit;                                                                        // Patch 1 93 RRA 7/1 8/16
  11329           en d;                                                                           // Patch 1 93 RRA 7/1 8/16
  11330         end;                                                                              // Patch 1 93 RRA 7/1 8/16
  11331         // e nd RRA  
  11332  
  11333         FMFi ler1.AddFD A('396.151 ', '+1,' +  IEN, '.01 ', 'DEFAUL T LIST');
  11334         FMFi ler1.AddFD A('396.151 ', '+1,' +  IEN, '2',  'Y');
  11335         For  zz := 1 To  50 Do
  11336         Begi n
  11337           sl eep(1);                                                                      // Need th is to deal  with Brok er calls c licked qui ckly in su ccession.
  11338           ap plication. processmes sages;
  11339         End;
  11340         //fm file;
  11341         If N ot frmMain .FMFiler1. Update The n
  11342         Begi n
  11343           Sh owmessageC APRI('Prob lem updati ng exam sp ecs.  Plea se try aga in.');
  11344           ap plication. terminate;
  11345           ap plication. terminate;
  11346         End;
  11347         ZIEN  := FMFile r1.FindIEN ('+1,') +  ',' + IEN;
  11348         For  z := 0 To  frmSiteExa mList.FMEx amsList.It ems.Count  - 1 Do
  11349         Begi n
  11350           St atusBarLoa dPt.Captio n := 'Sett ing up new  division:  IEN ' + t empSites[x ] + ', Exa m: ' + frm SiteExamLi st.FMExams List.Items [z];
  11351           St atusBarLoa dPt.Repain t;
  11352           Ap plication. Processmes sages;
  11353           fr mSiteExamL ist.FMExam sList.Item Index := z ;
  11354           fr mSiteExamL ist.FMEdit CAPRIExamL istDefinit ion.Text : = '`' + fr mSiteExamL ist.FMExam sList.GetS electedRec ord.IEN;
  11355           fr mSiteExamL ist.FMEdit CAPRIExamL istDefinit ion.IENS : = '+1,' +  ZIEN;
  11356           If  frmSiteEx amList.FME ditCAPRIEx amListDefi nition.Val idate Then
  11357           Be gin
  11358              FMFiler1.A ddChgdCont rol(frmSit eExamList. FMEditCAPR IExamListD efinition) ;
  11359              frmSiteExa mList.FMEd itCAPRIExa mListDefin ition.Text  := frmSit eExamList. FMEditCAPR IExamListD efinition. FMCtrlExte rnal;
  11360           En d
  11361           El se
  11362           Be gin
  11363              frmMain.FM Validator1 .DisplayEr rors;
  11364              frmSiteExa mList.FMEd itCAPRIExa mListDefin ition.Text  := frmSit eExamList. FMEditCAPR IExamListD efinition. FMTag;
  11365              exit;
  11366           En d;
  11367           FM Filer1.Add FDA('396.1 514', '+1, ' + ZIEN,  '2', 'Y');
  11368           If  Not frmMa in.FMValid ator1.Vali date Then
  11369           Be gin
  11370              FMValidato r1.Display Errors;
  11371              exit;
  11372           En d
  11373           El se
  11374              If Not FMF iler1.Upda te Then
  11375              Begin
  11376                ShowMess ageCAPRI(' There was  a problem  populating  the exam  list.');
  11377                exit;
  11378              End;
  11379         End;                                                                              // end of  exam list  population
  11380  
  11381       End;
  11382     End;
  11383  
  11384     //Reload  division  list in ca se it chan ged
  11385     frmSiteE xamList.FM ListerCust omExamList DivisionsL istBox.Get List;
  11386  
  11387     // Now e valuate fo r exams th at have be en inactiv ated or ex ams that h ave been a dded
  11388     StatusBa rLoadPt.Ca ption := ' Validating  list cons istency.';
  11389     For y :=  0 To frmS iteExamLis t.FMLister CustomExam ListDivisi onsListBox .Items.Cou nt - 1 Do
  11390     Begin
  11391       frmSit eExamList. FMListerCu stomExamLi stDivision sListBox.I temIndex : = y;
  11392       // Get  list for  division
  11393       frmSit eExamList. FMListerCu stomExamLi stDivision sListBoxCl ick(Applic ation);
  11394       // Loa d up the l ist and se e what exa ms are in  it.
  11395       If frm SiteExamLi st.FMListB oxAvailabl eExamLists .Items.Cou nt > 0 The n
  11396         frmS iteExamLis t.FMLister ExamSetup. ListerFlag s := [lfIn ternal];
  11397       For z  := 0 To fr mSiteExamL ist.FMList BoxAvailab leExamList s.Items.Co unt - 1 Do
  11398       Begin
  11399         frmS iteExamLis t.FMListBo xAvailable ExamLists. ItemIndex  := z;
  11400         Stat usBarLoadP t.Caption  := 'Valida ting ' + f rmSiteExam List.FMLis terCustomE xamListDiv isionsList Box.Items[ frmSiteExa mList.FMLi sterCustom ExamListDi visionsLis tBox.ItemI ndex] + ':   ' +
  11401           fr mSiteExamL ist.FMList BoxAvailab leExamList s.Items[fr mSiteExamL ist.FMList BoxAvailab leExamList s.ItemInde x];
  11402         frmS iteExamLis t.buttonEd itClick(Ap plication) ;
  11403         // C heck for e xams now i nactive
  11404         For  xx := frmS iteExamLis t.FMListBo xExamSetup .Items.Cou nt - 1 Dow nto 0 Do
  11405         Begi n
  11406           fr mSiteExamL ist.FMList BoxExamSet up.ItemInd ex := xx;
  11407           fo undflag :=  false;
  11408           Fo r yy := fr mSiteExamL ist.FMExam sList.Item s.Count -  1 Downto 0  Do
  11409           Be gin
  11410              frmSiteExa mList.FMEx amsList.It emIndex :=  yy;
  11411              If frmSite ExamList.F MExamsList .GetSelect edRecord.I EN = Copy( frmSiteExa mList.FMLi stBoxExamS etup.Items [xx], 1, P os('  ', f rmSiteExam List.FMLis tBoxExamSe tup.Items[ xx]) - 1)  Then
  11412                foundfla g := true;
  11413           En d;
  11414           If  foundflag  = false T hen
  11415           Be gin
  11416              StatusBarL oadPt.Capt ion := 'Re moving ' +  frmSiteEx amList.FML isterCusto mExamListD ivisionsLi stBox.Item s[frmSiteE xamList.FM ListerCust omExamList DivisionsL istBox.Ite mIndex] +  ':  ' +
  11417                frmSiteE xamList.Ch eckListBox ExamList.I tems[xx];
  11418              frmSiteExa mList.FMEd itExamName InList.Tex t := '@';
  11419              frmSiteExa mList.FMEd itExamName InList.IEN S := frmSi teExamList .FMListBox ExamSetup. GetSelecte dRecord.IE N + ',' +  frmSiteExa mList.FMLi stBoxAvail ableExamLi sts.GetSel ectedRecor d.IEN + ', ' +
  11420                frmSiteE xamList.FM ListerCust omExamList DivisionsL istBox.Get SelectedRe cord.IEN;
  11421              If frmSite ExamList.F MEditExamN ameInList. Validate T hen
  11422              Begin
  11423                frmMain. FMFiler1.A ddChgdCont rol(frmSit eExamList. FMEditExam NameInList );
  11424                frmSiteE xamList.FM EditExamNa meInList.T ext := frm SiteExamLi st.FMEditE xamNameInL ist.FMCtrl External;
  11425              End
  11426              Else
  11427              Begin
  11428                frmMain. FMValidato r1.Display Errors;
  11429                exit;
  11430              End;
  11431              For zz :=  1 To 50 Do
  11432              Begin
  11433                sleep(1) ;                                                                 // Need th is to deal  with Brok er calls c licked qui ckly in su ccession.
  11434                applicat ion.proces smessages;
  11435              End;
  11436              //fmfile;
  11437              If Not frm Main.FMFil er1.Update  Then
  11438              Begin
  11439                Showmess ageCAPRI(' Problem up dating exa m specs.   Please try  again.');
  11440                applicat ion.termin ate;
  11441                applicat ion.termin ate;
  11442              End;
  11443           En d;
  11444         End;
  11445         For  xx := 0 To  frmSiteEx amList.FME xamsList.I tems.Count  - 1 Do
  11446         Begi n
  11447           fo undflag :=  false;
  11448           fr mSiteExamL ist.FMExam sList.Item Index := x x;
  11449           Fo r yy := 0  To frmSite ExamList.F MListBoxEx amSetup.It ems.Count  - 1 Do
  11450           Be gin
  11451              If frmSite ExamList.F MExamsList .GetSelect edRecord.I EN = Copy( frmSiteExa mList.FMLi stBoxExamS etup.Items [yy], 1, P os('  ', f rmSiteExam List.FMLis tBoxExamSe tup.Items[ yy]) - 1)  Then
  11452                foundfla g := true;
  11453           En d;
  11454           If  foundflag  = false T hen
  11455           Be gin
  11456              //ShowMess ageCAPRI(' turn on '+ frmSiteExa mList.FMEx amsList.It ems[xx]);
  11457              StatusBarL oadPt.Capt ion := 'Ad ding ' + f rmSiteExam List.FMLis terCustomE xamListDiv isionsList Box.Items[ frmSiteExa mList.FMLi sterCustom ExamListDi visionsLis tBox.ItemI ndex] + ':   ' +
  11458                frmSiteE xamList.FM ExamsList. Items[xx];
  11459              ZIEN := fr mSiteExamL ist.FMList BoxAvailab leExamList s.GetSelec tedRecord. IEN + ','  + frmSiteE xamList.FM ListerCust omExamList DivisionsL istBox.Get SelectedRe cord.IEN;
  11460              FMFiler1.A ddFDA('396 .1514', '+ 1,' + ZIEN , '.01', f rmSiteExam List.FMExa msList.Get SelectedRe cord.IEN);
  11461              FMFiler1.A ddFDA('396 .1514', '+ 1,' + ZIEN , '2', 'Y' );
  11462              For zz :=  1 To 50 Do
  11463              Begin
  11464                sleep(1) ;                                                                 // Need th is to deal  with Brok er calls c licked qui ckly in su ccession.
  11465                applicat ion.proces smessages;
  11466              End;
  11467              //fmfile;
  11468              If Not frm Main.FMFil er1.Update  Then
  11469              Begin
  11470                Showmess ageCAPRI(' Problem up dating exa m specs.   Please try  again.');
  11471                applicat ion.termin ate;
  11472                applicat ion.termin ate;
  11473              End;
  11474           En d;
  11475         End;
  11476       End;
  11477       frmSit eExamList. FMListerEx amSetup.Li sterFlags  := [];
  11478     End;
  11479  
  11480     frmSiteE xamList.FM ListerCust omExamList DivisionsL istBox.Ite mIndex :=  0;
  11481     frmSiteE xamList.FM ListerCust omExamList DivisionsL istBoxClic k(Applicat ion);
  11482     frmSiteE xamList.to p := frmMa in.Top + ( (frmMain.H eight - fr mSiteExamL ist.Height ) Div 2);
  11483     frmSiteE xamList.le ft := frmM ain.left +  ((frmMain .Width - f rmSiteExam List.Width ) Div 2);
  11484     AnimateL ogo(False) ;
  11485     StatusBa rLoadPt.Ca ption := ' Ready.';
  11486     StatusBa rLoadPt.Re paint;
  11487     Applicat ion.Proces smessages;
  11488     frmSiteE xamList.Pa nel1.Bring ToFront;
  11489     // Set U p Institut ions
  11490     If frmRO Finder.ORL istBoxSite s.Items.Co unt = 0 Th en
  11491       LoadIn stitutions ;
  11492     (*
  11493       If lst Institutio ns.Items.C ount>0 the n
  11494         For  x:=0 to ls tInstituti ons.Items. Count-1 do
  11495           fr mSiteExamL ist.FMList BoxUserGro up.Items.A dd(Copy(ls tInstituti ons.Items[ x],1,Pos(' ^',lstInst itutions.I tems[x])-1 ));
  11496     *)
  11497     frmSiteE xamList.FM MemoDivisi onComments .Enabled : = True;
  11498     Contexto rChangeMes sage := 'Y ou are edi ting site  parameters .  If you  continue,  CAPRI will  drop out  of the cli nical cont ext.';
  11499     CCOWBrea kLink := T rue;
  11500     frmSiteE xamList.Sh owModal;
  11501     Contexto rChangeMes sage := '' ;
  11502     CCOWBrea kLink := F alse;
  11503     frmSiteE xamList.Re lease;
  11504     frmSiteE xamList :=  Nil;
  11505     tempSite s.Free;
  11506   end;
  11507  
  11508   procedure  TfrmMain.a ctToolsExa mListParam etersUpdat e(Sender:  TObject);
  11509   begin
  11510     If (GifI mageVistaY ellow.Visi ble = true ) or (frmP atientList  <> nil) t hen
  11511       actToo lsExamList Parameters .Enabled : = false
  11512     else
  11513       actToo lsExamList Parameters .Enabled : = true;
  11514  
  11515   end;
  11516  
  11517   procedure  TfrmMain.a ctToolsMac roEditorEx ecute(Send er: TObjec t);
  11518   begin
  11519     frmMacro Editor.Sho w;
  11520   end;
  11521  
  11522   procedure  TfrmMain.a ctToolsMan ageTemplat eDefExecut e(Sender:  TObject);
  11523   begin
  11524     frmManag eTemplateD efinitions  := tFrmMa nageTempla teDefiniti ons.create (frmMain);
  11525     frmManag eTemplateD efinitions .Show;
  11526     AnimateL ogo(True);
  11527     StatusBa rLoadPt.Ca ption := ' Loading te mplate lis t...';
  11528     StatusBa rLoadPt.Re paint;
  11529     Applicat ion.Proces smessages;
  11530     frmManag eTemplateD efinitions .ButtonRel oadListCli ck(Applica tion);
  11531     AnimateL ogo(False) ;
  11532     StatusBa rLoadPt.Ca ption := ' Ready.';
  11533     StatusBa rLoadPt.Re paint;
  11534     Applicat ion.Proces smessages;
  11535     frmManag eTemplateD efinitions .Hide;
  11536     frmManag eTemplateD efinitions .ShowModal ;
  11537     frmManag eTemplateD efinitions .Release;
  11538     frmManag eTemplateD efinitions  := Nil;
  11539   end;
  11540  
  11541   procedure  TfrmMain.a ctToolsPri ntBlankExa mExecute(S ender: TOb ject);
  11542   Var
  11543     x: integ er;
  11544     includef lag: boole an;
  11545     sdate, e date: Stri ng;
  11546     showuser : String;
  11547     objectco unt: integ er;
  11548     prefix:  String;
  11549     nowdt: S tring;
  11550   Begin
  11551     If ANURe moteProced ureCallInP rogress =  True Then
  11552       exit;
  11553  
  11554     WaitForm .Visible : = True;
  11555     WaitForm .BringToFr ont;
  11556     WaitForm .Label1.Ca ption := ' Loading te mplate lis t...';
  11557     WaitForm .Label1.Re paint;
  11558     WaitForm .Repaint;
  11559  
  11560     RPCBroke r1.RemoteP rocedure : = 'ORWU DT ';
  11561     RPCBroke r1.Param[1 ].Value :=  'NOW';
  11562     RPCBroke r1.Param[1 ].PType :=  literal;
  11563     frmMain. RPCBrokerC all;
  11564     Try
  11565       RPCBro ker1.Call;
  11566     Except
  11567       On EBr okerError  Do
  11568       Begin
  11569         ANUR emoteProce dureCallIn Progress : = False;
  11570         Anim ateLogo(Fa lse);
  11571         Stat usBarLoadP t.Caption  := 'RPC OR WU DT coul d not be a ccessed!';
  11572         Stat usBarLoadP t.Repaint;
  11573         Appl ication.Pr ocessmessa ges;
  11574         Show MessageCAP RI('ORWU D T could no t be acces sed!');
  11575       End;
  11576     End;
  11577     nowdt :=  Piece(RPC Broker1.Re sults[0],  '.', 1);
  11578  
  11579     frmGener ateBlankTe mplate :=  tfrmGenera teBlankTem plate.crea te(frmmain );
  11580     frmGener ateBlankTe mplate.FML istboxTemp lates.Item s.Clear;
  11581     RPCBroke r1.RemoteP rocedure : = 'DVBAB T EMPLATE LI ST';
  11582     frmMain. RPCBrokerC all;
  11583     Try
  11584       RPCBro ker1.Call;
  11585     Except
  11586       On EBr okerError  Do
  11587       Begin
  11588         ANUR emoteProce dureCallIn Progress : = False;
  11589         Anim ateLogo(Fa lse);
  11590         Stat usBarLoadP t.Caption  := 'RPC DV BAB TEMPLA TE LIST co uld not be  accessed! ';
  11591         Stat usBarLoadP t.Repaint;
  11592         Appl ication.Pr ocessmessa ges;
  11593         Show MessageCAP RI('DVBAB  TEMPLATE L IST could  not be acc essed!');
  11594       End;
  11595     End;
  11596     QuickCop y(RPCBroke r1.Results , frmGener ateBlankTe mplate.FML istboxTemp lates.Item s);
  11597     QuickCop y(RPCBroke r1.Results , frmGener ateBlankTe mplate.FML istboxAllT emplates.I tems);
  11598  
  11599     If frmGe nerateBlan kTemplate. FMListboxT emplates.I tems.Count  > 0 Then
  11600       For x  := frmGene rateBlankT emplate.FM ListboxTem plates.Ite ms.Count -  1 Downto  0 Do
  11601       Begin
  11602         frmG enerateBla nkTemplate .FMListbox Templates. ItemIndex  := x;
  11603         incl udeflag :=  false;
  11604         sdat e := Piece (frmGenera teBlankTem plate.FMLi stboxTempl ates.Items [x], '^',  2);
  11605         edat e := Piece (frmGenera teBlankTem plate.FMLi stboxTempl ates.Items [x], '^',  3);
  11606         show user := Pi ece(frmGen erateBlank Template.F MListboxTe mplates.It ems[x], '^ ', 4);
  11607         Try
  11608         obje ctcount :=  strtoint( Piece(frmG enerateBla nkTemplate .FMListbox Templates. Items[x],  '^', 5))Ex cept
  11609           ob jectcount  := 0;
  11610         End;                                                                              // The exc eption cat ches null  values
  11611  
  11612         //Sh owMessageC APRI(sdate +'*'+edate +'*'+showu ser);
  11613         pref ix := '';
  11614         If ( ShowUser =  '1') Or ( Showuser =  '') Then
  11615         Begi n
  11616           If  sdate = ' ' Then
  11617              includefla g := false ;
  11618           If  sdate <>  '' Then
  11619              If (sdate  <= nowdt)  And (edate  = '') The n
  11620                IncludeF lag := tru e
  11621              Else
  11622                If edate  <> '' The n
  11623                  If (sd ate <= now dt) And (E date > now dt) Then
  11624                    incl udeflag :=  true;
  11625           If  (Pos('@',  userfilem ancode) >  0) And (in cludeflag  <> true) T hen
  11626           Be gin
  11627              prefix :=  'ZZ_INACTI VE: ';
  11628              includefla g := true;
  11629           En d;
  11630         End;
  11631         If I ncludeFlag  = true Th en
  11632         Begi n
  11633           fr mGenerateB lankTempla te.Listbox Templates. Items.Add( prefix + P iece(Piece (frmGenera teBlankTem plate.FMLi stboxTempl ates.Items [x], '^',  1), '~', 1 ) + '^' +
  11634              Piece(frmG enerateBla nkTemplate .FMListbox Templates. Items[x],  '^', 6) +  '^' + intt ostr(objec tcount));
  11635         End;
  11636       End;
  11637  
  11638     // Refor mat list t o make tem platename~ version^ie n into
  11639     // templ atename^ie n
  11640     // Strip  off versi on info
  11641     // Piece  3 is the  object cou nt
  11642  
  11643     WaitForm .Visible : = False;
  11644  
  11645     If frmGe nerateBlan kTemplate. ShowModal  = mrCancel  Then
  11646     Begin
  11647       frmGen erateBlank Template.R elease;
  11648       frmGen erateBlank Template : = Nil;
  11649       exit;
  11650     End;
  11651  
  11652     frmGener ateBlankTe mplate.Rel ease;
  11653     frmGener ateBlankTe mplate :=  Nil;
  11654   end;
  11655  
  11656   procedure  TfrmMain.a ctToolsPro pertiesExe cute(Sende r: TObject );
  11657   begin
  11658     If ANURe moteProced ureCallInP rogress =  True Then
  11659       exit;
  11660     frmPrope rties.labl esample.fo nt := pane l1.font;
  11661     frmPrope rties.Top  := 7 + frm Main.Top +  ((frmMain .Height -  frmPropert ies.Height ) Div 2);
  11662     frmPrope rties.Left  := frmMai n.Left + ( (frmMain.W idth - frm Properties .Width) Di v 2);
  11663     frmPrope rties.Show Modal;
  11664   end;
  11665  
  11666   procedure  TfrmMain.a ctToolsPro pertiesUpd ate(Sender : TObject) ;
  11667   begin
  11668     If (GifI mageVistaY ellow.Visi ble = true ) or (frmP atientList  <> nil) t hen
  11669       actToo lsProperti es.Enabled  := False
  11670     else
  11671       actToo lsProperti es.Enabled  := true;
  11672   end;
  11673  
  11674   {========= ========== ========== ========== ========== ========== ========== ===
  11675    actToolsS earchExecu te
  11676    This acti on event h andler met hod is cal led from t he Tools/E nterprise
  11677    Search fo r a Patien t option,  the Enterp rise Searc h button o n the Pati ent
  11678    Selector  dialog box  and the E nterprise  Search but ton on the  Patient
  11679    Selector  (Restricte d Lists) d ialog box.
  11680  
  11681    The metho d performs  an MVI En terprise S earch by d efault.  T he method
  11682    continues  to suppor t the Lega cy RPCBrok er style s earch, whi ch will be
  11683    performed  when the  sender is  a TButton  with the T ag propert y set to ' 1'.
  11684  
  11685    CodeCR267  - rpm 8/3 0/12
  11686    ========= ========== ========== ========== ========== ========== ========== ===}
  11687  
  11688   procedure  TfrmMain.a ctToolsSea rchExecute (Sender: T Object);
  11689   Var
  11690     TempStrS erver: Str ing;
  11691     TempStrP ort: Integ er;
  11692  
  11693   Begin
  11694     If ANURe moteProced ureCallInP rogress =  True Then
  11695       exit;
  11696  
  11697     //Store  connection  date
  11698     TempStrS erver := R PCBroker1. Server;
  11699     TempStrP ort := RPC Broker1.Li stenerPort ;
  11700  
  11701     if IsBut tonTagOne( Sender) th en                                                     //execute  Legacy sea rch
  11702     begin
  11703       //Rest ricted Pat ient List  treated di fferently  based on S ender
  11704       if (Us erHasNewSt yleRestric tedList =  1) then
  11705         DoLe gacyEnterp riseSearch (frmPatien tListRestr icted.btnS earch)
  11706       else
  11707         DoLe gacyEnterp riseSearch (Sender);                                              //do legac y search
  11708     end
  11709     else                                                                                  //Execute  MVI search
  11710     begin
  11711       frmMVI Enterprise Search :=  TfrmMVIEnt erpriseSea rch.Create (Self);
  11712       try
  11713         RPCB roker1.Con nected :=  False;
  11714         if R PCBroker1. Connect2Ho meServer(R PCBroker1. ANUAccessC odeHome,
  11715           RP CBroker1.A NUVerifyCo deHome,
  11716           RP CBroker1.A NUstrServe rHome,
  11717           RP CBroker1.A NUstrPortH ome,
  11718           Fa lse) then
  11719         begi n
  11720           RP CBroker1.C reateConte xt('DVBA C APRI GUI') ;
  11721           // Restricted  Patient L ist treate d differen tly
  11722           if  (UserHasN ewStyleRes trictedLis t = 1) the n
  11723              LoadRestri ctedSearch Traits;
  11724           fr mMVIEnterp riseSearch .ShowModal ;
  11725         end;
  11726       finall y
  11727         Free AndNil(frm MVIEnterpr iseSearch) ;
  11728       end;
  11729     end;
  11730  
  11731     //Reconn ect to ori ginal host
  11732     RPCBroke r1.Server  := TempStr Server;
  11733     RPCBroke r1.Listene rPort := T empStrPort ;
  11734  
  11735     If Not C onnectToSe rver('DVBA  CAPRI GUI ') Then
  11736     Begin
  11737       ShowMe ssageCAPRI ('Could no t use opti on "DVBA C APRI GUI!" ');
  11738       applic ation.term inate;
  11739     End;
  11740     If RPCBr oker1.Conn ected = Fa lse Then
  11741     Begin
  11742       ShowMe ssageCAPRI ('Could no t use opti on "DVBA C APRI GUI!" ');
  11743       applic ation.term inate;
  11744     End;
  11745  
  11746     //MVI En terprise s earch sets  site with  site list  itemindex  and SSN
  11747     //when u ser wants  to switch  to a diffe rent treat ing facili ty.
  11748     if (Swit chToSite < > '') and  (SwitchToP atientSSN  <> '') the n
  11749     begin
  11750       DoMVIS iteSwitch( Sender);
  11751     end;
  11752   end;
  11753  
  11754   procedure  TfrmMain.a ctToolsSea rchUpdate( Sender: TO bject);
  11755   begin
  11756     If (ESSO Version =  True) and  (frmPatien tList = ni l) and ((P os('@', us erfilemanc ode) > 0)  Or
  11757       (Pos(' u', userfi lemancode)  > 0) Or ( Pos('U', u serfileman code) > 0) ) Then
  11758       actToo lsSearch.V isible :=  True
  11759     else
  11760       actToo lsSearch.V isible :=  false;
  11761  
  11762     If (GifI mageVistaY ellow.Visi ble = True ) then
  11763       actToo lsSearch.E nabled :=  false
  11764     else
  11765       actToo lsSearch.E nabled :=  true;
  11766   end;
  11767  
  11768   procedure  TfrmMain.a ctToolsUnc osignedDoc sExecute(S ender: TOb ject);
  11769   begin
  11770     frmTIUCo sign := Tf rmTIUCosig n.Create(f rmMain);
  11771     frmTIUCo sign.GetCo signatureA lerts;
  11772     frmTIUCo sign.showM odal;
  11773     frmTIUCo sign.Relea se;
  11774     frmTIUCo sign := Ni l;
  11775   end;
  11776  
  11777   procedure  TfrmMain.a ctToolsUnc osignedDoc sUpdate(Se nder: TObj ect);
  11778   begin
  11779     If (GifI mageVistaY ellow.Visi ble = True ) or (frmP atientList  <> nil) t hen
  11780       actToo lsUncosign edDocs.Ena bled := fa lse
  11781     Else
  11782       actToo lsUncosign edDocs.Ena bled := Tr ue
  11783   end;
  11784  
  11785   procedure  TfrmMain.a ctToolsUns ignedWorkS heetsUpdat e(Sender:  TObject);
  11786   begin
  11787     if (GifI mageVistaY ellow.Visi ble = true ) or (frmP atientList  <> nil) t hen
  11788       actToo lsUnsigned WorkSheets .Enabled : = False
  11789     else
  11790       actToo lsUnsigned WorkSheets .Enabled : = True;
  11791   end;
  11792  
  11793   procedure  TfrmMain.a ctToolsVis taUpdate(S ender: TOb ject);
  11794   begin
  11795     If (GifI mageVistaY ellow.Visi ble = true ) or (frmP atientList  <> nil) t hen
  11796       actToo lsVista.En abled := f alse
  11797     else
  11798       actToo lsVista.En abled := T rue;
  11799   end;
  11800  
  11801   Procedure  TfrmMain.B itBtnVistA Click(Send er: TObjec t);
  11802   Var
  11803     nowdt: S tring;
  11804     sgScreen Was: Strin g;
  11805     tempcode : String;
  11806     tempDUZ:  String;
  11807     tempflag : boolean;
  11808     x: integ er;
  11809     lUseRefl ection: bo olean;
  11810   Begin
  11811     If ANURe moteProced ureCallInP rogress Th en
  11812       exit;
  11813  
  11814     // CAPRI _CodeCR104  - jcs - 0 4/23/10 -  Prevent re -entry int o code if
  11815     // form  is already  visible,  which prev ents error  if a user  clicks
  11816     // VistA  button tw ice while  a connecti on is arle ady being  establishe d.
  11817     // If th e user alr eady has t he telnet  window ope n, just br ing it to  the front.
  11818     If frmTe lnet.visib le = True  then
  11819     begin
  11820       frmTel net.BringT oFront;
  11821       exit;
  11822     end;
  11823  
  11824     // CodeC R185 -MER  05/2011
  11825     // djs R eflections  - Removed  all Telne t code. Te lnet disco ntinued. P atch 193 1 0/21/16
  11826   //  if (Me ssageDlg(' Do you wis h to use R eflection  to launch  a secure s hell sessi on?', mtCo nfirmation , [mbYes,  mbNo], 0)  = mrYes)
  11827   //    then
  11828   //    lUse Reflection  := TRUE
  11829   //  else
  11830   //    lUse Reflection  := FALSE;
  11831  
  11832     // Check  for DISUS ER and don 't continu e if it's  true
  11833     If UserR emoteDISUS ER = '1' T hen
  11834     Begin
  11835       Showme ssageCAPRI ('The acti ve DISUSER  flag for  this accou nt will be  removed s o that log -in can oc cur normal ly.');
  11836  
  11837       FMFile r1.AddFDA( '200', Aut horIEN, '7 ', '');
  11838       If frm Main.FMFil er1.Anythi ngToFile T hen
  11839         If f rmMain.FMF iler1.Upda te Then
  11840         Begi n
  11841           // Do Stuff h ere if nee d to
  11842           Us erRemoteTe rminationD ate := '';
  11843         End;
  11844  
  11845       //Show messageCAP RI('Your a ccount has  been temp orarily bl ocked with  DISUSER o n this sys tem.  You  will need  to contact  IRM at th e site.  T he telnet  function c annot be a ctivated.' );
  11846       //exit ;
  11847     End;
  11848  
  11849     tempflag  := false;
  11850  
  11851     {Get Use r DUZ}
  11852  
  11853     //CAPRI_ CodeCR95   - jcs - 05 /20/2010
  11854     if not C allRPC(RPC Broker1, ' XWB GET VA RIABLE VAL UE', ['DUZ '], nil, T rue) then
  11855       exit;
  11856  
  11857     tempDUZ  := RPCBrok er1.Result s[0];
  11858  
  11859     // Check  User's Ve rify Code  to make su re it's no t blank.
  11860     // A bla nk code ca n happen d uring a re mote conne ction.
  11861     frmTelne t.fmGetsNe wPersonFil e.IENS :=  TempDUZ;
  11862     frmTelne t.fmGetsNe wPersonFil e.GetData;
  11863  
  11864     If frmTe lnet.fmGet sNewPerson File.GetFi eld('11'). FMDBIntern al = '' Th en
  11865     Begin
  11866       // Use  access co de as base  for verif y code but  reverse i t to scram ble it.
  11867       tempco de := encr ypt(RPCBro ker1.anuve rifycode);                                  // Use Vis tA hash to  scramble  the code;
  11868       // Sho wmessage(' Verify cod e is blank : '+tempco de);
  11869       FMVali dator1.Set up('200',  tempDUZ, ' 11', tempc ode);
  11870       If Not  FMValidat or1.Valida te Then
  11871       Begin
  11872         FMVa lidator1.D isplayErro rs;
  11873         Show MessageCAP RI('There  was an err or setting  up verify  code.');
  11874         appl ication.te rminate;
  11875       End;                                                                                {file}
  11876       fmfile r1.AddFDA( '200', tem pDUZ, '11' , tempcode );
  11877       If Not  fmfiler1. Update The n
  11878       Begin
  11879         fmfi ler1.Displ ayErrors;
  11880         Show MessageCAP RI('There  was an err or setting  a remote  verify cod e.');
  11881         appl ication.te rminate;
  11882       End;
  11883     End;
  11884  
  11885     // ***** ********** ********** ********** ********** ********** ********** *******
  11886         // I f the new  CAPRI HRC  menu patch  fixed the  VT-100 pr oblem at A marillo,
  11887         // t his code c an be dele ted.
  11888     // ***** ********** ********** ********** ********** ********** ********** *******
  11889  
  11890      // Load  list of t erminal ty pes
  11891      // Find  VT100
  11892     sgScreen Was := frm Telnet.FML isterTermi nalType.Sc reen;
  11893     frmTelne t.FMLister TerminalTy pe.Screen  := 'I $P(^ (0),U,2)';
  11894     frmTelne t.FMLister TerminalTy pe.GetList (frmTelnet .FMListBox TerminalTy pe.Items);
  11895     If frmTe lnet.FMLis tBoxTermin alType.Ite ms.count >  0 Then
  11896       For x  := 0 To fr mTelnet.FM ListBoxTer minalType. Items.coun t - 1 Do
  11897         If ( uppercase( frmTelnet. FMListBoxT erminalTyp e.Items[x] ) = 'C-VT1 00') Or
  11898           (u ppercase(f rmTelnet.F MListBoxTe rminalType .Items[x])  = 'VT100' ) Then
  11899         Begi n
  11900           te mpflag :=  true;
  11901           fr mTelnet.FM ListBoxTer minalType. ItemIndex  := x;
  11902         End;
  11903     frmTelne t.FMLister TerminalTy pe.Screen  := sgScree nWas;
  11904     If tempf lag = fals e Then
  11905     Begin
  11906       //Show messageCAP RI('Cannot  locate VT 100 termin al type.   Please not ify IRM.') ;
  11907     End
  11908     Else
  11909     Begin
  11910       // Set  user's ac count in t he NEW PER SON FILE s o that "la st termina l type"
  11911       // is  VT100
  11912       FMVali dator1.Set up('200',  tempDUZ, ' 9.3', '`'  + frmTelne t.FMListBo xTerminalT ype.GetSel ectedRecor d.IEN);
  11913       If Not  FMValidat or1.Valida te Then
  11914       Begin
  11915         FMVa lidator1.D isplayErro rs;
  11916         Show MessageCAP RI('There  was an err or setting  up termin al type.') ;
  11917         appl ication.te rminate;
  11918       End;                                                                                {file}
  11919       fmfile r1.AddFDA( '200', tem pDUZ, '9.3 ', frmTeln et.FMListB oxTerminal Type.GetSe lectedReco rd.IEN);
  11920       fmfile r1.AddFDA( '200', tem pDUZ, '898 3.13', frm Telnet.FML istBoxTerm inalType.G etSelected Record.IEN );
  11921       // For ce "ask te rminal typ e at login " from New  Person Fi le
  11922       fmfile r1.AddFDA( '200', tem pDUZ, '898 3.12', 'Y' );
  11923       If Not  fmfiler1. Update The n
  11924       Begin
  11925         fmfi ler1.Displ ayErrors;
  11926         Show MessageCAP RI('There  was an err or setting  terminal  type to VT -100.');
  11927         appl ication.te rminate;
  11928       End;
  11929     End;
  11930  
  11931     // ***** ********** ********** ********** ********** ********** ********** *******
  11932  
  11933       // Che ck for ter mination d ate.  If f ound and e arlier or  equal to c urrent dat e,
  11934       // the n clear it .  The use r has acce ss on cent ral authen tication s erver,
  11935       // so  the date c an be clea red.
  11936  
  11937     If UserR emoteTermi nationDate  <> '' The n
  11938     Begin
  11939       If ANU RemoteProc edureCallI nProgress  = True The n
  11940         exit ;
  11941       RPCBro ker1.Remot eProcedure  := 'ORWU  DT';
  11942       RPCBro ker1.Param [1].Value  := 'NOW';
  11943       RPCBro ker1.Param [1].PType  := literal ;
  11944       Try
  11945         RPCB roker1.Cal l;
  11946       Except
  11947         On E BrokerErro r Do
  11948         Begi n
  11949           AN URemotePro cedureCall InProgress  := False;
  11950           An imateLogo( False);
  11951           St atusBarLoa dPt.Captio n := 'RPC  ORWU DT co uld not be  accessed! ';
  11952           St atusBarLoa dPt.Repain t;
  11953           Ap plication. Processmes sages;
  11954           Sh owMessageC APRI('ORWU  DT could  not be acc essed!');
  11955         End;
  11956       End;
  11957       nowdt  := Piece(R PCBroker1. Results[0] , '.', 1);
  11958       If Use rRemoteTer minationDa te <= NowD t Then
  11959       Begin
  11960         // U ser has ac cess, so r emove term  date here
  11961         FMFi ler1.AddFD A('200', A uthorIEN,  '9.2', '') ;
  11962         If f rmMain.FMF iler1.Anyt hingToFile  Then
  11963           If  frmMain.F MFiler1.Up date Then
  11964           Be gin
  11965              //Do Stuff  here if n eed to
  11966              UserRemote Terminatio nDate := ' ';
  11967           En d;
  11968       End;
  11969     End;
  11970  
  11971     If UserH omePrimary Menu = 'EV E' Then
  11972       UserHo mePrimaryM enu := '';
  11973  
  11974     // Only  allow chan ging the p rimary men u when the  user's pr imary menu  exists
  11975     // in th e CAPRI PR IMARY MENU  OPTIONS ( #396.8) fi le. Otherw ise set th e
  11976     // user' s menu as  a secondar y option.
  11977     if FPrim aryMenuAss ignable th en                                                     //CodeCR10 9 - rpm 8/ 4/10
  11978     Begin
  11979       kernel _AssignMen uToPrimary (RPCBroker 1, AuthorI EN, UserHo mePrimaryM enu);
  11980       kernel _AssignMen uToSeconda ry(RPCBrok er1, Autho rIEN, 'XMU SER');
  11981  
  11982       // Che ck multipl e sign-ins  and set t o allowed,  if necess ary
  11983       If frm Telnet.fmG etsNewPers onFile.Get Field('200 .04').FMDB Internal < > '1' Then
  11984       Begin
  11985         FMVa lidator1.S etup('200' , tempDUZ,  '200.04',  '1');
  11986         If N ot FMValid ator1.Vali date Then
  11987         Begi n
  11988           FM Validator1 .DisplayEr rors;
  11989           Sh owMessageC APRI('Ther e was an e rror setti ng multipl e log-ins. ');
  11990           ap plication. terminate;
  11991         End;                                                                              {file}
  11992         fmfi ler1.AddFD A('200', t empDUZ, '2 00.04', '1 ');
  11993         If N ot fmfiler 1.Update T hen
  11994         Begi n
  11995           fm filer1.Dis playErrors ;
  11996           Sh owMessageC APRI('Ther e was an e rror setti ng multipl e log-ins. ');
  11997           ap plication. terminate;
  11998         End;
  11999       End;
  12000       // End  of multip le sign-in  block
  12001  
  12002     End
  12003     Else
  12004     Begin
  12005       If Use rHomePrima ryMenu <>  '' Then
  12006       Begin
  12007         kern el_AssignM enuToSecon dary(RPCBr oker1, Aut horIEN, Us erHomePrim aryMenu);
  12008         kern el_AssignM enuToSecon dary(RPCBr oker1, Aut horIEN, 'X MUSER');
  12009       End;
  12010     End;
  12011  
  12012     (*
  12013       // Che ck menu to  be sure i t's the sa me as the  one on the  central a uthenticat ion server
  12014       // If  not, then  change it.
  12015       If Use rHomePrima ryMenu<>''  then
  12016         If U serRemoteP rimaryMenu <>UserHome PrimaryMen u then beg in
  12017           fr mTelnet.FM ListerOpti on.PartLis t.Clear;
  12018           fr mTelnet.FM ListerOpti on.PartLis t.Add(User HomePrimar yMenu);
  12019           fr mTelnet.FM ListBoxOpt ion.GetLis t;
  12020           if  frmTelnet .FMListBox Option.Ite ms.Count=0  then begi n
  12021              Showmessag eCapri('Co uldn''t fi nd menu '+ UserHomePr imaryMenu+ ' on the r emote syst em.');
  12022              exit;
  12023           en d;
  12024           y: =-1;
  12025           if  frmTelnet .FMListBox Option.Ite ms.Count>0  then
  12026              for x:=0 t o frmTelne t.FMListBo xOption.It ems.Count- 1 do
  12027                if frmTe lnet.FMLis tBoxOption .Items[x]= UserHomePr imaryMenu  then y:=x;
  12028           if  (frmTelne t.FMListBo xOption.It ems.Count= 0) or (y=- 1) then be gin
  12029              Showmessag eCapri('Co uldn''t fi nd menu '+ UserHomePr imaryMenu+ ' on the r emote syst em.  You w ill be all owed to co ntinue, bu t may have  the wrong  menu.');
  12030              // If no m enu, then  set to XMU SER (mailm an);
  12031              If UserRem otePrimary Menu='' th en begin
  12032                frmTelne t.FMLister Option.Par tList.Clea r;
  12033                frmTelne t.FMLister Option.Par tList.Add( 'XMUSER');
  12034                frmTelne t.FMListBo xOption.Ge tList;
  12035                y:=-1;
  12036                If frmTe lnet.FMLis tboxOption .Items.Cou nt>0 then
  12037                  for x: =0 to frmT elnet.FMLi stboxOptio n.Items.Co unt-1 do
  12038                    If f rmTelnet.F MListboxOp tion.Items [x]='XMUSE R' then y: =x;
  12039                If (frmT elnet.FMLi stboxOptio n.Items.Co unt=0) or  (y=-1) the n begin
  12040                  Showme ssageCAPRI ('Couldn'' t find XMU SER on thi s system.   You have  no menu.') ;
  12041                  exit;
  12042                end;
  12043                frmTelne t.FMListBo xOption.It emIndex:=y ;
  12044                FMFiler1 .AddFDA('2 00',Author IEN,'201', frmTelnet. FMListBoxO ption.GetS electedRec ord.IEN);
  12045                if frmMa in.FMFiler 1.Anything ToFile the n
  12046                  if frm Main.FMFil er1.Update  then begi n
  12047                    //Do  Stuff her e if need  to
  12048                    User RemotePrim aryMenu:=f rmTelnet.F MListBoxOp tion.items [y];
  12049                  end;
  12050              end;
  12051           en d else beg in
  12052              // set men u here
  12053              frmTelnet. FMListBoxO ption.Item Index:=y;
  12054              FMFiler1.A ddFDA('200 ',AuthorIE N,'201',fr mTelnet.FM ListBoxOpt ion.GetSel ectedRecor d.IEN);
  12055              if frmMain .FMFiler1. AnythingTo File then
  12056                if frmMa in.FMFiler 1.Update t hen begin
  12057                  //Do S tuff here  if need to
  12058                  UserRe motePrimar yMenu:=frm Telnet.FML istBoxOpti on.items[y ];
  12059                end;
  12060           en d;
  12061         end;
  12062     *)
  12063  
  12064       //User RemoteTerm inationDat e:=FMGetsN ewPerson.G etField('9 .2').FMDBI nternal;
  12065  
  12066       // Nee d to check  primary m enu and as sign corre ct menu if  one doesn 't exist.
  12067  
  12068       //if a ssigned(fr mTelnet)=f alse then  begin
  12069         //fr mTelnet:=T frmTelnet. Create(frm Main);
  12070     //end;
  12071     frmTelne t.ServerEd it.Text :=  RPCBroker 1.ANUStrSe rver;
  12072     //frmTel net.Explod eForm1.Set SourceRect (BitBtnVis tA);
  12073  
  12074     // CAPRI _CodeCR104  - jcs - 0 4/23/10 -  Supplement al fix, mo ved follow ing line
  12075     // to fr mTelnet.Co nnectBtnCl ick(Applic ation) so  the captio n is updat ed when th e
  12076     // user  uses the c onnect but ton on the  telnet fo rm. The ca ption of t he main
  12077     // form  may change  if the us er switche d sites.
  12078     // frmTe lnet.capti on := Copy (frmMain.C aption, 19 , length(f rmMain.cap tion));
  12079  
  12080     // CodeC R185 -MER  04/2011
  12081     // Remov ed TELNET  option as  it is no l onger allo wed - djs  10/21/16
  12082   //  if (lU seReflecti on) then b egin
  12083       if not  (Reflecti onWrapper. IsRunning)  then begi n
  12084         Refl ectionWrap per.Host : = RPCBroke r1.ANUStrS erver;
  12085         Refl ectionWrap per.Access Token := ' ~~TOK~~' +  GetAppHan dle(RPCBro ker1);
  12086         Refl ectionWrap per.UserNa me := ANUT elnetLogin Name;
  12087       end;
  12088       Reflec tionWrappe r.LaunchEm ulator;
  12089   //  end el se begin
  12090   //    frmT elnet.Show ;
  12091   //    If f rmTelnet.C onnectBtn. Enabled =  True Then
  12092   //      fr mTelnet.Co nnectBtnCl ick(Applic ation)
  12093   //    Else
  12094   //    Begi n
  12095   //      fr mTelnet.Di sconnectBt nClick(App lication);
  12096   //      fr mTelnet.Co nnectBtnCl ick(Applic ation);
  12097   //    End;
  12098   //  end;
  12099   End;
  12100  
  12101   Procedure  TfrmMain.b uttonCance lReportAdm issionClic k(Sender:  TObject);
  12102   Begin
  12103     PanelRep ortChoice. Visible :=  False;
  12104     PanelRep ortChoice2 .Visible : = False;
  12105   End;
  12106  
  12107   Procedure  TfrmMain.b uttonOKRep ortAdmissi onClick(Se nder: TObj ect);
  12108   Var
  12109     whichind ex: intege r;
  12110     x, y: in teger;
  12111     typeofmo vement: St ring;
  12112   Begin
  12113     whichind ex := fmli stBoxAdmis sion.ItemI ndex;
  12114     If FMLis tBoxAdmiss ion.ItemIn dex > -1 T hen
  12115       If Pos ('UNKNOWN' , fmListBo xAdmission .Items[fmL istBoxAdmi ssion.Item Index]) >  0 Then
  12116       Begin
  12117         Show MessageCAP RI('CAPRI  cannot dis play this  event due  to unknown  data.');
  12118         exit ;
  12119       End;
  12120     If FMLis tBoxAdmiss ion.ItemIn dex = -1 T hen
  12121     Begin
  12122       Showme ssage('Ple ase select  an admiss ion event. ');
  12123       exit;
  12124     End;
  12125     If FMLis tBoxAdmiss ion.ItemIn dex = 0 Th en
  12126       If FML istBoxAdmi ssion.Item s[0] = 'No  admission s found' T hen
  12127       Begin
  12128         Show message('T here are n o admissio n events t o view.');
  12129         exit ;
  12130       End;
  12131     AnimateL ogo(True);
  12132     StatusBa rLoadPt.Ca ption := ' Downloadin g Admissio n Info.';
  12133     StatusBa rLoadPt.Re paint;
  12134     Applicat ion.Proces smessages;
  12135     PanelRep ortChoice. Visible :=  False;
  12136     PanelRep ortChoice2 .Visible : = False;
  12137     FMLister Admissions .PartList. Clear;
  12138     FMLister Admissions .PartList. Add(Patien tIEN);
  12139     //FMList erAdmissio ns.GetList (FMListBox Admission. Items);
  12140     FMListBo xAdmission .GetList;
  12141     If FMLis tBoxAdmiss ion.Items. Count > 0  Then
  12142     Begin                                                                                 //strip of f pt ien a nd anythin g not belo nging to p t.
  12143       For x  := FMListB oxAdmissio n.Items.Co unt - 1 Do wnto 0 Do
  12144       Begin
  12145         If P os(patient ien + '  ' , FMListBo xAdmission .Items[x])  <> 1 Then
  12146           FM ListBoxAdm ission.Ite ms.Delete( x)
  12147         Else
  12148           FM ListBoxAdm ission.Ite ms[x] := C opy(FMList BoxAdmissi on.Items[x ], Pos('   ', FMListB oxAdmissio n.Items[x] ) + 4, 999 );
  12149       End;
  12150     End;
  12151     For x :=  FMListBox Admission. Items.Coun t - 1 Down to 0 Do
  12152     Begin
  12153       FMList BoxAdmissi on.ItemInd ex := x;
  12154       TypeOf Movement : = Copy(FML istBoxAdmi ssion.Item s[x], Pos( '  ', FMLi stBoxAdmis sion.Items [x]) + 4,  255);
  12155       FMGets MovementTy pe.IENS :=  Copy(Type OfMovement , Pos('  ' , TypeOfMo vement) +  4, 255);
  12156       TypeOf Movement : = Copy(Typ eOfMovemen t, 1, Pos( '  ', Type OfMovement ) - 1);
  12157       FMGets MovementTy pe.GetAndF ill;
  12158       FMGets FacilityMo vementType .IENS := T ypeOfMovem ent;
  12159       //FMEd itMovement Type.Text: ='UNKNOWN' ;
  12160       //FMEd itMovement WardLocati on.Text:=' UNKNOWN';
  12161       //FMEd itFacility MovementTy pe.Text:=' UNKNOWN';
  12162       Try
  12163       FMGets FacilityMo vementType .GetAndFil l Except
  12164       End;
  12165       FMGets PatientMov ement.IENS  := FMList BoxAdmissi on.GetSele ctedRecord .IEN;
  12166       Try
  12167       FMGets PatientMov ement.GetA ndFill Exc ept
  12168       End;
  12169       FMList BoxAdmissi on.Items[x ] := FMEdi tMovementT ype.Text +  '  ' + FM DateTimeCo nvert(Copy (FMListBox Admission. Items[x],  1, Pos('   ', FMListB oxAdmissio n.Items[x] ) - 1)) +  '  ' +
  12170         FMEd itFacility MovementTy pe.Text +  '    TO:   ' + FMEdit MovementWa rdLocation .Text;
  12171     End;
  12172  
  12173     // Find  the select ed admissi on in the  full list
  12174     FMListBo xAdmission .ItemIndex  := 0;
  12175     y := 0;
  12176     x := 0;
  12177     If which index > 0  Then
  12178     Begin
  12179       Repeat
  12180         If p os('ADMISS ION', FMLi stBoxAdmis sion.Items [x]) = 1 T hen
  12181           in c(y);
  12182         inc( x);
  12183         If x  > fmlistb oxadmissio n.items.co unt - 1 Th en
  12184         Begi n
  12185           Sh owmessage( 'Couldn''t  find the  admission  due to a p rogram err or!');
  12186           ex it;
  12187         End;
  12188       Until  y = whichi ndex + 1;
  12189       FMList BoxAdmissi on.ItemInd ex := x -  1;
  12190     End
  12191     Else
  12192       FMList BoxAdmissi on.ItemInd ex := 0;
  12193     // End o f find adm ission
  12194  
  12195     WhichInd ex := FMLi stBoxAdmis sion.ItemI ndex;
  12196     ReportMe mo.Lines.C lear;
  12197     ReportMe mo.Visible  := False;
  12198     Try
  12199       If FML istBoxAdmi ssion.Item s[0] = 'No  admission s found' T hen
  12200     exit Exc ept
  12201       Begin
  12202         exit ;
  12203       End;
  12204     End;
  12205     If Label ReportChoi ce.Caption  = 'Detail ed Inpatie nt Inquiry ' Then
  12206     Begin
  12207  
  12208       //Admi ssion
  12209       FMList BoxAdmissi on.ItemInd ex := Whic hIndex;
  12210       FMGets PatientMov ement.IENS  := FMList BoxAdmissi on.GetSele ctedRecord .IEN;
  12211       FMGets PatientMov ement.GetA ndFill;
  12212       Report Memo.Lines .Add('ADMI SSION:');
  12213       Report Memo.Lines .Add('      ' + FMEdi tMovementD ateTime.Te xt + '  '  + FMEditMo vementType ofMovement .Text + '     TO: ' +  FMEditMov ementWardL ocation.Te xt + '  ['  + FMEditM ovementRoo mBed.Text  + ']');
  12214       Report Memo.Lines .Add(' ');
  12215  
  12216       //Tran sfers
  12217       Report Memo.Lines .Add('TRAN SFERS:');
  12218       FMList BoxAdmissi on.ItemInd ex := Whic hIndex;
  12219       x := w hichindex  - 1;
  12220       Repeat
  12221         Begi n
  12222           in c(x);
  12223           If  x <= fmli stboxadmis sion.items .count - 1  Then
  12224              If pos('TR ANSFER', F MListBoxAd mission.It ems[x]) =  1 Then
  12225              Begin
  12226                FMListBo xAdmission .ItemIndex  := x;
  12227                FMGetsPa tientMovem ent.IENS : = FMListBo xAdmission .GetSelect edRecord.I EN;
  12228                FMGetsPa tientMovem ent.GetAnd Fill;
  12229                ReportMe mo.Lines.A dd('     '  + FMEditM ovementDat eTime.Text  + '  ' +  FMEditMove mentTypeof Movement.T ext + '     TO: ' + F MEditMovem entWardLoc ation.Text  + '  [' +  FMEditMov ementRoomB ed.Text +
  12230                  ']');
  12231              End;
  12232       End Un til ((x >  fmlistboxa dmission.i tems.count  - 1) Or ( pos('DISCH ARGE', FML istBoxAdmi ssion.Item s[x]) = 1) );
  12233       Report Memo.Lines .Add(' ');
  12234  
  12235       //Trea ting Speci alty Chang es
  12236       Report Memo.Lines .Add('TREA TING SPECI ALTY CHANG ES:');
  12237       FMList BoxAdmissi on.ItemInd ex := Whic hIndex;
  12238       x := w hichindex  - 1;
  12239       Repeat
  12240         Begi n
  12241           in c(x);
  12242           If  x <= fmli stboxadmis sion.items .count - 1  Then
  12243              If pos('SP ECIALTY TR ANSFER', F MListBoxAd mission.It ems[x]) =  1 Then
  12244              Begin
  12245                FMListBo xAdmission .ItemIndex  := x;
  12246                FMGetsPa tientMovem ent.IENS : = FMListBo xAdmission .GetSelect edRecord.I EN;
  12247                FMGetsPa tientMovem ent.GetAnd Fill;
  12248                If FMMem oMovementD iagnosis.L ines.Count  = 0 Then
  12249                  FMMemo MovementDi agnosis.Li nes.Add('  ');
  12250                ReportMe mo.Lines.A dd('     '  + FMEditM ovementDat eTime.Text  + '    SP ECIALTY:   ' + FMEdit MovementSp ecialty.Te xt);
  12251                ReportMe mo.Lines.A dd('        PROVIDER:    ' + FME ditMovemen tProvider. Text);
  12252                ReportMe mo.Lines.A dd('        ATTENDING :  ' + FME ditMovemen tAttending .Text + '     DX:  '  + FMMemoMo vementDiag nosis.Line s[0]);
  12253                FMMemoMo vementDiag nosis.Line s.Delete(0 );
  12254                If FMMem oMovementD iagnosis.L ines.Count  > 0 Then
  12255                  Repeat
  12256                    Begi n
  12257                      Re portMemo.L ines.Add('                          DX:  '  + FMMemoMo vementDiag nosis.Line s[0]);
  12258                      FM MemoMoveme ntDiagnosi s.Lines.De lete(0);
  12259                  End Un til FMMemo MovementDi agnosis.Li nes.Count  = 0;
  12260              End;
  12261       End Un til ((x >  fmlistboxa dmission.i tems.count  - 1) Or ( pos('DISCH ARGE', FML istBoxAdmi ssion.Item s[x]) = 1) );
  12262       Report Memo.Lines .Add('');
  12263  
  12264       //Disc harge
  12265       FMList BoxAdmissi on.ItemInd ex := Whic hIndex;
  12266       x := w hichindex  - 1;
  12267       Repeat
  12268         Begi n
  12269           in c(x);
  12270       End Un til ((x >  fmlistboxa dmission.i tems.count  - 1) Or ( pos('DISCH ARGE', FML istBoxAdmi ssion.Item s[x]) = 1) );
  12271       If x >  fmlistbox admission. items.coun t - 1 Then
  12272       Begin
  12273         Repo rtMemo.Lin es.Add('DI SCHARGE:') ;
  12274         Repo rtMemo.Sel Start := 0 ;                                                      // Forces  cursor to  beginning
  12275         Repo rtMemo.Sel Length :=  0;
  12276         Repo rtMemo.Vis ible := Tr ue;
  12277         exit ;                                                                            // patient  is still  admitted
  12278       End;
  12279       FMList BoxAdmissi on.ItemInd ex := x;
  12280       FMGets PatientMov ement.IENS  := FMList BoxAdmissi on.GetSele ctedRecord .IEN;
  12281       FMGets PatientMov ement.GetA ndFill;
  12282       Report Memo.Lines .Add('DISC HARGE:');
  12283       Report Memo.Lines .Add('      ' + FMEdi tMovementD ateTime.Te xt + '  '  + FMEditMo vementType ofMovement .Text);
  12284       Report Memo.Lines .Add('');
  12285     End;
  12286     ReportMe mo.SelStar t := 0;                                                           // Forces  cursor to  beginning
  12287     ReportMe mo.SelLeng th := 0;
  12288     ReportMe mo.Visible  := True;
  12289     AnimateL ogo(False) ;
  12290     StatusBa rLoadPt.Ca ption := ' Ready.';
  12291     StatusBa rLoadPt.Re paint;
  12292     Applicat ion.Proces smessages;
  12293   End;
  12294  
  12295   Procedure  TfrmMain.S eventyOne3 1RequestRe freshClick (Sender: T Object);
  12296   Var
  12297     x: integ er;
  12298     date1, d ate2: Stri ng;
  12299   Begin
  12300     AnimateL ogo(True);
  12301     StatusBa rLoadPt.Ca ption := ' Re-populat ing 7131 r equests li st...';
  12302     StatusBa rLoadPt.Re paint;
  12303     Applicat ion.Proces smessages;
  12304     // Get C &P Exam Da tes
  12305     FMSevent yOne31List er1.PartLi st.Clear;
  12306     FMSevent yOne31List er1.PartLi st.Add(Pat ientIEN);
  12307     FMSevent yOne31Requ estListbox .GetList;
  12308     // Make  sure data  is correct  for Patie ntIEN
  12309     If FMSev entyOne31R equestList Box.Items. Count > 0  Then
  12310       For x  := FMSeven tyOne31Req uestListBo x.Items.Co unt - 1 Do wnto 0 Do
  12311       Begin
  12312         If P os(Patient IEN + '  ' , FMSevent yOne31Requ estListBox .Items[x])  <> 1 Then
  12313           FM SeventyOne 31RequestL istBox.Ite ms.Delete( x);
  12314       End;
  12315     // Refor mat data
  12316     If FMSev entyOne31R equestList box.Items. Count > 0  Then
  12317       For x  := 0 To FM SeventyOne 31RequestL istbox.Ite ms.Count -  1 Do
  12318       Begin
  12319         FMSe ventyOne31 RequestLis tbox.Items [x] := Cop y(FMSevent yOne31Requ estListbox .Items[x],  Pos('  ',  FMSeventy One31Reque stListbox. Items[x])  + 4, 255);  // Strip  patient IE N;
  12320         Date 1 := Copy( FMSeventyO ne31Reques tListbox.I tems[x], 1 , Pos('  ' , FMSevent yOne31Requ estListbox .Items[x])  - 1);
  12321         FMSe ventyOne31 RequestLis tbox.Items [x] := Cop y(FMSevent yOne31Requ estListbox .Items[x],  Pos('  ',  FMSeventy One31Reque stListbox. Items[x])  + 4, 500);
  12322         Date 2 := FMSev entyOne31R equestList box.Items[ x];
  12323         FMSe ventyOne31 RequestLis tbox.Items [x] := Cop y(FMSevent yOne31Requ estListbox .Items[x],  Pos('  ',  FMSeventy One31Reque stListbox. Items[x])  + 4, 500);
  12324         If D ate2 <> ''  Then
  12325           FM SeventyOne 31RequestL istbox.Ite ms[x] := C opy(FMDate TimeConver t(Date1) +  '                      ', 1, 20 ) + '  |   ' + FMDate TimeConver t(Date2)
  12326         Else
  12327           If  Date1 <>  '' Then
  12328              FMSeventyO ne31Reques tListbox.I tems[x] :=  Copy(FMDa teTimeConv ert(Date1)  + '                      ', 1,  20) + '  |   '
  12329           El se
  12330              FMSeventyO ne31Reques tListbox.I tems[x] :=  Copy('OUT PT TREATME NT     ',  1, 20) + '   |  ';
  12331         //Fi x single d igit date  and move o ver
  12332         If C opy(FMSeve ntyOne31Re questListb ox.Items[x ], 6, 1) =  ',' Then
  12333           FM SeventyOne 31RequestL istbox.Ite ms[x] := C opy(FMSeve ntyOne31Re questListb ox.Items[x ], 1, 4) +  ' ' + Cop y(FMSevent yOne31Requ estListbox .Items[x],  5, 15) +
  12334              Copy(FMSev entyOne31R equestList box.Items[ x], 21, 99 );
  12335  
  12336       End;
  12337     AnimateL ogo(False) ;
  12338     StatusBa rLoadPt.Ca ption := ' Ready.';
  12339     StatusBa rLoadPt.Re paint;
  12340     Applicat ion.Proces smessages;
  12341   End;
  12342  
  12343   Procedure  TfrmMain.b tnAdd7131C lick(Sende r: TObject );
  12344   Var
  12345     x, y: in teger;
  12346   Begin
  12347     If ANURe moteProced ureCallInP rogress =  True Then
  12348       exit;
  12349  
  12350     If frmRO Finder.ORL istBoxSite s.Items.Co unt = 0 Th en
  12351       LoadIn stitutions ;
  12352  
  12353     AddReque stIEN := ' ';
  12354     frmMain. RPCBroker1 .Results.C lear;
  12355     RPCBroke r1.RemoteP rocedure : = 'DVBAB C HECK CREDE NTIALS';
  12356     RPCBroke rCall;
  12357     Try
  12358       RPCBro ker1.Call;
  12359     Except
  12360       On EBr okerError  Do
  12361       Begin
  12362         ANUR emoteProce dureCallIn Progress : = False;
  12363         Anim ateLogo(Fa lse);
  12364         Stat usBarLoadP t.Caption  := 'RPC DV BAB CHECK  CREDENTIAL S could no t be acces sed!';
  12365         Stat usBarLoadP t.Repaint;
  12366         Appl ication.Pr ocessmessa ges;
  12367         Show MessageCAP RI('RPC DV BAB CHECK  CREDENTIAL S could no t be acces sed!');
  12368       End;
  12369     End;
  12370     If RPCBr oker1.Resu lts[0] <>  '[OK]' The n
  12371     Begin
  12372       ShowMe ssageCAPRI (RPCBroker 1.Results[ 0]);
  12373       applic ation.term inate;
  12374       Exit;
  12375     End;
  12376     AnimateL ogo(True);
  12377     StatusBa rLoadPt.Ca ption := ' Loading ev ents.';
  12378     StatusBa rLoadPt.Re paint;
  12379     Applicat ion.Proces smessages;
  12380  
  12381     btnAddRe quest.Enab led := Fal se;
  12382     BitBtnVi stA.enable d := False ;
  12383     btnViewE xam.Enable d := False ;
  12384     btnExamF inalReport .Enabled : = False;
  12385     btnGener ateReport. Enabled :=  False;
  12386  
  12387     frmNew71 31 := Tfrm New7131.Cr eate(frmMa in);
  12388     frmNew71 31.Checkbo x1.Checked  := False;
  12389     frmNew71 31.Checkbo x2.Checked  := False;
  12390     frmNew71 31.Checkbo x3.Checked  := False;
  12391     frmNew71 31.Checkbo x4.Checked  := False;
  12392     frmNew71 31.Checkbo x5.Checked  := False;
  12393     frmNew71 31.Checkbo x6.Checked  := False;
  12394     frmNew71 31.Checkbo x7.Checked  := False;
  12395     frmNew71 31.Checkbo x8.Checked  := False;
  12396     frmNew71 31.Checkbo x9.Checked  := False;
  12397     frmNew71 31.Checkbo x10.Checke d := False ;
  12398     frmNew71 31.FMChk1. Text := '' ;
  12399     frmNew71 31.FMChk2. Text := '' ;
  12400     frmNew71 31.FMChk3. Text := '' ;
  12401     frmNew71 31.FMChk4. Text := '' ;
  12402     frmNew71 31.FMChk5. Text := '' ;
  12403     frmNew71 31.FMChk6. Text := '' ;
  12404     frmNew71 31.FMChk7. Text := '' ;
  12405     frmNew71 31.FMChk8. Text := '' ;
  12406     frmNew71 31.FMChk9. Text := '' ;
  12407     frmNew71 31.FMChk10 .Text := ' ';
  12408     frmNew71 31.FMDocum entType.Te xt := '';
  12409     frmNew71 31.FMRegio nalOfficeN umberFake. Text := '' ;
  12410     frmNew71 31.FMRegio nalOfficeN umber.Item Index := - 1;
  12411     frmNew71 31.FMReque stDate.Tex t := '';
  12412     frmNew71 31.FMDateS tatusChang e.Text :=  '';
  12413     frmNew71 31.FMTxRep ort.Text : = '';
  12414     frmNew71 31.FMAdmis sionDate.T ext := '';
  12415     frmNew71 31.FMComme ntsMemo.Li nes.Clear;
  12416     frmNew71 31.FMRouti ngLocation Fake.Text  := '';
  12417     frmNew71 31.FMRouti ngLocation .ItemIndex  := -1;
  12418     frmNew71 31.ScrollB ox1.VertSc rollBar.Po sition :=  0;
  12419  
  12420     // If cr edentials  are ok, th en continu e
  12421     {Use CPR S Visit Lo ader ORQQV S VISITS/A PPTS}
  12422     RPCBroke r1.RemoteP rocedure : = 'ORQQVS  VISITS/APP TS';
  12423     RPCBroke r1.Param[0 ].Value :=  PatientIE N;
  12424     RPCBroke r1.Param[0 ].PType :=  literal;
  12425     RPCBroke r1.Param[1 ].Value :=  'T-9999';                                             {Date to s tart}
  12426     RPCBroke r1.Param[1 ].PType :=  literal;
  12427     RPCBroke r1.Param[2 ].Value :=  'T@11:59P M';                                         {Date to s top}
  12428     RPCBroke r1.Param[2 ].PType :=  literal;
  12429     RPCBroke r1.Param[3 ].Value :=  '';
  12430     RPCBroke r1.Param[3 ].PType :=  literal;
  12431     RPCBroke rCall;
  12432     Try
  12433       RPCBro ker1.Call;
  12434     Except
  12435       On EBr okerError  Do
  12436       Begin
  12437         ANUR emoteProce dureCallIn Progress : = False;
  12438         Anim ateLogo(Fa lse);
  12439         Stat usBarLoadP t.Caption  := 'RPC OR QQVS VISIT S/APPTS co uld not be  accessed! ';
  12440         Stat usBarLoadP t.Repaint;
  12441         Appl ication.Pr ocessmessa ges;
  12442         Show MessageCAP RI('Connec tion to se rver for O RQQVS VISI TS/APPTS c ould not b e establis hed!');
  12443       End;
  12444     End;
  12445     {Copy to  hidden li stbox}
  12446     frmNew71 31.ListBox 2.Items.Cl ear;                                                   {Hidden Bo x}
  12447     frmNew71 31.ListBox 4.Items.Cl ear;                                                   {Inpt Box}
  12448     frmNew71 31.ListBox 5.Items.Cl ear;                                                   {Hidden Bo x}
  12449     frmNew71 31.ListBox 2.Items :=  RPCBroker 1.Results;
  12450     // Remov e all admi ssion info  and do it  another w ay
  12451     If frmNe w7131.List box2.Items .Count > 0  Then
  12452       For x  := frmNew7 131.Listbo x2.Items.C ount - 1 D ownto 0 Do
  12453       Begin
  12454         If P os('^admit ted:^', fr mNew7131.L istBox2.It ems[x]) >  0 Then
  12455           fr mNew7131.L istBox2.It ems.Delete (x)
  12456       End;
  12457     {Use CPR S Visit Lo ader ORWPT  ADMITLST}
  12458     RPCBroke r1.RemoteP rocedure : = 'ORWPT A DMITLST';
  12459     RPCBroke r1.Param[0 ].Value :=  PatientIE N;
  12460     RPCBroke r1.Param[0 ].PType :=  literal;
  12461     RPCBroke rCall;
  12462     Try
  12463       RPCBro ker1.Call;
  12464     Except
  12465       On EBr okerError  Do
  12466       Begin
  12467         ANUR emoteProce dureCallIn Progress : = False;
  12468         Anim ateLogo(Fa lse);
  12469         Stat usBarLoadP t.Caption  := 'RPC OR WPT ADMITL ST could n ot be acce ssed!';
  12470         Stat usBarLoadP t.Repaint;
  12471         Appl ication.Pr ocessmessa ges;
  12472         Show MessageCAP RI('Connec tion to se rver for O RWPT ADMIT LST could  not be est ablished!' );
  12473       End;
  12474     End;
  12475     frmNew71 31.ListBox 2.Items.Cl ear;                                                   {Hidden Bo x}
  12476     frmNew71 31.ListBox 4.Items.Cl ear;                                                   {Inpt Box}
  12477     frmNew71 31.ListBox 5.Items.Cl ear;                                                   {Hidden Bo x}
  12478     frmNew71 31.ListBox 2.Items :=  RPCBroker 1.Results;
  12479     If frmNe w7131.List box2.Items .Count > 0  Then
  12480       For x  := 0 To fr mNew7131.L istbox2.It ems.Count  - 1 Do
  12481       Begin
  12482         frmN ew7131.Lis tBox4.Item s.Add(Copy (frmNew713 1.ListBox2 .Items[x],  Pos('^',  frmNew7131 .ListBox2. Items[x])  + 1, 254)) ;
  12483         frmN ew7131.Lis tBox4.Item s[x] := Co py(frmNew7 131.ListBo x4.Items[x ], Pos('^' , frmNew71 31.ListBox 4.Items[x] ) + 1, 254 );
  12484         frmN ew7131.Lis tBox4.Item s[x] := FM DateTimeCo nvert(Copy (frmNew713 1.ListBox2 .Items[x],  1, Pos('^ ', frmNew7 131.ListBo x2.Items[x ]) - 1)) +  '  ' + Co py(frmNew7 131.ListBo x4.Items[x ], 1, Pos( '^',
  12485           fr mNew7131.L istBox4.It ems[x]) -  1);
  12486         frmN ew7131.Lis tBox5.Item s.Add(Copy (frmNew713 1.ListBox2 .Items[x],  1, Pos('^ ', frmNew7 131.ListBo x2.Items[x ]) - 1));
  12487       End;
  12488     //Popula te Control s
  12489  
  12490     (*
  12491     frmNew71 31.FMRegio nalOfficeN umber.Item s.Clear;
  12492     If lstIn stitutions .Items.Cou nt>0 then
  12493       For x: =0 to lstI nstitution s.Items.Co unt-1 do
  12494           fr mNew7131.F MRegionalO fficeNumbe r.Items.Ad d(Copy(lst Institutio ns.Items[x ],1,Pos('^ ',lstInsti tutions.It ems[x])-1) );
  12495   *)
  12496     frmNew71 31.FMPatie ntName.Tex t := Copy( Panel1.Cap tion, 1, P os('  SSN# ', Panel1. Caption));
  12497     frmNew71 31.FMPatie ntNameIEN. Text := '` ' + Patien tIEN;
  12498     frmNew71 31.FMReque stDate.Tex t := 'TODA Y';
  12499     frmNew71 31.FMDateS tatusChang e.Text :=  'TODAY';
  12500     frmNew71 31.FMReque stedBy.Tex t := FMUse rName.Capt ion;
  12501     frmNew71 31.FMRouti ngLocation .Items :=  listMedica lCenterDiv ision;
  12502     frmNew71 31.FMPatie ntNameIEN. IENS := '+ 1';
  12503     frmNew71 31.FMRegio nalOfficeN umberFake. IENS := '+ 1';
  12504     frmNew71 31.FMReque stedBy.IEN S := '+1';
  12505     frmNew71 31.FMReque stDate.IEN S := '+1';
  12506     frmNew71 31.FMDateS tatusChang e.IENS :=  '+1';
  12507     frmNew71 31.FMDocum entType.IE NS := '+1' ;
  12508     frmNew71 31.FMTxRep ort.IENS : = '+1';
  12509     frmNew71 31.FMRouti ngLocation Fake.IENS  := '+1';
  12510     frmNew71 31.FMAdmis sionDate.I ENS := '+1 ';
  12511     frmNew71 31.FMComme ntsMemo.IE NS := '+1' ;
  12512     frmNew71 31.FMChk1. IENS := '+ 1';
  12513     frmNew71 31.FMChk2. IENS := '+ 1';
  12514     frmNew71 31.FMChk3. IENS := '+ 1';
  12515     frmNew71 31.FMChk4. IENS := '+ 1';
  12516     frmNew71 31.FMChk5. IENS := '+ 1';
  12517     frmNew71 31.FMChk6. IENS := '+ 1';
  12518     frmNew71 31.FMChk7. IENS := '+ 1';
  12519     frmNew71 31.FMChk8. IENS := '+ 1';
  12520     frmNew71 31.FMChk9. IENS := '+ 1';
  12521     frmNew71 31.FMChk10 .IENS := ' +1';
  12522  
  12523     AnimateL ogo(False) ;
  12524     StatusBa rLoadPt.Ca ption := ' Ready.';
  12525     StatusBa rLoadPt.Re paint;
  12526     Applicat ion.Proces smessages;
  12527  
  12528     //Enter  request
  12529     frmNew71 31.Height  := frmMain .Height -  32;
  12530     If frmNe w7131.Heig ht > 850 T hen
  12531       frmNew 7131.Heigh t := 850;
  12532     frmNew71 31.Top :=  7 + frmMai n.Top + (( frmMain.He ight - frm New7131.He ight) Div  2);
  12533     frmNew71 31.Left :=  frmMain.L eft + ((fr mMain.Widt h - frmNew 7131.Width ) Div 2);
  12534     frmNew71 31.btnSend Request.To p := frmNe w7131.Heig ht - 81;
  12535     frmNew71 31.btnCanc el.Top :=  frmNew7131 .Height -  81;
  12536     frmNew71 31.Scrollb ox1.Height  := frmNew 7131.Heigh t - 82;
  12537     //frmMai n.BorderIc ons:=frmMa in.BorderI cons-[biSy stemMenu];
  12538     frmNew71 31.Panel2. Visible :=  False;
  12539  
  12540     frmNew71 31.FMListe rCustomExa mListDivis ionsListBo x.GetList;
  12541     //Check  for inacti ve divisio ns
  12542     If frmNe w7131.FMLi sterCustom ExamListDi visionsLis tBox.Items .Count > 0  Then
  12543       For x  := 0 To fr mNew7131.F MListerCus tomExamLis tDivisions ListBox.It ems.Count  - 1 Do
  12544       Begin
  12545         frmN ew7131.FML isterCusto mExamListD ivisionsLi stBox.Item Index := x ;
  12546         frmN ew7131.Cus tomExamLis tDivisions .IENS := f rmNew7131. FMListerCu stomExamLi stDivision sListBox.G etSelected Record.IEN ;
  12547         frmN ew7131.Cus tomExamLis tDivisions .GetAndFil l;
  12548         //In activate i f "YES"
  12549         If f rmNew7131. FMEditInac tivateDivi sion.Text  = 'YES' Th en
  12550         Begi n
  12551           If  frmNew713 1.FMRoutin gLocation. Items.Coun t > 0 Then
  12552              For y := f rmNew7131. FMRoutingL ocation.It ems.Count  - 1 Downto  0 Do
  12553              Begin
  12554                frmNew71 31.FMRouti ngLocation .ItemIndex  := y;
  12555                If Piece (frmNew713 1.FMRoutin gLocation. Items[y],  '^', 2) =  frmNew7131 .FMListerC ustomExamL istDivisio nsListBox. Items[x] T hen
  12556                Begin
  12557                  frmNew 7131.FMRou tingLocati on.Items.D elete(y);
  12558                End;
  12559              End;
  12560         End;
  12561       End;
  12562     frmNew71 31.FMRouti ngLocation .ItemIndex  := -1;
  12563  
  12564     // Set u p division ...
  12565     searchfo rstring :=  UserDivis ion;
  12566     frmNew71 31.FMRegio nalOfficeN umber.Text  := UserDi vision;
  12567     frmNew71 31.FMRegio nalOfficeN umberFake. Text := Us erDivision ;
  12568     frmNew71 31.FMRegio nalOfficeN umberEnter (Applicati on);
  12569     searchfo rstring :=  '';
  12570  
  12571     Contexto rChangeMes sage := 'Y ou are add ing a new  7131 reque st.  If yo u continue , you will  lose your  work.';
  12572     CCOWBrea kLink := T rue;
  12573     frmNew71 31.ShowMod al;
  12574     Contexto rChangeMes sage := '' ;
  12575     CCOWBrea kLink := F alse;
  12576     //frmMai n.BorderIc ons:=frmMa in.BorderI cons+[biSy stemMenu];
  12577     SeventyO ne31Reques tRefreshCl ick(Applic ation);
  12578     frmNew71 31.release ;
  12579     frmNew71 31 := Nil;
  12580     Try
  12581       frmROF inder.Hide ;
  12582     Except
  12583     End;
  12584  
  12585     if ESSOV ersion the n
  12586       BitBtn VistA.enab led := Tru e;                                                     //only rem ote connec tions - rp m 3/17/09
  12587     If ReadO nlyMode =  False Then
  12588       btnAdd Request.En abled := T rue;
  12589     If FMSev entyOne31R equestList box.Itemin dex > -1 T hen
  12590     Begin
  12591       btnGen erate7131R eport.Enab led := Tru e;
  12592       btnVie w7131.Enab led := Tru e;
  12593     End
  12594     Else
  12595     Begin
  12596       btnGen erate7131R eport.Enab led := Fal se;
  12597       btnVie w7131.Enab led := Fal se;
  12598     End;
  12599   End;
  12600  
  12601   Procedure  TfrmMain.l oadInstitu tions;
  12602   Begin
  12603     If ANURe moteProced ureCallInP rogress =  True Then
  12604       Repeat  applicati on.process messages U ntil ANURe moteProced ureCallInP rogress =  False;
  12605  
  12606     AnimateL ogo(True);
  12607     StatusBa rLoadPt.Ca ption := ' Loading in stitutions ...';
  12608     StatusBa rLoadPt.Re paint;
  12609     Applicat ion.Proces smessages;
  12610     frmROFin der.button 1Click(App lication);
  12611     (*
  12612       {Load  Institutio ns to List box}
  12613       lstIns titutions. Items.Clea r;
  12614       RPCBro ker1.Remot eProcedure  := 'DVBAB  INST LIST ';
  12615  
  12616       RPCBro kerCall; t ry RPCBrok er1.Call;
  12617         exce pt
  12618       On EBr okerError  do begin   ANURemoteP rocedureCa llInProgre ss:=False;
  12619         Anim ateLogo(Fa lse);
  12620         Stat usBarLoadP t.Caption: ='RPC INST  LIST coul d not be a ccessed!';  StatusBar LoadPt.Rep aint; Appl ication.Pr ocessmessa ges;
  12621         Show MessageCAP RI('DVBAB  INST LIST  could not  be accesse d!');
  12622       end; e nd;
  12623       lstIns titutions. Items:=RPC Broker1.Re sults;
  12624       // Loa d RO #'s.. .
  12625       If lst Institutio ns.Items.C ount>0 the n
  12626          For  yy:=0 to  lstInstitu tions.Item s.Count-1  do
  12627               FMRegiona lOfficeNum ber.Items. Add(Copy(l stInstitut ions.Items [yy],1,Pos ('^',lstIn stitutions .Items[yy] )-1));
  12628  
  12629       // Det ermine if  fany entri es have ju st -RO and  if so, on ly show th ose.
  12630       // Als o show Cen tral Offic e
  12631       FoundR O:=False;
  12632       If lst Institutio ns.Items.C ount>0 the n begin
  12633         For  yy:=0 to l stInstitut ions.Items .Count-1 d o
  12634           If  Pos('-RO^ ',lstInsti tutions.It ems[yy])>0  then
  12635              FoundRO:=T rue;
  12636          If  FoundRO=Tr ue then be gin
  12637            F or yy:=lst Institutio ns.Items.C ount-1 dow nto 0 do
  12638              If (Pos('- BVA/VBA-SO ^',lstInst itutions.I tems[yy])= 0) and
  12639                 (Pos('- RO^',lstIn stitutions .Items[yy] )=0) and
  12640                 (Pos('- CO^',lstIn stitutions .Items[yy] )=0) and
  12641                 (Pos('C ENTRAL OFF ICE',lstIn stitutions .Items[yy] )=0) and
  12642                 (Pos('B VA',lstIns titutions. Items[yy]) =0) and
  12643                 (Pos('- M&ROC',lst Institutio ns.Items[y y])=0) and
  12644                 (Pos('- RO-OC',lst Institutio ns.Items[y y])=0) and
  12645                 (Pos('- RO&IC',lst Institutio ns.Items[y y])=0) and
  12646                 (Pos('V AMROC',lst Institutio ns.Items[y y])=0) and
  12647                 (Pos('F ARGO^',lst Institutio ns.Items[y y])=0) and
  12648                 (Pos('V AHSRO',lst Institutio ns.Items[y y])=0)
  12649                then beg in
  12650                lstInsti tutions.It ems.Delete (yy);
  12651                end;
  12652          end ;
  12653       end;
  12654       *)
  12655  
  12656     AnimateL ogo(False) ;
  12657     StatusBa rLoadPt.Ca ption := ' Ready.';
  12658     StatusBa rLoadPt.Re paint;
  12659     Applicat ion.Proces smessages;
  12660   End;
  12661  
  12662   Procedure  TfrmMain.b tnView7131 Click(Send er: TObjec t);
  12663   Begin
  12664     If frmRO Finder.ORL istBoxSite s.Items.Co unt = 0 Th en
  12665       LoadIn stitutions ;
  12666  
  12667     If FMSev entyOne31R equestList Box.ItemIn dex = -1 T hen
  12668       exit;
  12669     frmMain. RPCBroker1 .Results.C lear;
  12670     RPCBroke r1.RemoteP rocedure : = 'DVBAB C HECK CREDE NTIALS';
  12671     RPCBroke rCall;
  12672     Try
  12673       RPCBro ker1.Call;
  12674     Except
  12675       On EBr okerError  Do
  12676       Begin
  12677         ANUR emoteProce dureCallIn Progress : = False;
  12678         Anim ateLogo(Fa lse);
  12679         Stat usBarLoadP t.Caption  := 'RPC DV BAB CHECK  CREDENTIAL S could no t be acces sed!';
  12680         Stat usBarLoadP t.Repaint;
  12681         Appl ication.Pr ocessmessa ges;
  12682         Show MessageCAP RI('RPC DV BAB CHECK  CREDENTIAL S could no t be acces sed!');
  12683       End;
  12684     End;
  12685     If RPCBr oker1.Resu lts[0] <>  '[OK]' The n
  12686     Begin
  12687       ShowMe ssageCAPRI (RPCBroker 1.Results[ 0]);
  12688       applic ation.term inate;
  12689       Exit;
  12690     End;
  12691  
  12692     btnAddRe quest.Enab led := Fal se;
  12693     BitBtnVi stA.enable d := False ;
  12694     btnView7 131.Enable d := False ;
  12695     btnGener ate7131Rep ort.Enable d := False ;
  12696     // Set u p form
  12697     frmView7 131 := Tfr mView7131. Create(frm Main);
  12698     frmView7 131.FMGets ExamReques t.IENS :=  FMSeventyO ne31Reques tListbox.G etSelected Record.IEN ;
  12699     frmView7 131.FMGets ExamReques t.GetAndFi ll;
  12700     frmView7 131.FMRout ingLocatio n.Items :=  listMedic alCenterDi vision;
  12701     frmView7 131.FMRegi onalOffice Number.Ite ms.Clear;
  12702     (*
  12703        If ls tInstituti ons.Items. Count>0 th en
  12704          For  x:=0 to l stInstitut ions.Items .Count-1 d o
  12705               frmView71 31.FMRegio nalOfficeN umber.Item s.Add(Copy (lstInstit utions.Ite ms[x],1,Po s('^',lstI nstitution s.Items[x] )-1));
  12706     *)
  12707        // If  credentia ls are ok,  then cont inue
  12708     frmView7 131.Height  := frmMai n.Height -  32;
  12709     If frmVi ew7131.Hei ght > 805  Then
  12710       frmVie w7131.Heig ht := 805;
  12711     frmView7 131.btnCan cel.Top :=  frmView71 31.Height  - 81;
  12712     frmView7 131.Scroll box1.Heigh t := frmVi ew7131.Hei ght - 83;
  12713     frmView7 131.Top :=  7 + frmMa in.Top + ( (frmMain.H eight - fr mView7131. Height) Di v 2);
  12714     frmView7 131.Left : = frmMain. Left + ((f rmMain.Wid th - frmVi ew7131.Wid th) Div 2) ;
  12715     frmView7 131.FMRegi onalOffice Number.Tex t := frmVi ew7131.FMR egionalOff iceNumberF ake.Text;
  12716     frmView7 131.FMRout ingLocatio n.Text :=  frmView713 1.FMRoutin gLocationF ake.Text;
  12717     If frmVi ew7131.FMC hk1.Text =  'YES' The n
  12718       frmVie w7131.Chec kbox1.Chec ked := Tru e
  12719     Else
  12720       frmVie w7131.Chec kbox1.Chec ked := Fal se;
  12721     If frmVi ew7131.FMC hk2.Text =  'YES' The n
  12722       frmVie w7131.Chec kbox2.Chec ked := Tru e
  12723     Else
  12724       frmVie w7131.Chec kbox2.Chec ked := Fal se;
  12725     If frmVi ew7131.FMC hk3.Text =  'YES' The n
  12726       frmVie w7131.Chec kbox3.Chec ked := Tru e
  12727     Else
  12728       frmVie w7131.Chec kbox3.Chec ked := Fal se;
  12729     If frmVi ew7131.FMC hk4.Text =  'YES' The n
  12730       frmVie w7131.Chec kbox4.Chec ked := Tru e
  12731     Else
  12732       frmVie w7131.Chec kbox4.Chec ked := Fal se;
  12733     If frmVi ew7131.FMC hk5.Text =  'YES' The n
  12734       frmVie w7131.Chec kbox5.Chec ked := Tru e
  12735     Else
  12736       frmVie w7131.Chec kbox5.Chec ked := Fal se;
  12737     If frmVi ew7131.FMC hk6.Text =  'YES' The n
  12738       frmVie w7131.Chec kbox6.Chec ked := Tru e
  12739     Else
  12740       frmVie w7131.Chec kbox6.Chec ked := Fal se;
  12741     If frmVi ew7131.FMC hk7.Text =  'YES' The n
  12742       frmVie w7131.Chec kbox7.Chec ked := Tru e
  12743     Else
  12744       frmVie w7131.Chec kbox7.Chec ked := Fal se;
  12745     If frmVi ew7131.FMC hk8.Text =  'YES' The n
  12746       frmVie w7131.Chec kbox8.Chec ked := Tru e
  12747     Else
  12748       frmVie w7131.Chec kbox8.Chec ked := Fal se;
  12749     If frmVi ew7131.FMC hk9.Text =  'YES' The n
  12750       frmVie w7131.Chec kbox9.Chec ked := Tru e
  12751     Else
  12752       frmVie w7131.Chec kbox9.Chec ked := Fal se;
  12753     If frmVi ew7131.FMC hk10.Text  = 'YES' Th en
  12754       frmVie w7131.Chec kbox10.Che cked := Tr ue
  12755     Else
  12756       frmVie w7131.Chec kbox10.Che cked := Fa lse;
  12757     If ((Cop y(FMSevent yOne31Requ estListbox .Items[FMS eventyOne3 1RequestLi stbox.Item Index], 26 , 99) = '' ) And (Rea dOnlyMode  = False))  Then
  12758     Begin
  12759       //Requ est not co mpleted ye t.  Allow  edit of ke y fields.
  12760       frmVie w7131.Chec kbox4.Enab led := Tru e;
  12761       frmVie w7131.Chec kbox5.Enab led := Tru e;
  12762       frmVie w7131.Chec kbox6.Enab led := Tru e;
  12763       frmVie w7131.Chec kbox7.Enab led := Tru e;
  12764       frmVie w7131.Chec kbox8.Enab led := Tru e;
  12765       frmVie w7131.Chec kbox10.Ena bled := Tr ue;
  12766       frmVie w7131.FMRe gionalOffi ceNumber.E nabled :=  True;
  12767       frmVie w7131.FMTx Report.Ena bled := Tr ue;
  12768       frmVie w7131.FMRo utingLocat ion.Enable d := True;
  12769       //frmV iew7131.FM AdmissionD ate.Enable d:=True;
  12770       frmVie w7131.FMCo mmentsMemo .ReadOnly  := False;
  12771     End
  12772     Else
  12773     Begin
  12774       //Make  Read Only .  Request  has been  completed.
  12775       frmVie w7131.Chec kbox1.Enab led := Fal se;
  12776       frmVie w7131.Chec kbox2.Enab led := Fal se;
  12777       frmVie w7131.Chec kbox3.Enab led := Fal se;
  12778       frmVie w7131.Chec kbox4.Enab led := Fal se;
  12779       frmVie w7131.Chec kbox5.Enab led := Fal se;
  12780       frmVie w7131.Chec kbox6.Enab led := Fal se;
  12781       frmVie w7131.Chec kbox7.Enab led := Fal se;
  12782       frmVie w7131.Chec kbox8.Enab led := Fal se;
  12783       frmVie w7131.Chec kbox9.Enab led := Fal se;
  12784       frmVie w7131.Chec kbox10.Ena bled := Fa lse;
  12785       frmVie w7131.FMRe gionalOffi ceNumber.E nabled :=  False;
  12786       frmVie w7131.FMTx Report.Ena bled := Fa lse;
  12787       frmVie w7131.FMRo utingLocat ion.Enable d := False ;
  12788       frmVie w7131.FMAd missionDat e.Enabled  := False;
  12789       frmVie w7131.FMCo mmentsMemo .ReadOnly  := True;
  12790     End;
  12791     frmView7 131.Scroll Box1.VertS crollBar.P osition :=  0;
  12792  
  12793     frmView7 131.FMRegi onalOffice Number.Ena bled := Fa lse;
  12794  
  12795     Contexto rChangeMes sage := 'Y ou are vie wing/chang ing a 7131  request.   If you co ntinue, yo u will los e your wor k.';
  12796     CCOWBrea kLink := T rue;
  12797     Try
  12798     frmView7 131.CheckB ox1.Setfoc us Except
  12799     End;
  12800     frmView7 131.ShowMo dal;
  12801     frmView7 131.releas e;
  12802     frmView7 131 := Nil ;
  12803     Contexto rChangeMes sage := '' ;
  12804     CCOWBrea kLink := F alse;
  12805  
  12806     SeventyO ne31Reques tRefreshCl ick(Applic ation);
  12807  
  12808     if ESSOV ersion the n
  12809       BitBtn VistA.enab led := Tru e;                                                     //only rem ote connec tions - rp m 3/17/09
  12810     If ReadO nlyMode =  False Then
  12811       btnAdd Request.En abled := T rue;
  12812     If fmExa mRequestLi stbox.Item Index > -1  Then
  12813     Begin
  12814       btnVie wExam.Enab led := Tru e;
  12815       btnExa mFinalRepo rt.Enabled  := True;
  12816       btnGen erateRepor t.Enabled  := True;
  12817     End;
  12818   End;
  12819  
  12820   Procedure  TfrmMain.F MSeventyOn e31Request ListboxCli ck(Sender:  TObject);
  12821   Begin
  12822     If FMSev entyOne31R equestList box.ItemIn dex > -1 T hen
  12823     Begin
  12824       btnVie w7131.Enab led := Tru e;
  12825       btnGen erate7131R eport.Enab led := Tru e;
  12826     End;
  12827   End;
  12828  
  12829   Procedure  TfrmMain.F MSeventyOn e31Request ListboxDra wItem(
  12830     Control:  TWinContr ol; Index:  Integer;  Rect: TRec t;
  12831     State: T OwnerDrawS tate);
  12832   Begin
  12833     If FMSev entyOne31R equestList box.ItemIn dex > -1 T hen
  12834     Begin
  12835       btnVie w7131.Enab led := Tru e;
  12836       btnGen erate7131R eport.enab led := tru e;
  12837     End
  12838     Else
  12839     Begin
  12840       btnVie w7131.Enab led := Fal se;
  12841       btnGen erate7131R eport.enab led := tru e;
  12842     End;
  12843   End;
  12844  
  12845   Procedure  TfrmMain.B utton9Clic k(Sender:  TObject);
  12846   Begin
  12847     (*
  12848       If (Da teTimePick er1.Text=' ') or (ORD ateBox2.Te xt='') the n begin
  12849         Show MessageCAP RI('Please  enter bot h a start  and stop d ate.');
  12850         exit ;
  12851       end;
  12852     *)
  12853   End;
  12854  
  12855   Procedure  TfrmMain.F MRegionalO fficeNumbe rExit(Send er: TObjec t);
  12856   Var
  12857     x: integ er;
  12858   Begin
  12859     If FMReg ionalOffic eNumber.Te xt = '' Th en
  12860       exit;
  12861     For x :=  0 To FMRe gionalOffi ceNumber.I tems.Count  - 1 Do
  12862       If Pos (uppercase (FMRegiona lOfficeNum ber.Text),  uppercase (FMRegiona lOfficeNum ber.Items[ x])) = 1 T hen
  12863       Begin
  12864         FMRe gionalOffi ceNumber.I temIndex : = x;
  12865       End;
  12866     If FMReg ionalOffic eNumber.It emIndex =  -1 Then
  12867     Begin
  12868       //Show MessageCAP RI('The Re gional Off ice you ha ve entered  is not in  the list. ');
  12869       FMRegi onalOffice Number.Tex t := '';
  12870       Try
  12871       FMRegi onalOffice Number.Set focus Exce pt
  12872       End;
  12873       exit;
  12874     End;
  12875     FMRegion alOfficeNu mberFake.T ext := FMR egionalOff iceNumber. Text;
  12876     (*
  12877       If frm Main.lstIn stitutions .Items.Cou nt>0 then
  12878         For  x:=0 to fr mMain.lstI nstitution s.Items.Co unt-1 do
  12879           If  Pos(FMReg ionalOffic eNumber.Te xt+'^',frm Main.lstIn stitutions .Items[x]) >0 then
  12880              frmNew7131 .FMRegiona lOfficeNum berFake.Te xt:='`'+Pi ece(frmMai n.lstInsti tutions.It ems[x],'^' ,4);
  12881     *)
  12882   End;
  12883  
  12884   Procedure  TfrmMain.S plitter3Mo ved(Sender : TObject) ;
  12885   Begin
  12886     PanelRep ortChoice2 .Left := S plitter3.L eft + 63;
  12887   End;
  12888  
  12889   Procedure  TfrmMain.b tnGenerate 7131Report Click(Send er: TObjec t);
  12890   Begin
  12891     If ANURe moteProced ureCallInP rogress =  True Then
  12892       exit;
  12893  
  12894     If btnGe nerate7131 report.Ena bled = Fal se Then
  12895     Begin
  12896       ShowMe ssageCAPRI ('There ar e no previ ous 7131 r equests on  file.  Th is report  cannot be  run.');
  12897       exit;
  12898     End;
  12899     If FMSev entyOne31R equestList box.ItemIn dex = -1 T hen
  12900     Begin
  12901       ShowMe ssageCAPRI ('Please s elect a 71 31 request s first.   This repor t cannot b e run.');
  12902       exit;
  12903     End;
  12904     frmMain. RPCBroker1 .Results.C lear;
  12905     RPCBroke r1.RemoteP rocedure : = 'DVBAB C HECK CREDE NTIALS';
  12906     RPCBroke r1.Call;
  12907     RPCBroke rCall;
  12908     Try
  12909       RPCBro ker1.Call;
  12910     Except
  12911       On EBr okerError  Do
  12912       Begin
  12913         ANUR emoteProce dureCallIn Progress : = False;
  12914         Anim ateLogo(Fa lse);
  12915         Stat usBarLoadP t.Caption  := 'RPC DV BAB CHECK  CREDENTIAL S could no t be acces sed!';
  12916         Stat usBarLoadP t.Repaint;
  12917         Appl ication.Pr ocessmessa ges;
  12918         Show MessageCAP RI('RPC DV BAB CHECK  CREDENTIAL S could no t be acces sed!');
  12919       End;
  12920     End;
  12921     If RPCBr oker1.Resu lts[0] <>  '[OK]' The n
  12922     Begin
  12923       ShowMe ssageCAPRI (RPCBroker 1.Results[ 0]);
  12924       applic ation.term inate;
  12925       Exit;
  12926     End;
  12927     // Set u p form
  12928     RPCBroke r1.RemoteP rocedure : = 'DVBAB R EPORT 7131 INQ';
  12929     RPCBroke r1.Param[0 ].Value :=  PatientIE N;
  12930     RPCBroke r1.Param[0 ].PType :=  literal;
  12931     RPCBroke r1.Param[1 ].Value :=  FMSeventy One31Reque stListbox. GetSelecte dRecord.IE N;
  12932     RPCBroke r1.Param[1 ].PType :=  literal;
  12933     RPCBroke rCall;
  12934     Try
  12935       RPCBro ker1.Call;
  12936     Except
  12937       On EBr okerError  Do
  12938       Begin
  12939         ANUR emoteProce dureCallIn Progress : = False;
  12940         Anim ateLogo(Fa lse);
  12941         Stat usBarLoadP t.Caption  := 'RPC DV BAB REPORT  7131INQ c ould not b e accessed !';
  12942         Stat usBarLoadP t.Repaint;
  12943         Appl ication.Pr ocessmessa ges;
  12944         Show MessageCAP RI('Connec tion to se rver for D VBAB REPOR T 7131INQ  could not  be establi shed!');
  12945       End;
  12946     End;
  12947     ReportMe mo.Lines.C lear;
  12948     If frmMa in.RPCBrok er1.Result s.Count >  0 Then
  12949     Begin
  12950       Repeat
  12951         Begi n
  12952           Sc reen.Curso r := crHou rglass;
  12953           If  Pos('^',  frmMain.RP CBroker1.R esults[0])  > 0 Then
  12954           Be gin
  12955              ReportMemo .Lines.Add (Copy(frmM ain.RPCBro ker1.Resul ts[0], 1,  Pos('^', f rmMain.RPC Broker1.Re sults[0])  - 1));
  12956              frmMain.RP CBroker1.R esults[0]  := Copy(fr mMain.RPCB roker1.Res ults[0], P os('^', fr mMain.RPCB roker1.Res ults[0]) +  1, Length (frmMain.R PCBroker1. Results[0] ));
  12957           En d
  12958           El se
  12959           Be gin
  12960              ReportMemo .Lines.Add (frmMain.R PCBroker1. Results[0] );
  12961              frmMain.RP CBroker1.R esults[0]  := '';
  12962           En d;
  12963       End Un til frmMai n.RPCBroke r1.Results [0] = '';
  12964       //If R eportMemo. Lines.Coun t>0 then b egin
  12965       //  Re portMemo.L ines.Add(C opy(Report Memo.Lines [ReportMem o.Lines.Co unt-1],Pos ('Requeste d by:',Rep ortMemo.Li nes[Report Memo.Lines .Count-1]) ,999));
  12966       //  Re portMemo.L ines[Repor tMemo.Line s.Count-2] :=Copy(Rep ortMemo.Li nes[Report Memo.Lines .Count-2], 1,Pos('Dat e of Reque st:',Repor tMemo.Line s[ReportMe mo.Lines.C ount-2])+1 5)+' '+Pie ce(FMSeven tyOne31Req uestListbo x.Items[FM SeventyOne 31RequestL istbox.Ite mIndex],'@ ',1);
  12967       //end;
  12968       Screen .Cursor :=  crDefault ;
  12969     End;
  12970     ORReport sAvailable .ItemIndex  := 3;
  12971     Page95Co ntrol1.Act ivePage :=  TabReport s
  12972   End;
  12973  
  12974   Procedure  TfrmMain.b tnGenerate ReportClic k(Sender:  TObject);
  12975   Begin
  12976     If ANURe moteProced ureCallInP rogress =  True Then
  12977       exit;
  12978  
  12979     If FMExa mRequestLi stBox.Item Index = -1  Then
  12980       exit;
  12981     frmMain. RPCBroker1 .Results.C lear;
  12982     RPCBroke r1.RemoteP rocedure : = 'DVBAB C HECK CREDE NTIALS';
  12983     RPCBroke rCall;
  12984     Try
  12985       RPCBro ker1.Call;
  12986     Except
  12987       On EBr okerError  Do
  12988       Begin
  12989         ANUR emoteProce dureCallIn Progress : = False;
  12990         Anim ateLogo(Fa lse);
  12991         Stat usBarLoadP t.Caption  := 'RPC DV BAB CHECK  CREDENTIAL S could no t be acces sed!';
  12992         Stat usBarLoadP t.Repaint;
  12993         Appl ication.Pr ocessmessa ges;
  12994         Show MessageCAP RI('RPC DV BAB CHECK  CREDENTIAL S could no t be acces sed!');
  12995       End;
  12996     End;
  12997     If RPCBr oker1.Resu lts[0] <>  '[OK]' The n
  12998     Begin
  12999       ShowMe ssageCAPRI (RPCBroker 1.Results[ 0]);
  13000       applic ation.term inate;
  13001       Exit;
  13002     End;
  13003     // Set u p form
  13004     RPCBroke r1.RemoteP rocedure : = 'DVBAB R EPORT CPDE TAILS';
  13005     RPCBroke r1.Param[0 ].Value :=  PatientIE N;
  13006     RPCBroke r1.Param[0 ].PType :=  literal;
  13007     RPCBroke r1.Param[1 ].Value :=  FMExamReq uestListbo x.GetSelec tedRecord. IEN;
  13008     RPCBroke r1.Param[1 ].PType :=  literal;
  13009     RPCBroke rCall;
  13010     Try
  13011       RPCBro ker1.Call;
  13012     Except
  13013       On EBr okerError  Do
  13014       Begin
  13015         ANUR emoteProce dureCallIn Progress : = False;
  13016         Anim ateLogo(Fa lse);
  13017         Stat usBarLoadP t.Caption  := 'RPC DV BAB REPORT  CPDETAILS  could not  be access ed!';
  13018         Stat usBarLoadP t.Repaint;
  13019         Appl ication.Pr ocessmessa ges;
  13020         Show MessageCAP RI('Connec tion to se rver for D VBAB REPOR T CPDETAIL S could no t be estab lished!');
  13021       End;
  13022     End;
  13023  
  13024     //Build  Report
  13025     StatusBa rLoadPt.Ca ption := ' Downloadin g report.' ;
  13026     StatusBa rLoadPt.Re paint;
  13027     Applicat ion.Proces smessages;
  13028     ANURemot eProcedure CallInProg ress := tr ue;
  13029     ReportMe mo.Lines.C lear;
  13030     screen.c ursor := c rHourglass ;
  13031  
  13032     ReportMe mo.SetSelT extBuf(RPC Broker1.Re sults.GetT ext);
  13033  
  13034     screen.c ursor := c rDefault;
  13035     ReportMe mo.Visible  := True;
  13036     ANURemot eProcedure CallinProg ress := Fa lse;
  13037     AnimateL ogo(False) ;
  13038     StatusBa rLoadPt.Ca ption := ' Ready.';
  13039     StatusBa rLoadPt.Re paint;
  13040     Applicat ion.Proces smessages;
  13041     //End Of  Build Rep ort
  13042     ORReport sAvailable .ItemIndex  := 2;
  13043     ReportMe mo.SelStar t := 0;
  13044     ReportMe mo.SelLeng th := 0;
  13045     Page95Co ntrol1.Act ivePage :=  TabReport s;
  13046     Try
  13047     ReportMe mo.SetFocu s Except
  13048     End;
  13049   End;
  13050  
  13051   Procedure  TfrmMain.P age95Contr ol1Change( Sender: TO bject);
  13052   Var
  13053     x: integ er;
  13054     StationN o: String;                                                                   //required  for Local  FHIE conn ections
  13055     CenterWi dth : Inte ger;                                                              // Patch19 7 JRL - re sizing VR  display  
  13056   Begin
  13057     ReverseE xamRequest SortOrder  := False;                                              // CodeCR7 08 rpk 8/2 7/2015
  13058   //  Revers eAdminSort Order := F alse;                                                    // CodeC R708 rpk 8 /27/2015
  13059  
  13060   //  if Pag e95Control 1.ActivePa ge = Admin Documents  then                               // CodeC R708 rpk 8 /27/2015
  13061   //    btnS ortAdmin.C aption :=  'Sort Olde st on top  ^';                                // CodeC R708 rpk 8 /27/2015
  13062  
  13063     StationN o := '';
  13064  
  13065     // Patch  193 - Rem ove DoD ta b and asso ciated cod e once Pat ch 193 is  installed  JRL 7/20/1 6
  13066     If IsPat chInstalle d('DVBA*2. 7*193') th en
  13067       TabDOD .Enabled : = FALSE  / / Patch 19 3 and late r
  13068     else
  13069       TabDOD .Enabled : = True;    // Patch 1 92 and ear lier                             // DoD tab  is someti mes greyin g out.  Th is forces  it to norm al.
  13070     
  13071     SetFont;                                                                              // Force u pdate of f ont just i n case
  13072     frmMain. FormResize (Applicati on);
  13073  
  13074     If Page9 5Control1. ActivePage  = TabCPEx ams Then
  13075     Begin
  13076       cbxSor tExamReq.I temIndex : = 0;                                                   // CodeCR7 08 rpk 8/2 7/2015
  13077       ExamRe questRefre shClick(Ap plication) ;
  13078     End;
  13079  
  13080     If Page9 5Control1. ActivePage  = Tab7131 Request Th en
  13081     Begin
  13082       If FMS eventyOne3 1RequestLi stbox.Item Index = -1  Then
  13083       Begin
  13084         btnG enerate713 1report.En abled := F alse;
  13085         btnV iew7131.En abled := F alse;
  13086       End
  13087       Else
  13088       Begin
  13089         btnG enerate713 1report.En abled := T rue;
  13090         btnV iew7131.En abled := T rue;
  13091       End;
  13092     End;
  13093  
  13094     If Page9 5Control1. ActivePage  = TabCPWo rksheets T hen
  13095     Begin
  13096       Button IPRRefresh Click(Appl ication);
  13097     End;
  13098  
  13099     If Page9 5Control1. ActivePage  = TabHeal thSummarie s Then
  13100     Begin
  13101       If ESS OVersion =  True Then
  13102         butt onRDV.Enab led := Fal se;
  13103     End;
  13104  
  13105     If Page9 5Control1. ActivePage  = TabClin icalDocume nts Then
  13106     Begin
  13107       // -ME R CodeCR17 7 3/2011 r estore the  tabs with  hotkeys
  13108       Tab95C ontrol1.Ta bs.Clear;
  13109       Tab95C ontrol1.Ta bs.Add('&1 )  Notes') ;
  13110       Tab95C ontrol1.Ta bs.Add('&2 )  Dischar ge Summari es');
  13111       Tab95C ontrol1.Ta bs.Add('&3 )  Consult s');
  13112       Tab95C ontrol1.Ta bs.Add('&4 )  Vitals' );
  13113       Tab95C ontrol1.Ta bs.Add('&5 )  Meds');
  13114       Tab95C ontrol1.Ta bs.Add('&6 )  Labs');
  13115       Tab95C ontrol1.Ta bs.Add('&7 )  Imaging ');
  13116       Tab95C ontrol1.Ta bs.Add('&8 )  Diet');
  13117       Tab95C ontrol1.Ta bs.Add('&9 )  Nutriti onal Asses sment');
  13118       Tab95C ontrol1.Ta bs.Add('&U )  Order S ummary');
  13119       Tab95C ontrol1.Ta bs.Add('&Y )  Procedu res');
  13120       Tab95C ontrol1.Ta bs.Add('&Z )  Problem  List');
  13121  
  13122       If Tab 95Control1 .TabIndex  < 0 Then
  13123         Tab9 5Control1. TabIndex : = 0;
  13124       Tab95C ontrol1Cha nge(Applic ation);
  13125       If Scr eenReaderA ctive = Tr ue Then
  13126         Page 95Control1 .SetFocus;
  13127     end else  begin
  13128       // -ME R CodeCR17 7 3/2011 C lear the t abs with h otkeys so  they won't  trap keys trokes
  13129       Tab95C ontrol1.Ta bs.Clear;
  13130     end;
  13131  
  13132     If Page9 5Control1. ActivePage  <> TabCli nicalDocum ents Then
  13133     Begin
  13134       If For mReportBui lder <> Ni l Then
  13135         Form ReportBuil der.Hide;
  13136     End;
  13137  
  13138     If Page9 5Control1. ActivePage  = TabVist AWeb Then
  13139     Begin
  13140       If Vis tAWebLoade d <> True  Then
  13141       Begin
  13142         btnV istAWebHom eClick(App lication);
  13143         Vist AWebLoaded  := True;
  13144       End;
  13145     End;
  13146  
  13147  
  13148     // Patch  193 - Rem ove DoD ta b and asso ciated cod e once Pat ch 193 is  installed  JRL 7/20/1 6
  13149     If not I sPatchInst alled('DVB A*2.7*193' ) then
  13150     begin //  Patch 192  and earli er
  13151       If Pag e95Control 1.ActivePa ge = TabDO D Then
  13152       Begin
  13153         Pane lDODGrids. Visible :=  False;
  13154         If T abDOD.enab led = Fals e Then
  13155           ex it;
  13156         If L abelDoDInf o.Caption  = '** NOT  CONNECTED  **' Then
  13157         Begi n
  13158           An imateLogo( True);
  13159           St atusBarLoa dPt.Captio n := 'Popu lating DoD  tab.';
  13160           St atusBarLoa dPt.Repain t;
  13161           Ap plication. Processmes sages;
  13162           // Set DOD Br oker divis ion and ge t BSE toke n from hom e server
  13163           RP CBrokerDOD .ANUstrDiv isionHome  := RPCBrok er1.ANUstr DivisionHo me;
  13164           RP CBrokerDOD .Connect2H omeServer( RPCBroker1 .ANUAccess CodeHome,
  13165              RPCBroker1 .ANUVerify CodeHome,
  13166              RPCBroker1 .ANUstrSer verHome,
  13167              RPCBroker1 .ANUstrPor tHome,
  13168              False);
  13169           if  NOT RPCBr okerDOD.Cr eateContex t('DVBA CA PRI GUI')  then
  13170           be gin
  13171              ShowMessag eCAPRI('Co uld not us e option " DVBA CAPRI  GUI!"');
  13172              applicatio n.terminat e;
  13173           en d;
  13174       
  13175           RP CBrokerDOD .ANUFHIECo nnection : = True;
  13176           // determine  station nu mber requi red for lo cal FHIE c onnections ;
  13177           //  short-cir cuit when  no station  number
  13178           if  NOT ESSOV ersion the n
  13179           be gin
  13180              StationNo  := Piece(G etDivision (ESSOVersi on, RPCBro kerDOD), ' ^', 3);
  13181              if Station No = '' th en
  13182              begin
  13183                RPCBroke rDOD.ANUFH IEConnecti on := Fals e;
  13184                RPCBroke rDOD.Conne cted := Fa lse;
  13185                ShowMess ageCapri(' Could not  determine  local stat ion number  for FHIE  connection .');
  13186                Exit;
  13187              end;
  13188           en d;
  13189           RP CBrokerDOD .Connected  := False;
  13190           sl eep(1000);
  13191           RP CBrokerDOD .RPCTimeLi mit := 288 00;
  13192           RP CBrokerDOD .Server :=  Piece(FHI ESiteLocat ion, ',',  1);
  13193           RP CBrokerDOD .ListenerP ort := Str toInt(Piec e(FHIESite Location,  ',', 2));
  13194           RP CBrokerDOD .ANUUserSp ecs :=
  13195              AuthorSSN  + '^' +
  13196              AuthorName  + '^' +
  13197              UserDivisi on + '^' +                                                          // Site
  13198              UserDivisi onNumber +  '^' +                                                   // Site  num
  13199              AuthorIEN;
  13200  
  13201           // connect to  remote se rver with  BSE token
  13202           if  NOT RPCBr okerDOD.Co nnect2Remo teServer(R PCBrokerDO D.Server,
  13203              IntToStr(R PCBrokerDO D.Listener Port),
  13204              False, Tru e, Station No) then
  13205           be gin
  13206              AnimateLog o(False);
  13207              RPCBrokerD OD.Connect ed := Fals e;
  13208              StatusBarL oadPt.Capt ion := 'FH IE Server  unavailabl e.';
  13209              StatusBarL oadPt.Repa int;
  13210              Applicatio n.Processm essages;
  13211              RPCBrokerD OD.Connect ed := Fals e;
  13212              ShowMessag eCAPRI('FH IE Server  cannot be  accessed!' );
  13213              //RPCBroke r1.Connect ed := true ; BSE mod  - replace  with conne cttoserver
  13214              if NOT RPC Broker1.Co nnected th en
  13215                ConnectT oServer('D VBA CAPRI  GUI');
  13216              RPCBrokerD OD.Connect ed := Fals e;
  13217              ESSOConnec ting := Tr ue;
  13218              exit;
  13219           en d;
  13220  
  13221           If  Not RPCBr okerDOD.Cr eateContex t('DVBA CA PRI GUI')  Then
  13222           Be gin
  13223              ShowMessag eCAPRI('Co uld not us e option " DVBA CAPRI  GUI!"');
  13224              applicatio n.terminat e;
  13225           En d;
  13226  
  13227           // LoadTypesF romServer
  13228           RP CBrokerDOD .RemotePro cedure :=  'DVBAB DOD  REPORT TY PES';
  13229           RP CBrokerDOD Call;
  13230           Tr y
  13231              RPCBrokerD OD.Call;
  13232           Ex cept
  13233              On EBroker Error Do
  13234              Begin
  13235                ANURemot eProcedure CallInProg ress := Fa lse;
  13236                AnimateL ogo(False) ;
  13237                StatusBa rLoadPt.Ca ption := ' RPC DVBAB  DOD REPORT  TYPES cou ld not be  accessed!' ;
  13238                StatusBa rLoadPt.Re paint;
  13239                Applicat ion.Proces smessages;
  13240                ShowMess ageCAPRI(' DVBAB DOD  REPORT TYP ES could n ot be acce ssed!');
  13241              End;
  13242           En d;
  13243           OR ListBoxDOD ReportType s.Items :=  RPCBroker DOD.Result s;
  13244           St atusBarLoa dPt.Captio n := 'Gett ing info m essage.';
  13245           St atusBarLoa dPt.Repain t;
  13246           Ap plication. Processmes sages;
  13247           RP CBrokerDOD .RemotePro cedure :=  'DVBAB DOD  INFO';
  13248           RP CBrokerDOD Call;
  13249           Tr y
  13250              RPCBrokerD OD.Call;
  13251           Ex cept
  13252              On EBroker Error Do
  13253              Begin
  13254                ANURemot eProcedure CallInProg ress := Fa lse;
  13255                AnimateL ogo(False) ;
  13256                StatusBa rLoadPt.Ca ption := ' RPC DVBAB  DOD INFO c ould not b e accessed !';
  13257                StatusBa rLoadPt.Re paint;
  13258                Applicat ion.Proces smessages;
  13259                ShowMess ageCAPRI(' DVBAB DOD  INFO could  not be ac cessed!');
  13260                RPCBroke rDOD.Conne cted := Fa lse;
  13261                RPCBroke rDOD.ANUFH IEConnecti on := Fals e;
  13262                RPCBroke rDOD.Conne cted := Fa lse;
  13263                ESSOConn ecting :=  True;
  13264                exit;
  13265              End;
  13266           En d;
  13267           La belDoDInfo .Caption : = RPCBroke rDOD.Resul ts[0];
  13268  
  13269           sc reen.curso r := crHou rglass;
  13270           RP CBrokerDOD .Connected  := False;
  13271           sl eep(1000);
  13272  
  13273           ES SOConnecti ng := True ;
  13274           Fo r x := 1 T o 500 Do
  13275              applicatio n.processm essages;
  13276  
  13277           //  The follo wing code  was change d because  Togus was  locking af ter an FHI E call
  13278  
  13279           RP CBroker1.C onnected : = False;
  13280           sl eep(1000);
  13281           // RPCBroker1 .Connected  := true;   BSE mod -  rpm 3/16/ 09
  13282           If  Not Conne ctToServer ('DVBA CAP RI GUI') T hen
  13283           Be gin
  13284              ShowMessag eCAPRI('DO D1: Could  not use op tion "DVBA  CAPRI GUI !"');
  13285              applicatio n.terminat e;
  13286           En d;
  13287           If  RPCBroker 1.Connecte d = False  Then
  13288           Be gin
  13289              ShowMessag eCAPRI('DO D2: Could  not use op tion "DVBA  CAPRI GUI !"');
  13290              applicatio n.terminat e;
  13291           En d;
  13292  
  13293           Sc reen.curso r := crDef ault;
  13294  
  13295           ES SOConnecti ng := Fals e;
  13296  
  13297         //// ////////// ////////// ////////// ////////// ////////// ////////// ////////// ////
  13298  
  13299           St atusBarLoa dPt.Captio n := 'Read y.';
  13300           St atusBarLoa dPt.Repain t;
  13301           Ap plication. Processmes sages;
  13302         End;
  13303         Rich EditDODRep ort.Lines. Clear;
  13304         Pane lDODGrids. Visible :=  False;
  13305         ORLi stBoxDODRe portTypes. ItemIndex  := -1;
  13306         Anim ateLogo(Fa lse);
  13307         RPCB rokerDOD.A NUFHIEConn ection :=  False;
  13308       End;
  13309  
  13310     end;  
  13311     
  13312     RPCBroke rDOD.ANUFH IEConnecti on := Fals e;
  13313     If Page9 5Control1. ActivePage  = TabVocR ehab Then                                   //CodeCR34 7 - jrl 5/ 22/12
  13314     Begin                                                                                 //CodeCR34 7 - jrl 5/ 22/12
  13315       // cre ate VocReh ab class i f not done  already          //C odeCR347 -  jrl 5/22/ 12
  13316       if not  Assigned( VocRehab)  then                                                   //CodeCR34 7 - jrl 5/ 22/12
  13317         VocR ehab := TV ocRehab.Cr eate;                                                  //CodeCR34 7 - jrl 5/ 22/12
  13318       // Set up the Med ical Servi ces Reques t list for  display o n VocRehab  tab  //Co deCR347 -  jrl 5/22/1 2
  13319       VocReh ab.SetupMe dicalServi cesList;                                               //CodeCR34 7 - jrl 5/ 22/12
  13320  
  13321       //VocR ehab tab -  Added res izing Patc h197 JRL 2 /2/17
  13322       Center Width := p nlVocRehab .Width div  2;
  13323       btnVRA ddNewReque st.Top :=  pnlVocReha b.Height -  50;
  13324       btnVRA ddNewReque st.Left :=  CenterWid th - 100 -  btnVRAddN ewRequest. Width;
  13325       btnVRE ditRequest .Top := pn lVocRehab. Height - 5 0;
  13326       btnVRE ditRequest .Left := C enterWidth  + 100;
  13327       lbVocR ehab.Heigh t := pnlVo cRehab.Hei ght - 145;
  13328       edtHea der.Left : = CenterWi dth - (edt Header.Wid th div 2);
  13329       lbVocR ehab.Left  := CenterW idth - (lb VocRehab.W idth div 2 );
  13330       edtCol umnHeader. Left := lb VocRehab.L eft + 7;
  13331                                       
  13332       if VAU tils.Scree nReaderAct ive then
  13333       begin
  13334         edtH eader.TabS top := TRU E;
  13335         edtC olumnHeade r.TabStop  := TRUE;
  13336         edtH eader.SetF ocus;
  13337       end
  13338       else
  13339       begin
  13340         edtH eader.TabS top := FAL SE;
  13341         edtC olumnHeade r.TabStop  := FALSE;
  13342         lbVo cRehab.Set Focus;                                                            //CodeCR34 7 - jrl 5/ 22/12
  13343       end;
  13344  
  13345       if lbV ocRehab.It emIndex <>  -1 then                                               //CodeCR34 7 - jrl 5/ 22/12
  13346         btnV REditReque st.Enabled  := TRUE;                                              //CodeCR34 7 - jrl 5/ 22/12
  13347     End;                                                                                  //CodeCR34 7 - jrl 5/ 22/12
  13348  
  13349   End;
  13350  
  13351   Procedure  TfrmMain.T ab95Contro l1Change(S ender: TOb ject);
  13352   Var
  13353     x: integ er;
  13354     authornt : String;
  13355     typ, sta t: String;
  13356   Begin
  13357     If ANURe moteProced ureCallInP rogress =  True Then
  13358       exit;
  13359  
  13360     Page95Co ntrol1.Ena bled := Fa lse;                                                   //CodeCR32 4 - rpm 3/ 6/12
  13361     Tab95Con trol1.Enab led := Fal se;
  13362     buttonCl inDocDateR ange.Enabl ed := True ;
  13363     LabelDoc sFound.Cap tion := '' ;
  13364     buttonCl inDocDateR ange.Visib le := True ;
  13365     LabelCur rentView.V isible :=  True;
  13366     Division Run := Fal se;
  13367     AnimateL ogo(True);
  13368     StatusBa rLoadPt.Ca ption := ' Re-populat ing choice s...';
  13369     StatusBa rLoadPt.Re paint;
  13370     Applicat ion.Proces smessages;
  13371     lstDocs. Visible :=  True;
  13372     LastSear ch := '';                                                                    //CodeCR34 0 - jrl 5/ 01/12
  13373     editSear chPN.Text  := '';                                                            //CodeCR34 0 - jrl 5/ 01/12
  13374     If Tab95 Control1.T abs[Tab95C ontrol1.Ta bIndex] =  '&1)  Note s' Then
  13375     Begin
  13376       If For mReportBui lder <> Ni l Then
  13377         form ReportBuil der.ORAlig nButtonAdd All.Enable d := True;
  13378       btnDiv isions.Ena bled := Tr ue;
  13379       button ClinDocDat eRange.Vis ible := Tr ue;
  13380       Splitt er2.Visibl e := True;
  13381       PanelC ount.Visib le := True ;
  13382       PanelG raphVS.Vis ible := Fa lse;
  13383       PanelS earch.Visi ble := Tru e;
  13384       DocTyp e := 'PN';
  13385       memoDo cs.Lines.C lear;
  13386       LstDoc s.Items.Cl ear;
  13387       //frmM ain.RPCBro ker1.Resul ts.Clear;
  13388       RPCBro ker1.Remot eProcedure  := 'TIU D OCUMENTS B Y CONTEXT' ;
  13389       RPCBro ker1.Param [1].Value  := '3';                                                // 3= Prog ress Notes
  13390       RPCBro ker1.Param [1].PType  := literal ;
  13391       RPCBro ker1.Param [3].Value  := Patient IEN;                                        // Patient  IEN
  13392       RPCBro ker1.Param [3].PType  := literal ;
  13393       If Cli nDocDateRa ngeSelecte d = true T hen
  13394       Begin
  13395         // - MER CodeCR 122 9/2010
  13396         RPCB roker1.Par am[4].Valu e := FMToD ateConvert (FormatDat eTime('mm/ dd/yyyy',  FormDateRa nge.dtpSta rtDate.Dat e)); // st art date
  13397         RPCB roker1.Par am[4].PTyp e := liter al;
  13398         RPCB roker1.Par am[5].Valu e := FMToD ateConvert (FormatDat eTime('mm/ dd/yyyy',  FormDateRa nge.dtpEnd Date.Date) ); // end  date
  13399         RPCB roker1.Par am[5].PTyp e := liter al;
  13400         RPCB roker1.Par am[2].Valu e := '5';                                              // By date  range
  13401         RPCB roker1.Par am[2].PTyp e := liter al;
  13402         //12 88683 rra  remove siz e restrict ion on dat e searches   Patch 19 3 6/20/16
  13403         RPCB roker1.Par am[7].Valu e := IntTo Str(32767) ;  //
  13404         RPCB roker1.Par am[7].PTyp e := liter al;    End    //
  13405       Else
  13406       Begin
  13407         RPCB roker1.Par am[4].Valu e := '-1';                                             // Date Ra nge
  13408         RPCB roker1.Par am[4].PTyp e := liter al;
  13409         RPCB roker1.Par am[5].Valu e := '-1';                                             // Date Ra nge
  13410         RPCB roker1.Par am[5].PTyp e := liter al;
  13411         RPCB roker1.Par am[2].Valu e := '1';                                              // All sig ned Docume nts
  13412         RPCB roker1.Par am[2].PTyp e := liter al;
  13413         //12 88683 rra  moved size  restricte d code ins ide else l oop  Patch  193 6/20/ 16
  13414         RPCB roker1.Par am[7].Valu e := IntTo Str(Number ClinDocsTo Retrieve);  //
  13415         RPCB roker1.Par am[7].PTyp e := liter al;                               //
  13416       End;
  13417       RPCBro ker1.Param [6].Value  := AuthorI EN;                                         // AuthorI EN;
  13418       RPCBro ker1.Param [6].PType  := literal ;
  13419   //  RPCBro ker1.Param [7].Value  := IntToSt r(NumberCl inDocsToRe trieve);   // rra 128 8683
  13420   //  RPCBro ker1.Param [7].PType  := literal ;                                // rra 128 8683
  13421       RPCBro ker1.Param [8].Value  := 'D';
  13422       RPCBro ker1.Param [8].PType  := literal ;
  13423       RPCBro ker1.Param [9].Value  := '1';
  13424       RPCBro ker1.Param [9].PType  := literal ;
  13425  
  13426       RPCBro kerCall;
  13427       Try
  13428         RPCB roker1.Cal l;
  13429       Except
  13430         On E BrokerErro r Do
  13431         Begi n
  13432           AN URemotePro cedureCall InProgress  := False;
  13433           An imateLogo( False);
  13434           St atusBarLoa dPt.Captio n := 'RPC  TIU DOCUME NTS BY CON TEXT could  not be ac cessed!';
  13435           St atusBarLoa dPt.Repain t;
  13436           Ap plication. Processmes sages;
  13437           Sh owMessageC APRI('RPC  TIU DOCUME NTS BY CON TEXT could  not be ac cessed!');
  13438         End;
  13439       End;
  13440       listDo cs.Clear;
  13441       If RPC Broker1.Re sults.Coun t > 0 Then
  13442         For  x := 0 To  RPCBroker1 .Results.C ount - 1 D o
  13443           li stDocs.add (RPCBroker 1.Results[ x]);
  13444       If Lis tDocs.Coun t > 0 Then
  13445         For  x := 0 To  ListDocs.C ount - 1 D o
  13446         Begi n
  13447           Au thorNT :=  Piece(list docs[x], ' ^', 5);
  13448           Au thorNT :=  Copy(Autho rNT, pos(' ;', Author NT) + 1, 9 9);
  13449           ls tDocs.Item s.Add(FMDa teTimeConv ert(Piece( listdocs[x ], '^', 3) ) + ', ' +  Piece(lis tdocs[x],  '^', 2) +  ', ' + aut hornt + ',  ' + Piece (listdocs[ x], '^', 7 ) + ' ^' +  Piece(lis tdocs[x],  '^', 1));
  13450         End;
  13451       If Lis tDocs.Coun t = 0 Then
  13452       Begin
  13453         Memo Docs.Lines .Add('');
  13454         Memo Docs.Lines .Add('No p rogress no tes found. ');
  13455       End;
  13456  
  13457       If (Sc reenReader Active = F alse) and  IsSetFocus Valid(lstD ocs) Then
  13458         lstD ocs.SetFoc us;
  13459  
  13460       If lst Docs.Items .Count > 0  Then
  13461       Begin
  13462         lstD ocs.ItemIn dex := 0;
  13463         lstD ocs.Select ed[0] := T RUE;                                                   //-MER Cod eCR126 7/2 010
  13464         lstD ocsClick(A pplication );
  13465       End;
  13466     End;
  13467     If Tab95 Control1.T abs[Tab95C ontrol1.Ta bIndex] =  '&2)  Disc harge Summ aries' The n
  13468     Begin
  13469       If For mReportBui lder <> Ni l Then
  13470         form ReportBuil der.ORAlig nButtonAdd All.Enable d := True;
  13471       button ClinDocDat eRange.Vis ible := Tr ue;
  13472       Splitt er2.Visibl e := True;
  13473       PanelC ount.Visib le := Fals e;
  13474       PanelG raphVS.Vis ible := Fa lse;
  13475       PanelS earch.Visi ble := Tru e;
  13476       DocTyp e := 'DS';
  13477       memoDo cs.Lines.C lear;
  13478       LstDoc s.Items.Cl ear;
  13479       frmMai n.RPCBroke r1.Results .Clear;
  13480       RPCBro ker1.Remot eProcedure  := 'TIU D OCUMENTS B Y CONTEXT' ;
  13481       RPCBro ker1.Param [1].Value  := '244';                                              // 244= Di scharge Su mmaries
  13482       RPCBro ker1.Param [1].PType  := literal ;
  13483       RPCBro ker1.Param [3].Value  := Patient IEN;                                        // Patient  IEN
  13484       RPCBro ker1.Param [3].PType  := literal ;
  13485       If Cli nDocDateRa ngeSelecte d = true T hen
  13486       Begin
  13487         // - MER CodeCR 122 9/2010
  13488         RPCB roker1.Par am[4].Valu e := FMToD ateConvert (FormatDat eTime('mm/ dd/yyyy',  FormDateRa nge.dtpSta rtDate.Dat e)); // st art date
  13489         RPCB roker1.Par am[4].PTyp e := liter al;
  13490         RPCB roker1.Par am[5].Valu e := FMToD ateConvert (FormatDat eTime('mm/ dd/yyyy',  FormDateRa nge.dtpEnd Date.Date) ); // end  date
  13491         RPCB roker1.Par am[5].PTyp e := liter al;
  13492         RPCB roker1.Par am[2].Valu e := '5';                                              // By date  range
  13493         RPCB roker1.Par am[2].PTyp e := liter al;
  13494       End
  13495       Else
  13496       Begin
  13497         RPCB roker1.Par am[4].Valu e := '0';                                              // Date Ra nge
  13498         RPCB roker1.Par am[4].PTyp e := liter al;
  13499         RPCB roker1.Par am[5].Valu e := '0';                                              // Date Ra nge
  13500         RPCB roker1.Par am[5].PTyp e := liter al;
  13501         RPCB roker1.Par am[2].Valu e := '1';                                              // All sig ned Docume nts
  13502         RPCB roker1.Par am[2].PTyp e := liter al;
  13503       End;
  13504       RPCBro ker1.Param [6].Value  := AuthorI EN;                                         // AuthorI EN;
  13505       RPCBro ker1.Param [6].PType  := literal ;
  13506       RPCBro ker1.Param [7].Value  := '999999 9';
  13507       RPCBro ker1.Param [7].PType  := literal ;
  13508       RPCBro ker1.Param [8].Value  := 'D';
  13509       RPCBro ker1.Param [8].PType  := literal ;
  13510       Try
  13511         RPCB roker1.Cal l;
  13512       Except
  13513         On E BrokerErro r Do
  13514         Begi n
  13515           AN URemotePro cedureCall InProgress  := False;
  13516           An imateLogo( False);
  13517           St atusBarLoa dPt.Captio n := 'RPC  TIU DOCUME NTS BY CON TEXT could  not be ac cessed!';
  13518           St atusBarLoa dPt.Repain t;
  13519           Ap plication. Processmes sages;
  13520           Sh owMessageC APRI('RPC  TIU DOCUME NTS BY CON TEXT could  not be ac cessed!');
  13521         End
  13522       End;
  13523       listDo cs.Clear;
  13524       If RPC Broker1.Re sults.Coun t > 0 Then
  13525         For  x := 0 To  RPCBroker1 .Results.C ount - 1 D o
  13526           li stDocs.add (RPCBroker 1.Results[ x]);
  13527       If Lis tDocs.Coun t > 0 Then
  13528         For  x := 0 To  ListDocs.C ount - 1 D o
  13529         Begi n
  13530           Au thorNT :=  Piece(list docs[x], ' ^', 5);
  13531           Au thorNT :=  Copy(Autho rNT, pos(' ;', Author NT) + 1, 9 9);
  13532           ls tDocs.Item s.Add(FMDa teTimeConv ert(Piece( listdocs[x ], '^', 3) ) + ', ' +  Piece(lis tdocs[x],  '^', 2) +  ', ' + aut hornt + ',  ' + Piece (listdocs[ x], '^', 7 ) + ' ^' +  Piece(lis tdocs[x],  '^', 1));
  13533         End;
  13534       If Lis tDocs.Coun t = 0 Then
  13535       Begin
  13536         Memo Docs.Lines .Add('');
  13537         Memo Docs.Lines .Add('No d ischarge s ummaries f ound.');
  13538       End;
  13539       Try
  13540         If S creenReade rActive =  False Then
  13541       lstDoc s.SetFocus  Except
  13542       End;
  13543       If lst Docs.Items .Count > 0  Then
  13544       Begin
  13545         lstD ocs.ItemIn dex := 0;
  13546         lstD ocs.Select ed[0] := T RUE;                                                   //-MER Cod eCR126 7/2 010
  13547         lstD ocsClick(A pplication );
  13548       End;
  13549     End;
  13550     If Tab95 Control1.T abs[Tab95C ontrol1.Ta bIndex] =  '&3)  Cons ults' Then
  13551     Begin
  13552       If For mReportBui lder <> Ni l Then
  13553         form ReportBuil der.ORAlig nButtonAdd All.Enable d := True;
  13554       button ClinDocDat eRange.Vis ible := Tr ue;
  13555   //  Splitt er2.Visibl e := False ;
  13556       Splitt er2.Visibl e := True;                                                        //CodeCR69 6 JRL 4/8/ 15
  13557       PanelC ount.Visib le := Fals e;
  13558       PanelG raphVS.Vis ible := Fa lse;
  13559       PanelS earch.Visi ble := TRU E;                                                     //CodeCR69 6 JRL 4/8/ 15
  13560       DocTyp e := 'CN';
  13561       memoDo cs.Lines.C lear;
  13562       LstDoc s.Items.Cl ear;
  13563       frmMai n.RPCBroke r1.Results .Clear;
  13564       RPCBro ker1.Remot eProcedure  := 'ORQQC N LIST';
  13565       RPCBro ker1.Param [1].Value  := Patient IEN;                                        // Patient  IEN
  13566       RPCBro ker1.Param [1].PType  := literal ;
  13567       If Cli nDocDateRa ngeSelecte d = true T hen
  13568       Begin
  13569         // - MER CodeCR 122 9/2010
  13570         RPCB roker1.Par am[2].Valu e := FMToD ateConvert (FormatDat eTime('mm/ dd/yyyy',  FormDateRa nge.dtpSta rtDate.Dat e)); // st art date
  13571         RPCB roker1.Par am[2].PTyp e := liter al;
  13572         RPCB roker1.Par am[3].Valu e := FMToD ateConvert (FormatDat eTime('mm/ dd/yyyy',  FormDateRa nge.dtpEnd Date.Date) ); // end  date
  13573         RPCB roker1.Par am[3].PTyp e := liter al;
  13574       End;
  13575  
  13576       Try
  13577         RPCB roker1.Cal l;
  13578       Except
  13579         On E BrokerErro r Do
  13580         Begi n
  13581           AN URemotePro cedureCall InProgress  := False;
  13582           An imateLogo( False);
  13583           St atusBarLoa dPt.Captio n := 'RPC  ORQQCN LIS T could no t be acces sed!';
  13584           St atusBarLoa dPt.Repain t;
  13585           Ap plication. Processmes sages;
  13586           Sh owMessageC APRI('RPC  ORQQCN LIS T could no t be acces sed!');
  13587         End
  13588       End;
  13589       listDo cs.Clear;
  13590       If RPC Broker1.Re sults.Coun t > 0 Then
  13591         For  x := 0 To  RPCBroker1 .Results.C ount - 1 D o
  13592           li stDocs.add (RPCBroker 1.Results[ x]);
  13593       If Lis tDocs.Coun t > 0 Then
  13594         For  x := 0 To  ListDocs.C ount - 1 D o
  13595         Begi n
  13596           ls tDocs.Item s.Add(FMDa teTimeConv ert(Piece( listdocs[x ], '^', 2) ) + ' (' +  Piece(lis tdocs[x],  '^', 3) +  ') ' + Pie ce(listdoc s[x], '^',  4) + ' ^'  + Piece(l istdocs[x] , '^', 1)) ;
  13597         End;
  13598       If Lis tDocs.Coun t = 0 Then
  13599       Begin
  13600         Memo Docs.Lines .Add('');
  13601         Memo Docs.Lines .Add('No c onsults fo und.');
  13602       End;
  13603       If (ls tDocs.Item s.Count >  0) And (Po s('PATIENT  DOES NOT  HAVE ANY',  lstDocs.I tems[0]) >  0) Then
  13604       Begin
  13605         Memo Docs.Lines .Add('');
  13606         Memo Docs.Lines .Add('No c onsults fo und.');
  13607         lstD ocs.Items. Clear;
  13608       End;
  13609  
  13610       If (Sc reenReader Active = F alse) and  IsSetFocus Valid(lstD ocs) Then
  13611         lstD ocs.SetFoc us;
  13612  
  13613       If lst Docs.Items .Count > 0  Then
  13614       Begin
  13615         lstD ocs.ItemIn dex := 0;
  13616         lstD ocs.Select ed[0] := T RUE;                                                   //-MER Cod eCR126 7/2 010
  13617         lstD ocsClick(A pplication );
  13618       End;
  13619     End;
  13620     If Tab95 Control1.T abs[Tab95C ontrol1.Ta bIndex] =  '&4)  Vita ls' Then
  13621     Begin
  13622       If For mReportBui lder <> Ni l Then
  13623         form ReportBuil der.ORAlig nButtonAdd All.Enable d := False ;
  13624       button ClinDocDat eRange.Vis ible := Fa lse;
  13625       LabelC urrentView .Visible : = False;
  13626       Splitt er2.Visibl e := False ;
  13627       PanelC ount.Visib le := Fals e;
  13628       PanelG raphVS.Vis ible := Tr ue;
  13629       btnGra phVS.enabl ed := True ;
  13630       PanelS earch.Visi ble := Fal se;
  13631       DocTyp e := 'VS';
  13632       memoDo cs.Lines.C lear;
  13633       LstDoc s.Items.Cl ear;
  13634       LstDoc s.Items.Ad d('Today') ;
  13635       LstDoc s.Items.Ad d('One Wee k Back');
  13636       LstDoc s.Items.Ad d('Two Wee ks Back');
  13637       LstDoc s.Items.Ad d('One Mon th Back');
  13638       LstDoc s.Items.Ad d('Six Mon ths Back') ;
  13639       LstDoc s.Items.Ad d('One Yea r Back');
  13640       LstDoc s.Items.Ad d('Two Yea rs Back');
  13641       LstDoc s.Items.Ad d('Five Ye ars Back') ;
  13642       LstDoc s.Items.Ad d('ALL Vit als');
  13643       //LstD ocs.Items. Add('Graph ');
  13644     (* Defec t #2199 -  rpm 4/21/0 9 - Exceed ing the It ems array  count by s etting
  13645        the I temIndex t o 9 causes  the listb ox to set  the ItemIn dex to -1.   Appears
  13646        to be  an incomp lete futur e enhancem ent.
  13647       If Cli nDocDateRa ngeSelecte d = true T hen
  13648         LstD ocs.ItemIn dex := 9
  13649       Else
  13650     *)
  13651       lstDoc s.ItemInde x := 0;
  13652       lstDoc s.Selected [0] := TRU E;                                                     //-MER Cod eCR126 7/2 010
  13653       Try
  13654         If S creenReade rActive =  False Then
  13655           ls tDocs.SetF ocus;
  13656       Except
  13657       End;
  13658       LstDoc sClick(App lication);
  13659     End;
  13660     If Tab95 Control1.T abs[Tab95C ontrol1.Ta bIndex] =  '&5)  Meds ' Then
  13661     Begin
  13662       If For mReportBui lder <> Ni l Then
  13663         form ReportBuil der.ORAlig nButtonAdd All.Enable d := False ;
  13664       button ClinDocDat eRange.Vis ible := Fa lse;
  13665       LabelC urrentView .Visible : = False;
  13666       Splitt er2.Visibl e := False ;
  13667       PanelC ount.Visib le := Fals e;
  13668       PanelG raphVS.Vis ible := Fa lse;
  13669       PanelS earch.Visi ble := Fal se;
  13670       DocTyp e := 'MEDS ';
  13671       memoDo cs.Lines.C lear;
  13672       LstDoc s.Items.Cl ear;
  13673       LstDoc s.Items.Ad d('Outpati ent Rx Act ion Profil e');
  13674       LstDoc s.Items.Ad d('Outpati ent Histor y All');
  13675       LstDoc s.Items.Ad d('Outpati ent Histor y By Date  Range');
  13676       LstDoc s.Items.Ad d('Inpatie nt History  All');
  13677       LstDoc s.Items.Ad d('Inpatie nt History  By Date R ange');
  13678       LstDoc s.Items.Ad d('Inpatie nt Unit Do se History  All');
  13679       LstDoc s.Items.Ad d('Inpatie nt Unit Do se History  By Date R ange');
  13680       LstDoc s.Items.Ad d('Inpatie nt IV Hist ory All');
  13681       LstDoc s.Items.Ad d('Inpatie nt IV Hist ory By Dat e Range');
  13682       LstDoc s.Items.Ad d('Active  Outpatient ');
  13683       LstDoc s.Items.Ad d('Active  Inpatient' );
  13684       LstDoc s.Items.Ad d('Active  Inpatient  Unit Dose' );
  13685       LstDoc s.Items.Ad d('Active  Inpatient  IV');
  13686       LstDoc s.Items.Ad d('Med Adm in History  (BCMA) By  Date Rang e');
  13687       lstDoc s.ItemInde x := 0;
  13688       lstDoc s.Selected [0] := TRU E;                                                     //-MER Cod eCR126 7/2 010
  13689       Try
  13690         If S creenReade rActive =  False Then
  13691       lstDoc s.SetFocus  Except
  13692       End;
  13693       LstDoc sClick(App lication);
  13694     End;
  13695     If Tab95 Control1.T abs[Tab95C ontrol1.Ta bIndex] =  '&6)  Labs ' Then
  13696     Begin
  13697       If For mReportBui lder <> Ni l Then
  13698         form ReportBuil der.ORAlig nButtonAdd All.Enable d := False ;
  13699       button ClinDocDat eRange.Vis ible := Fa lse;
  13700       LabelC urrentView .Visible : = False;
  13701       Splitt er2.Visibl e := False ;
  13702       PanelC ount.Visib le := Fals e;
  13703       PanelG raphVS.Vis ible := Fa lse;
  13704       PanelS earch.Visi ble := Fal se;
  13705       DocTyp e := 'LAB' ;
  13706       memoDo cs.Lines.C lear;
  13707       LstDoc s.Items.Cl ear;
  13708       LstDoc s.Items.Ad d('Cumulat ive 1 week ');
  13709       LstDoc s.Items.Ad d('Cumulat ive 2 week s');
  13710       LstDoc s.Items.Ad d('Cumulat ive 1 mont h');
  13711       LstDoc s.Items.Ad d('Cumulat ive 6 mont hs');
  13712       LstDoc s.Items.Ad d('Cumulat ive 1 year ');
  13713       LstDoc s.Items.Ad d('Cumulat ive 2 year s');
  13714       LstDoc s.Items.Ad d('Cumulat ive 5 year s');
  13715       LstDoc s.Items.Ad d('Cumulat ive ALL');
  13716       LstDoc s.Items.Ad d('Anatomi c Patholog y');
  13717       LstDoc s.Items.Ad d('Blood B ank');
  13718       LstDoc s.Items.Ad d('Microbi ology');
  13719       LstDoc s.Items.Ad d('Graph') ;
  13720       lstDoc s.ItemInde x := 0;
  13721       lstDoc s.Selected [0] := TRU E;                                                     //-MER Cod eCR126 7/2 010
  13722       frmMai n.Repaint;
  13723       Try
  13724         If S creenReade rActive =  False Then
  13725       lstDoc s.SetFocus  Except
  13726       End;
  13727       LstDoc sClick(App lication);
  13728     End;
  13729     If Tab95 Control1.T abs[Tab95C ontrol1.Ta bIndex] =  '&7)  Imag ing' Then
  13730     Begin
  13731       If For mReportBui lder <> Ni l Then
  13732         form ReportBuil der.ORAlig nButtonAdd All.Enable d := True;
  13733       button ClinDocDat eRange.Vis ible := Fa lse;
  13734       LabelC urrentView .Visible : = False;
  13735   //  Splitt er2.Visibl e := False ;
  13736       Splitt er2.Visibl e := True;                                                        //CodeCR69 6 JRL 4/8/ 15
  13737       PanelC ount.Visib le := Fals e;
  13738       PanelG raphVS.Vis ible := Fa lse;
  13739   //  PanelS earch.Visi ble := Fal se;
  13740       PanelS earch.Visi ble := Tru e;                                                     //CodeCR69 6 JRL 4/8/ 15
  13741       DocTyp e := 'IMAG ING';
  13742       memoDo cs.Lines.C lear;
  13743       LstDoc s.Items.Cl ear;
  13744       //frmM ain.RPCBro ker1.Resul ts.Clear;
  13745       RPCBro ker1.Remot eProcedure  := 'ORWRA  IMAGING E XAMS';
  13746       RPCBro ker1.Param [1].Value  := Patient IEN;                                        // Patient  IEN
  13747       RPCBro ker1.Param [1].PType  := literal ;
  13748       Try
  13749         RPCB roker1.Cal l;
  13750       Except
  13751         On E BrokerErro r Do
  13752         Begi n
  13753           AN URemotePro cedureCall InProgress  := False;
  13754           An imateLogo( False);
  13755           St atusBarLoa dPt.Captio n := 'RPC  DVBAB ORWR A IMAGING  EXAMS coul d not be a ccessed!';
  13756           St atusBarLoa dPt.Repain t;
  13757           Ap plication. Processmes sages;
  13758           Sh owMessageC APRI('RPC  DVBAB ORWR A IMAGING  EXAMS coul d not be a ccessed!') ;
  13759         End
  13760       End;
  13761       listDo cs.Clear;
  13762       If RPC Broker1.Re sults.Coun t > 0 Then
  13763         For  x := 0 To  RPCBroker1 .Results.C ount - 1 D o
  13764           li stDocs.add (RPCBroker 1.Results[ x]);
  13765       If Lis tDocs.Coun t > 0 Then
  13766         For  x := 0 To  ListDocs.C ount - 1 D o
  13767         Begi n
  13768           ty p := Piece (listdocs[ x], '^', 3 );
  13769           st at := Piec e(listdocs [x], '^',  5);
  13770           ls tDocs.Item s.Add(FMDa teTimeConv ert(Piece( listdocs[x ], '^', 2) ) + '  ' +  typ + '   ' + stat +  ' ^' + Pi ece(listdo cs[x], '^' , 1) + '#'  + Piece(l istdocs[x] , '^', 4)) ;
  13771         End;
  13772       If Lis tDocs.Coun t = 0 Then
  13773       Begin
  13774         Memo Docs.Lines .Add('');
  13775         Memo Docs.Lines .Add('No i mages foun d...');
  13776       End;
  13777       Try
  13778         If S creenReade rActive =  False Then
  13779       lstDoc s.SetFocus  Except
  13780       End;
  13781       If lst Docs.Items .Count > 0  Then
  13782       Begin
  13783         lstD ocs.ItemIn dex := 0;
  13784         lstD ocs.Select ed[0] := T RUE;                                                   //-MER Cod eCR126 7/2 010
  13785         lstD ocsClick(A pplication );
  13786       End;
  13787     End;
  13788     If Tab95 Control1.T abs[Tab95C ontrol1.Ta bIndex] =  '&8)  Diet ' Then
  13789     Begin
  13790       If For mReportBui lder <> Ni l Then
  13791         form ReportBuil der.ORAlig nButtonAdd All.Enable d := False ;
  13792       button ClinDocDat eRange.Vis ible := Fa lse;
  13793       LabelC urrentView .Visible : = False;
  13794       Splitt er2.Visibl e := False ;
  13795       PanelC ount.Visib le := Fals e;
  13796       PanelG raphVS.Vis ible := Fa lse;
  13797       PanelS earch.Visi ble := Fal se;
  13798       DocTyp e := 'DIET ';
  13799       memoDo cs.Lines.C lear;
  13800       LstDoc s.Items.Cl ear;
  13801       LstDoc s.ItemInde x := -1;
  13802       Try
  13803         If S creenReade rActive =  False Then
  13804       lstDoc s.SetFocus  Except
  13805       End;
  13806       LstDoc sClick(App lication);
  13807     End;
  13808     If Tab95 Control1.T abs[Tab95C ontrol1.Ta bIndex] =  '&9)  Nutr itional As sessment'  Then
  13809     Begin
  13810       If For mReportBui lder <> Ni l Then
  13811         form ReportBuil der.ORAlig nButtonAdd All.Enable d := True;
  13812       button ClinDocDat eRange.Vis ible := Fa lse;
  13813       LabelC urrentView .Visible : = False;
  13814   //  Splitt er2.Visibl e := False ;
  13815       Splitt er2.Visibl e := True;                                                        //CodeCR69 6 JRL 4/8/ 15
  13816       PanelC ount.Visib le := Fals e;
  13817       PanelG raphVS.Vis ible := Fa lse;
  13818   //  PanelS earch.Visi ble := Fal se;
  13819       PanelS earch.Visi ble := Tru e;                                                     //CodeCR69 6 JRL 4/8/ 15
  13820       DocTyp e := 'NUTA SSESS';
  13821       memoDo cs.Lines.C lear;
  13822       LstDoc s.Items.Cl ear;
  13823       lbNUTA SSESSSearc hIndex.Ite ms.Clear;                                              // CodeCR6 96 JRL 4/1 0/15
  13824       frmMai n.RPCBroke r1.Results .Clear;
  13825       RPCBro ker1.Remot eProcedure  := 'ORWRP 1 LISTNUTR ';
  13826       RPCBro ker1.Param [1].Value  := Patient IEN;                                        // Patient  IEN
  13827       RPCBro ker1.Param [1].PType  := literal ;
  13828       Try
  13829         RPCB roker1.Cal l;
  13830       Except
  13831         On E BrokerErro r Do
  13832         Begi n
  13833           AN URemotePro cedureCall InProgress  := False;
  13834           An imateLogo( False);
  13835           St atusBarLoa dPt.Captio n := 'RPC  ORWRP1 LIS TNUTR coul d not be a ccessed!';
  13836           St atusBarLoa dPt.Repain t;
  13837           Ap plication. Processmes sages;
  13838           Sh owMessageC APRI('RPC  ORWRP1 LIS TNUTR coul d not be a ccessed!') ;
  13839         End
  13840       End;
  13841       listDo cs.Clear;
  13842  
  13843       If RPC Broker1.Re sults.Coun t > 0 Then
  13844         For  x := 0 To  RPCBroker1 .Results.C ount - 1 D o
  13845           li stDocs.add (RPCBroker 1.Results[ x]);
  13846       If Lis tDocs.Coun t > 0 Then
  13847         For  x := 0 To  ListDocs.C ount - 1 D o
  13848         Begi n
  13849           If  Piece(RPC Broker1.Re sults[x],  '^', 3) <>  '' Then
  13850           Be gin
  13851              CPRSVersio n := 'V16' ;
  13852              lstDocs.It ems.Add(Pi ece(RPCBro ker1.Resul ts[x], '^' , 3));
  13853              lbNUTASSES SSearchInd ex.Items.A dd(Piece(R PCBroker1. Results[x] , '^', 3)) ; // CodeC R696 JRL 4 /10/15
  13854           En d
  13855           El se
  13856           Be gin
  13857              CPRSVersio n := 'V15' ;
  13858              lstDocs.It ems.Add(RP CBroker1.R esults[x]) ;
  13859           En d;
  13860         End;
  13861       Try
  13862         If S creenReade rActive =  False Then
  13863       lstDoc s.SetFocus  Except
  13864       End;
  13865       If Lis tDocs.Coun t = 0 Then
  13866       Begin
  13867         Memo Docs.Lines .Add('');
  13868         Memo Docs.Lines .Add('No n utritional  assessmen ts found.' );
  13869       End;
  13870       If lst Docs.Items .Count > 0  Then
  13871       Begin
  13872         lstD ocs.ItemIn dex := 0;
  13873         lstD ocs.Select ed[0] := T RUE;                                                   //-MER Cod eCR126 7/2 010
  13874         lstD ocsClick(A pplication );
  13875       End;
  13876     End;
  13877     If Tab95 Control1.T abs[Tab95C ontrol1.Ta bIndex] =  '&U)  Orde r Summary'  Then
  13878     Begin
  13879       If For mReportBui lder <> Ni l Then
  13880         form ReportBuil der.ORAlig nButtonAdd All.Enable d := False ;
  13881       button ClinDocDat eRange.Vis ible := Fa lse;
  13882       LabelC urrentView .Visible : = False;
  13883       Splitt er2.Visibl e := False ;
  13884       PanelC ount.Visib le := Fals e;
  13885       PanelG raphVS.Vis ible := Fa lse;
  13886       PanelS earch.Visi ble := Fal se;
  13887       DocTyp e := 'ORDE RS';
  13888       memoDo cs.Lines.C lear;
  13889       LstDoc s.Items.Cl ear;
  13890       LstDoc s.Items.Ad d('Today') ;
  13891       LstDoc s.Items.Ad d('One Wee k Back');
  13892       LstDoc s.Items.Ad d('Two Wee ks Back');
  13893       LstDoc s.Items.Ad d('One Mon th Back');
  13894       LstDoc s.Items.Ad d('Six Mon ths Back') ;
  13895       LstDoc s.Items.Ad d('One Yea r Back');
  13896       LstDoc s.Items.Ad d('Two Yea rs Back');
  13897       LstDoc s.Items.Ad d('Five Ye ars Back') ;
  13898       LstDoc s.Items.Ad d('ALL Ord ers');
  13899       lstDoc s.ItemInde x := 0;
  13900       lstDoc s.Selected [0] := TRU E;                                                     //-MER Cod eCR126 7/2 010
  13901       Try
  13902         If S creenReade rActive =  False Then
  13903       lstDoc s.SetFocus  Except
  13904       End;
  13905       LstDoc sClick(App lication);
  13906     End;
  13907     If Tab95 Control1.T abs[Tab95C ontrol1.Ta bIndex] =  '&Y)  Proc edures' Th en
  13908     Begin
  13909       If For mReportBui lder <> Ni l Then
  13910         form ReportBuil der.ORAlig nButtonAdd All.Enable d := True;
  13911       button ClinDocDat eRange.Vis ible := Fa lse;
  13912   //  Splitt er2.Visibl e := False ;
  13913       Splitt er2.Visibl e := True;                                                        //CodeCR69 6 JRL 4/8/ 15
  13914       PanelC ount.Visib le := Fals e;
  13915       PanelG raphVS.Vis ible := Fa lse;
  13916   //  PanelS earch.Visi ble := Fal se;
  13917       PanelS earch.Visi ble := Tru e;                                                     //CodeCR69 6 JRL 4/8/ 15
  13918       DocTyp e := 'PROC EDURES';
  13919       memoDo cs.Lines.C lear;
  13920       LstDoc s.Items.Cl ear;
  13921       frmMai n.RPCBroke r1.Results .Clear;
  13922  
  13923       RPCBro ker1.Remot eProcedure  := 'ORWMC  PATIENT P ROCEDURES' ;
  13924       RPCBro ker1.Param [1].Value  := Patient IEN;                                        // Patient  IEN
  13925       RPCBro ker1.Param [1].PType  := literal ;
  13926       Try
  13927         RPCB roker1.Cal l;
  13928       Except
  13929         On E BrokerErro r Do
  13930         Begi n
  13931           AN URemotePro cedureCall InProgress  := False;
  13932           An imateLogo( False);
  13933           St atusBarLoa dPt.Captio n := 'RPC  ORWMC PATI ENT PROCED URES could  not be ac cessed!';
  13934           St atusBarLoa dPt.Repain t;
  13935           Ap plication. Processmes sages;
  13936           Sh owMessageC APRI('RPC  ORWMC PATI ENT PROCED URES could  not be ac cessed!');
  13937         End
  13938       End;
  13939       listDo cs.Clear;
  13940       If RPC Broker1.Re sults.Coun t > 0 Then
  13941         For  x := 0 To  RPCBroker1 .Results.C ount - 1 D o
  13942           li stDocs.add (RPCBroker 1.Results[ x]);
  13943       If Lis tDocs.Coun t > 0 Then
  13944         For  x := 0 To  ListDocs.C ount - 1 D o
  13945         Begi n
  13946           ls tDocs.Item s.Add(Piec e(listdocs [x], '^',  7) + '  '  + Piece(li stdocs[x],  '^', 2) +  '  (' + P iece(listd ocs[x], '^ ', 8) + ')  ^' + Piec e(listdocs [x], '^',  1));
  13947         End;
  13948       If Lis tDocs.Coun t = 0 Then
  13949       Begin
  13950         Memo Docs.Lines .Add('');
  13951         Memo Docs.Lines .Add('No p rocedures  found.');
  13952       End;
  13953       If (ls tDocs.Item s.Count >  0) And (Po s('PATIENT  DOES NOT  HAVE ANY',  lstDocs.I tems[0]) >  0) Then
  13954       Begin
  13955         Memo Docs.Lines .Add('');
  13956         Memo Docs.Lines .Add('No p rocedures  found.');
  13957         lstD ocs.Items. Clear;
  13958       End;
  13959       Try
  13960         If S creenReade rActive =  False Then
  13961       lstDoc s.SetFocus  Except
  13962       End;
  13963       If lst Docs.Items .Count > 0  Then
  13964       Begin
  13965         lstD ocs.ItemIn dex := 0;
  13966         lstD ocs.Select ed[0] := T RUE;                                                   //-MER Cod eCR126 7/2 010
  13967         lstD ocsClick(A pplication );
  13968       End;
  13969     End;
  13970     If Tab95 Control1.T abs[Tab95C ontrol1.Ta bIndex] =  '&Z)  Prob lem List'  Then
  13971     Begin
  13972       If For mReportBui lder <> Ni l Then
  13973         form ReportBuil der.ORAlig nButtonAdd All.Enable d := False ;
  13974       button ClinDocDat eRange.Vis ible := Fa lse;
  13975       LabelC urrentView .Visible : = False;
  13976       Splitt er2.Visibl e := False ;
  13977       PanelC ount.Visib le := Fals e;
  13978       PanelG raphVS.Vis ible := Fa lse;
  13979       PanelS earch.Visi ble := Fal se;
  13980       DocTyp e := 'PROB LEM LIST';
  13981       memoDo cs.Lines.C lear;
  13982       LstDoc s.Items.Cl ear;
  13983       LstDoc s.Items.Ad d('Active' );
  13984       LstDoc s.Items.Ad d('Inactiv e');
  13985       LstDoc s.Items.Ad d('Both Ac tive and I nactive');
  13986       lstDoc s.ItemInde x := 0;
  13987       lstDoc s.Selected [0] := TRU E;                                                     //-MER Cod eCR126 7/2 010
  13988       Try
  13989         If S creenReade rActive =  False Then
  13990       lstDoc s.SetFocus  Except
  13991       End;
  13992       LstDoc sClick(App lication);
  13993     End;
  13994     Tab95Con trol1.Enab led := Tru e;
  13995     Page95Co ntrol1.Ena bled := Tr ue;                                                    //CodeCR32 4 - rpm 3/ 6/12
  13996     //rpm 3/ 31/09 - De fect #2178 : prevent  error when  quickly s witching t abs
  13997     if IsSet FocusValid (Tab95Cont rol1) then
  13998       Tab95C ontrol1.Se tFocus;
  13999     AnimateL ogo(False) ;
  14000     StatusBa rLoadPt.Ca ption := ' Ready.';
  14001     StatusBa rLoadPt.Re paint;
  14002     Applicat ion.Proces smessages;
  14003     //zz
  14004   End;
  14005  
  14006   Procedure  TfrmMain.T imeoutTime rTimer(Sen der: TObje ct);
  14007   Var
  14008     TabReOrd er: boolea n;
  14009     x: integ er;
  14010     tempIEN:  String;
  14011     temp2IEN : integer;
  14012     tempFMLi stBox: TFM ListBox;
  14013   Begin
  14014  
  14015     If ESSOV ersion = F alse Then
  14016       If CCO WMode = Tr ue Then
  14017         If C ontextorCo ntrol.Stat e = 3 Then
  14018         Begi n
  14019           CC OWSuspende d := True;
  14020           Bi tBtnCCOWLi nkBroken.V isible :=  True;
  14021           Bi tBtnCCOWLi nk.Visible  := False;
  14022           Bi tBtnCCOWLi nkChanging .Visible : = False;
  14023         End;
  14024  
  14025     // 2 = c onnected
  14026     // 3 = S uspended
  14027  
  14028     // Make  sure every thing is s hut down b efore turn ing off th e flag
  14029     If Shutd ownCAPRIMo dalDialogs  = true Th en
  14030     Begin
  14031       // Don 't need to  check for ms that fo rce CAPRI  to exit co ntext
  14032       If frm BrowseTemp lates = Ni l Then
  14033         If f rmAboutFor m = Nil Th en
  14034           If  UnsignedV iew = Nil  Then
  14035              If frmPati entList =  Nil Then
  14036                If frmNe wExam = Ni l Then
  14037                  If frm View7131 =  Nil Then
  14038                    Shut DownCAPRIM odalDialog s := false
  14039     End;
  14040  
  14041     If ANURe moteProced ureCallInP rogress =  True Then
  14042       exit;
  14043  
  14044     TimeOutT imer.Enabl ed := Fals e;
  14045     Inc(Time SinceLastB rokerCall) ;
  14046  
  14047     If SendP NCSEvent < > '' Then
  14048     Begin
  14049       inc(Se ndPNCSCoun ter);
  14050       If Sen dPNCSCount er = 2 The n
  14051       Begin
  14052         // T his keeps  keyclicks  from sendi ng so many  PNCSEvent  messages  and
  14053         // s ends one e very 1 sec ond instea d.  This h elps long  scripts in  PNCS
  14054         // f rom making  the app f eel sluggi sh.
  14055           // PNCSEvent: =SendPNCSE vent;
  14056         Paus eScript :=  False;
  14057         PNCS EventContr ol := Send PNCSEvent;
  14058         PNCS Event := T rue;
  14059         Send PNCSCounte r := 0;
  14060         Send PNCSEvent  := '';
  14061       End;
  14062     End;
  14063  
  14064     If PNCSf orm = Nil  Then
  14065       If hal tflag = tr ue Then
  14066       Begin
  14067         If a ppstarted  = true The n
  14068         Begi n
  14069           fr mMain.Clos e;
  14070         End;
  14071       End;
  14072  
  14073     If (ANUR efreshCPWM Titles = T rue) And ( Page95Cont rol1.Activ ePage = Ta bCPWorkshe ets) Then
  14074     Begin
  14075       ANURef reshCPWMTi tles := Fa lse;
  14076       Button IPRRefresh Click(Appl ication);
  14077     End;
  14078  
  14079     If (Time SinceLastB rokerCall  = 30) And  (ANURemote ProcedureC allInProgr ess = Fals e) Then
  14080     Begin
  14081       SaveCA PRISetting s;                                                                // Save wi ndow posit ion and su ch for nex t session
  14082       screen .cursor :=  crArrow;
  14083       // Thi s call is  only used  as a keep  alive func tion.
  14084       // Not hing is do ne with th e returned  data.
  14085  
  14086       //CAPR I_CodeCR95   - jcs -  05/20/2010
  14087       // lef t original  (commente d out) cod e, for now ...
  14088  
  14089       if not  CallRPC(R PCBroker1,  'XWB GET  VARIABLE V ALUE', ['D UZ'], nil,  True) the n
  14090         exit ;
  14091  
  14092   //    RPCB roker1.Rem oteProcedu re := 'XWB  GET VARIA BLE VALUE' ;
  14093   //    RPCB roker1.Par am[0].Valu e := 'DUZ' ;
  14094   //    RPCB roker1.Par am[0].PTyp e := refer ence;
  14095   //    RPCB rokerCall;
  14096   //    Try
  14097   //      RP CBroker1.C all;
  14098   //    Exce pt
  14099   //      On  EBrokerEr ror Do
  14100   //      Be gin
  14101   //         ANURemoteP rocedureCa llInProgre ss := Fals e;
  14102   //         AnimateLog o(False);
  14103   //         If Not RPC Broker1.Co nnected Th en
  14104   //           If PNCSF orm <> Nil  Then
  14105   //           Begin
  14106   //             Status BarLoadPt. Caption :=  'No conne ction to V istA!';
  14107   //             Progre ssBarLoadP t.Repaint;
  14108   //             frmMai n.Repaint;
  14109   //             ShowMe ssageCAPRI ('The conn ection to  VistA has  been lost! ');
  14110   //           End
  14111   //           Else
  14112   //             If PNC SForm <> N il Then
  14113   //             Begin
  14114   //               Stat usBarLoadP t.Caption  := 'RPC XW B GET VARI ABLE VALUE  could not  be access ed!';
  14115   //               Prog ressBarLoa dPt.Repain t;
  14116   //               frmM ain.Repain t;
  14117   //               Show MessageCAP RI('XWB GE T VARIABLE  VALUE cou ld not be  accessed!' );
  14118   //             End;
  14119   //      En d; { on }
  14120   //    End;  { try/exc ept }
  14121       screen .cursor :=  crdefault ;
  14122       TimeSi nceLastBro kerCall :=  0;
  14123     End;
  14124  
  14125     If TimeO utVal > 0  Then
  14126       Inc(Ti meOutCount );
  14127     If TimeO utVal = 0  Then
  14128       TimeOu tCount :=  0;
  14129     { DEFECT  #1965 - r pm 12/11/0 8 - moved  closerevie w to PNCSM ain.Review EventsDial og
  14130     If PNCSF orm <> Nil  Then // S PH 10/19/2 007
  14131       If For mReviewerU tility <>  Nil Then
  14132       Begin
  14133         If f ormReviewe rUtility.C aption = ' ~CLOSE~' T hen
  14134         Begi n
  14135           fo rmReviewer Utility.Ca ption := ' Review Eve nts';
  14136           fo rmReviewer Utility.Vi sible := F alse;
  14137           pn csform.Clo seReview;
  14138         End;
  14139       End;
  14140     }
  14141     If pncsf orm <> Nil  Then
  14142     Begin
  14143       If (Pi ece(PNCSFo rm.Templat eAction, ' ~', 2) = ' CLOSE') Th en                    //CodeCR10 7 - rpm 5/ 12/10
  14144       Begin
  14145  
  14146         // H andle unlo cking the  node
  14147         If ( RPCBroker1 .Connected ) And (PNC SForm.xFME dit2.IENS  <> '') The n
  14148         Begi n
  14149           If  LockNode( frmmain.RP CBroker1,  '^DVB(396. 17,' + Pie ce(PNCSFor m.xFMEdit2 .IENS, ',' , 1) + ',8 )', UnLock , 5) = tru e Then
  14150           Be gin
  14151              //
  14152           En d
  14153           El se
  14154           Be gin
  14155              Showmessag eCAPRI('Th e form cou ld not be  unlocked.   There may  be proble ms opening  it for yo u or other  users unt il this CA PRI sessio n is close d.');
  14156           En d;
  14157         End;
  14158  
  14159         If P NCSForm.xC COWTimer.E nabled = T rue Then
  14160           PN CSForm.xCC OWTimer.En abled := F alse;
  14161         If U nsignedVie w <> Nil T hen
  14162         Begi n
  14163           If  UnsignedV iew.Label1 .Caption =  '1' Then
  14164              UnsignedVi ew.button5 Click(Appl ication);
  14165           If  UnsignedV iew.Label1 .Caption =  '2' Then
  14166              UnsignedVi ew.button3 Click(Appl ication);
  14167           If  UnsignedV iew.Label1 .Caption =  '3' Then
  14168              UnsignedVi ew.button6 Click(Appl ication);
  14169           If  UnsignedV iew.Label1 .Caption =  '4' Then
  14170              UnsignedVi ew.button4 Click(Appl ication);
  14171         End;
  14172  
  14173         { Re lease Form ReviewerUt ility firs t - revers e order of  creation  }
  14174         If F ormReviewe rUtility < > nil Then
  14175         Begi n
  14176           If  FormRevie werUtility .Owner = N il Then
  14177              FreeAndNil (FormRevie werUtility )
  14178           El se
  14179           Be gin
  14180              FormReview erUtility. Owner.Remo veComponen t(FormRevi ewerUtilit y);
  14181              FreeAndNil (FormRevie werUtility );
  14182           En d;
  14183         End;
  14184         If P NCSForm <>  nil Then
  14185         Begi n
  14186           If  PNCSForm. Owner = Ni l Then
  14187              FreeAndNil (PNCSForm)
  14188           El se
  14189           Be gin
  14190              PNCSForm.O wner.Remov eComponent (PNCSForm) ;
  14191              If assigne d(PNCSForm ) Then
  14192                FreeAndN il(PNCSFor m);
  14193           En d;
  14194         End;
  14195  
  14196         form Running :=  False;
  14197         If ( Page95Cont rol1.Visib le = true)  And (RPCB roker1.Con nected) Th en
  14198           bu ttonIPRRef reshClick( Applicatio n);
  14199       End
  14200       Else
  14201         If ( Piece(PNCS Form.Templ ateAction,  '~', 2) =  'RELOAD')  Then                 //CodeCR10 7 - rpm 5/ 12/10
  14202         Begi n
  14203  
  14204           //  Handle un locking th e node
  14205           If  PNCSForm. xFMEdit2.I ENS <> ''  Then
  14206           Be gin
  14207              If LockNod e(frmmain. RPCBroker1 , '^DVB(39 6.17,' + P iece(PNCSF orm.xFMEdi t2.IENS, ' ,', 1) + ' ,8)', UnLo ck, 5) = t rue Then
  14208              Begin
  14209              End
  14210              Else
  14211              Begin
  14212                Showmess ageCAPRI(' The form c ould not b e unlocked .  There m ay be prob lems openi ng it for  you or oth er users u ntil this  CAPRI sess ion is clo sed.');
  14213              End;
  14214           En d;
  14215  
  14216           Ta bReOrder : = Pos('TAB ', UpperCa se(PNCSFor m.SaveName )) > 0;
  14217           te mpIEN := P iece(PNCSF orm.Templa teAction,  '~', 3);                         //CodeCR10 7 - rpm 5/ 12/10
  14218           If  PNCSForm. xCCOWTimer .Enabled =  True Then
  14219              PNCSForm.x CCOWTimer. Enabled :=  False;
  14220  
  14221           {  WLM 3/6/08  CHANGING  HOW TO FRE E PNCS }
  14222              { Release  FormReview erUtility  first - re verse orde r of creat ion }
  14223           If  FormRevie werUtility  <> nil Th en
  14224           Be gin
  14225              If FormRev iewerUtili ty.Owner =  Nil Then
  14226              Begin
  14227                FreeAndN il(FormRev iewerUtili ty);
  14228              End
  14229              Else
  14230              Begin
  14231                FormRevi ewerUtilit y.Owner.Re moveCompon ent(FormRe viewerUtil ity);
  14232                FreeAndN il(FormRev iewerUtili ty);
  14233              End;
  14234           En d;
  14235           If  PNCSForm  <> nil The n
  14236           Be gin
  14237              If PNCSFor m.Owner =  Nil Then
  14238                FreeAndN il(PNCSFor m)
  14239              Else
  14240              Begin
  14241                PNCSForm .Owner.Rem oveCompone nt(PNCSFor m);
  14242                FreeAndN il(PNCSFor m);
  14243              End;
  14244           En d;
  14245  
  14246           fo rmRunning  := false;
  14247           If  UnsignedV iew = Nil  Then
  14248              buttonIPRR efreshClic k(Applicat ion);
  14249           te mpFMListBo x := FMLis tBoxIPR1;
  14250           If  UnsignedV iew <> Nil  Then
  14251           Be gin
  14252              If Unsigne dView.Labe l1.Caption  = '1' The n
  14253                Unsigned View.butto n5Click(Ap plication) ;
  14254              If Unsigne dView.Labe l1.Caption  = '2' The n
  14255                Unsigned View.butto n3Click(Ap plication) ;
  14256              If Unsigne dView.Labe l1.Caption  = '3' The n
  14257                Unsigned View.butto n6Click(Ap plication) ;
  14258              If Unsigne dView.Labe l1.Caption  = '4' The n
  14259                Unsigned View.butto n4Click(Ap plication) ;
  14260              tempFMList Box := Uns ignedView. FMListBoxI PR1;
  14261           En d;
  14262           te mp2IEN :=  -1;
  14263           If  tempIEN < > '' Then
  14264              If tempFML istBox.Ite ms.Count >  0 Then
  14265              Begin
  14266                tempFMLi stBox.Item Index := - 1;
  14267                For x :=  0 To temp FMListBox. Items.Coun t - 1 Do
  14268                Begin
  14269                  tempFM ListBox.It emIndex :=  x;
  14270                  If Cop y(tempFMLi stBox.Item s[x], 1, 1 ) <> '!' T hen
  14271                    If t empFMListB ox.GetSele ctedRecord .IEN = tem pIEN Then
  14272                    Begi n
  14273                      te mp2ien :=  x;
  14274                    End;
  14275                End;
  14276                If temp2 IEN > -1 T hen
  14277                Begin
  14278                  tempFM ListBox.It emIndex :=  temp2ien;
  14279                  If Uns ignedView  <> Nil The n
  14280                  Begin
  14281                    If t empFMListB ox = Unsig nedView.FM ListBoxIPR 1 Then
  14282                    Begi n
  14283                      Un signedView .Button1Cl ick(Applic ation);
  14284                    End
  14285                    Else
  14286                      If  tempFMLis tBox = FML istBoxIPR1  Then
  14287                      Be gin
  14288                         ListBoxIPR 1.ItemInde x := ListB oxIPR1.Ite ms.Count -  1 - FMLis tBoxIPR1.I temIndex;
  14289                         ButtonIPRD isplayClic k(Applicat ion);
  14290                      En d;
  14291                  End
  14292                  Else
  14293                    If t empFMListB ox = FMLis tBoxIPR1 T hen
  14294                    Begi n
  14295                      Li stBoxIPR1. ItemIndex  := ListBox IPR1.Items .Count - 1  - FMListB oxIPR1.Ite mIndex;
  14296                      Bu ttonIPRDis playClick( Applicatio n);
  14297                      {  WLM 4/21 }
  14298                      If  TabReOrde r Then
  14299                         PNCSForm.S aveName :=  ' Tab ReO rder - Sav e after Re order';
  14300                    End;
  14301                End;                                                                       {temp2IEN  > -1}
  14302              End;                                                                         {tempFMLis tBox.Items .Count > 0 }
  14303         End;
  14304     End;
  14305     // timeo utval:=5;
  14306     If PNCSF orm <> Nil  Then
  14307       TimeOu tCount :=  0;
  14308     If TimeO utCount >  TimeOutVal  Then
  14309     Begin
  14310       timeou ttimer.ena bled := fa lse;
  14311       //Set  up form
  14312       frmSta yConnected  := TfrmSt ayConnecte d.Create(f rmMain);
  14313       frmSta yConnected .Top := 7  + frmMain. Top + ((fr mMain.Heig ht - frmSt ayConnecte d.Height)  Div 2);
  14314       frmSta yConnected .Left := f rmMain.Lef t + ((frmM ain.Width  - frmStayC onnected.W idth) Div  2);
  14315       frmSta yConnected .font := p anel1.font ;
  14316       //frmS tayConnect ed.Label1. Font:=pane l1.font;
  14317       frmSta yConnected .button1.h eight := p anel1.Heig ht;
  14318       frmSta yConnected .button2.h eight := p anel1.Heig ht;
  14319       frmSta yConnected .panelCoun tdown.top  := frmStay Connected. Label1.Top  + frmStay Connected. label1.hei ght + 8;
  14320       frmSta yConnected .button2.t op := frmS tayConnect ed.panelCo untdown.to p;
  14321       frmSta yConnected .button1.t op := frmS tayConnect ed.button2 .top + frm StayConnec ted.button 2.height;
  14322       frmSta yConnected .panelCoun tdown.heig ht := frmS tayConnect ed.button1 .height +  frmStayCon nected.but ton2.heigh t;
  14323       frmSta yConnected .height :=  frmStayCo nnected.bu tton1.top  + frmStayC onnected.b utton1.hei ght * 2 +  (frmStayCo nnected.he ight - frm StayConnec ted.Client Height);
  14324       //
  14325       frmSta yConnected .Top := 7  + frmMain. Top + ((fr mMain.Heig ht - frmSt ayConnecte d.Height)  Div 2);
  14326       frmSta yConnected .Left := f rmMain.Lef t + ((frmM ain.Width  - frmStayC onnected.W idth) Div  2);
  14327       //
  14328       Contex torChangeM essage :=  'The appli cation is  in the pro cess of ti ming out.  If you con tinue, CAP RI will dr op out of  the clinic al context .';
  14329       CCOWBr eakLink :=  True;
  14330       If frm StayConnec ted.ShowMo dal = mrOK  Then
  14331       Begin
  14332         Time OutCount : = 0;
  14333         time outtimer.e nabled :=  True;
  14334       End
  14335       Else
  14336       Begin
  14337         RPCB rokerCall;
  14338         If P NCSForm =  Nil Then
  14339           If  appstarte d = true T hen
  14340           Be gin
  14341              frmMain.cl ose;
  14342           En d
  14343           El se
  14344              applicatio n.terminat e;
  14345         Halt flag := tr ue;
  14346       End;
  14347       Contex torChangeM essage :=  '';
  14348       CCOWBr eakLink :=  False;
  14349       frmSta yConnected .release;
  14350       frmSta yConnected  := Nil;
  14351     End;
  14352     TimeOutT imer.Enabl ed := True ;
  14353   End;
  14354  
  14355   Procedure  TfrmMain.B uttonState AcceptClic k(Sender:  TObject);
  14356   Begin
  14357     // Reloa d Counties
  14358     FMLister Counties.I ENS := ','  + FMState sList.GetS electedRec ord.IEN;
  14359     fmLister Counties.G etList(FMC ountiesLis t.Items);
  14360     If TempI EN <> FMSt atesList.G etSelected Record.IEN  Then
  14361     Begin
  14362       // Sta te has cha nged, so c lear count y
  14363       FMEdit County.Tex t := '';
  14364       County Fake.Text  := '';
  14365       FMCoun tiesList.I temIndex : = -1;
  14366     End;
  14367  
  14368     FMEditSt ate.Text : = '`' + FM StatesList .GetSelect edRecord.I EN;
  14369     StateFak e.Text :=  FMStatesLi st.Items[F MStatesLis t.ItemInde x];
  14370     FMStates List.Visib le := Fals e;
  14371     ButtonSt ateAccept. Visible :=  False;
  14372  
  14373     If (Stat eFake.Text  = 'CANADA ') Or (Sta teFake.Tex t = 'PHILI PPINES') O r
  14374       (State Fake.Text  = 'QUEBEC' ) Or
  14375       (Upper case(Trim( StateFake. Text)) = ' NEWFOUNDLA ND') Or (U ppercase(T rim(StateF ake.text))  = 'LABRAD OR') Or (U ppercase(T rim(StateF ake.text))  = 'NOVA S COTIA') Or
  14376       (Upper case(Trim( StateFake. Text)) = ' PRINCE EDW ARD ISLAND ') Or (Upp ercase(Tri m(StateFak e.text)) =  'NEW BRUN SWICK') Or  (Uppercas e(Trim(Sta teFake.tex t)) = 'ONT ARIO') Or
  14377       (Upper case(Trim( StateFake. Text)) = ' MANITOBA')  Or (Upper case(Trim( StateFake. text)) = ' SASKATCHEW AN') Or (U ppercase(T rim(StateF ake.text))  = 'ALBERT A') Or
  14378       (Upper case(Trim( StateFake. text)) = ' BRITISH CO LUMBIA') O r (Upperca se(Trim(St ateFake.te xt)) = 'YU KON TERRIT ORY') Or ( Uppercase( Trim(State Fake.text) ) = 'NORTH WEST TERRI TORIES') O r
  14379       (Upper case(Trim( StateFake. text)) = ' NUNAVUT')  Then
  14380     Begin
  14381       FMEdit Zip.Text : = '@';
  14382       FMEdit Zip.Visibl e := False ;
  14383     End
  14384     Else
  14385     Begin
  14386       FMEdit Zip.Visibl e := True;
  14387       If FME ditZip.Tex t = '@' Th en
  14388         FMEd itZip.Text  := '';
  14389     End;
  14390  
  14391   End;
  14392  
  14393   Procedure  TfrmMain.B uttonCount yAcceptCli ck(Sender:  TObject);
  14394   Begin
  14395     FMEditCo unty.Text  := '`' + F MCountiesL ist.GetSel ectedRecor d.IEN;
  14396     CountyFa ke.Text :=  FMCountie sList.Item s[FMCounti esList.Ite mIndex];
  14397     FMCounti esList.Vis ible := Fa lse;
  14398     ButtonCo untyAccept .Visible : = False;
  14399   End;
  14400  
  14401   Procedure  TfrmMain.B uttonSearc hClick(Sen der: TObje ct);
  14402   Var
  14403     xx, yy:  integer;
  14404     foundfla g: boolean ;
  14405     foundat:  integer;
  14406     tempstri ng, tempst ring2: Str ing;
  14407   Begin
  14408     If EditS earchPN.Te xt = '' Th en
  14409     Begin
  14410       Tab95C ontrol1Cha nge(Applic ation);
  14411       exit;
  14412     End;
  14413     If lstDo cs.ItemInd ex = -1 Th en
  14414     Begin
  14415       exit;
  14416     End;
  14417     If (Sear chRunning  = 0) Or (S earchRunni ng = 99) T hen
  14418       If Edi tSearchPN. Text = Las tSearch Th en
  14419       Begin
  14420         foun dat := mem oDocs.Find Text(editS earchPN.Te xt, lastSe archFoundA t, length( memoDocs.T ext), []);
  14421         If F oundAt <>  -1 Then
  14422         Begi n
  14423           Tr y
  14424           me moDocs.Set Focus Exce pt
  14425           En d;
  14426           // First jump  to bottom .
  14427           me moDocs.Sel Start := l ength(memo Docs.Text)  - 2;
  14428           me moDocs.Sel Length :=  2;
  14429           te mpString : = memoDocs .SelText;
  14430           me moDocs.Sel Text := '' ;
  14431           me moDocs.sel text := te mpstring;
  14432           // Now find t ext
  14433           me moDocs.Sel Start := F oundAt;
  14434           me moDocs.Sel Length :=  Length(edi tSearchPN. Text);
  14435           te mpstring2  := memoDoc s.SelText;
  14436           //  Force jum p to secti on
  14437           me moDocs.Sel Text := te mpString2;
  14438           //  Re-Highli ght
  14439           me moDocs.Sel Start := F oundAt;
  14440           me moDocs.Sel Length :=  Length(edi tSearchPN. Text);
  14441           //  Scroll do wn a few l ines
  14442           la stSearchFo undAt := f oundat + l ength(edit SearchPN.T ext);
  14443           Se archRunnin g := 99;
  14444           // SearchRunn ing:=99; / / Force se lection of  text
  14445         End
  14446         Else
  14447         Begi n                                                                            // Go to n ext record
  14448           If  lstDocs.I temIndex <  lstDocs.I tems.Count  - 1 Then
  14449           Be gin
  14450              SearchRunn ing := 0;
  14451              lstDocs.It emIndex :=  lstDocs.I temIndex +  1;
  14452              lstDocsCli ck(Applica tion);
  14453              //ButtonSe archClick( Applicatio n);
  14454              //exit;
  14455           En d
  14456           El se
  14457           Be gin
  14458              editSearch PN.Text :=  '';
  14459              ShowMessag eCAPRI('No  more reco rds to sea rch.  Clic k "SEARCH"  again to  re-load th e previous  list of d ocuments.' );
  14460           En d;
  14461         End;
  14462         exit ;
  14463       End;
  14464     Tab95Con trol1.Enab led := Fal se;
  14465     Page95Co ntrol1.Ena bled := Fa lse;
  14466     ButtonCl inDocDateR ange.Enabl ed := Fals e;
  14467     ButtonCl inDocDateR ange.Capti on := 'Sea rched Docu ments';
  14468     //Masked it1.Text:= '1000000';
  14469     //MaskEd it1Change( Applicatio n);
  14470  
  14471     // Cycle  through a ll documen ts to see  which have  the searc h term in  them.
  14472     // Delet e the ones  without t he search  term from  the list o n the left .
  14473     If lstDo cs.Items.C ount > 0 T hen
  14474     Begin
  14475       For xx  := lstDoc s.Items.Co unt - 1 Do wnto 0 Do
  14476       Begin
  14477         Sear chRunning  := 1;
  14478         lstD ocs.ItemIn dex := xx;
  14479         lstD ocsClick(A pplication );
  14480         foun dflag := f alse;
  14481         If m emoDocs.Li nes.Count  > 0 Then
  14482           Fo r yy := 0  To memoDoc s.Lines.Co unt - 1 Do
  14483              If Pos(upp ercase(Edi tSearchPN. Text), upp ercase(mem oDocs.Line s[yy])) >  0 Then
  14484                foundfla g := true;
  14485         If f oundflag =  false The n
  14486           ls tDocs.Item s.Delete(x x);
  14487         appl ication.Pr ocessMessa ges;
  14488         memo Docs.Repai nt;
  14489         lstD ocs.Repain t;
  14490         appl ication.Pr ocessMessa ges;
  14491       End;
  14492     End
  14493     Else
  14494     Begin
  14495       memoDo cs.Lines.C lear;
  14496       memoDo cs.Lines.A dd('No ite ms found!' );
  14497       Tab95C ontrol1.En abled := T rue;
  14498       Page95 Control1.E nabled :=  True;
  14499       Button ClinDocDat eRange.Ena bled := Tr ue;
  14500       LastSe arch := ed itSearchPN .Text;
  14501       Search Running :=  0;
  14502       exit;
  14503     End;
  14504     SearchRu nning := 0 ;
  14505     Tab95Con trol1.Enab led := Tru e;
  14506     Page95Co ntrol1.Ena bled := Tr ue;
  14507     ButtonCl inDocDateR ange.Enabl ed := True ;
  14508     LastSear ch := edit SearchPN.T ext;
  14509     If lstdo cs.Items.C ount = 0 T hen
  14510     Begin
  14511       memoDo cs.Lines.C lear;
  14512       memoDo cs.Lines.A dd('No ite ms found t hat meet s earch crit eria!');
  14513       exit;
  14514     End;
  14515     lstdocs. ItemIndex  := 0;
  14516     lstDocs. Selected[0 ] := TRUE;                                                        //-MER Cod eCR126 7/2 010
  14517     lstDocsC lick(Appli cation);
  14518   End;
  14519  
  14520   Procedure  TfrmMain.R eportMemoE nter(Sende r: TObject );
  14521   Begin
  14522     actEditU pdate(Appl ication);
  14523   //  Edit1C lick(Appli cation);
  14524   End;
  14525  
  14526   Procedure  TfrmMain.H SMemoEnter (Sender: T Object);
  14527   Begin
  14528     actEditU pdate(Appl ication);
  14529   //  Edit1C lick(Appli cation);
  14530   End;
  14531  
  14532   Procedure  TfrmMain.m emoDocsCha nge(Sender : TObject) ;
  14533   Begin
  14534     SetFont;
  14535     actEditU pdate(Appl ication);
  14536     //  Edit 1Click(App lication);
  14537   End;
  14538  
  14539   Procedure  TfrmMain.M emoAppoint mentsEnter (Sender: T Object);
  14540   Begin
  14541     actEditU pdate(Appl ication);
  14542   //  Edit1C lick(Appli cation);
  14543   End;
  14544  
  14545   Procedure  TfrmMain.m emoDocsEnt er(Sender:  TObject);
  14546   Begin
  14547     actEditU pdate(Appl ication);
  14548   //  Edit1C lick(Appli cation);
  14549   End;
  14550  
  14551   Procedure  TfrmMain.P opupReadon lyRichedit Popup(Send er: TObjec t);
  14552   Begin
  14553     actEditU pdate(Appl ication);
  14554   //  Edit1C lick(Appli cation);
  14555   End;
  14556  
  14557   {========= ========== ========== ========== ========== ========== ========== ====
  14558    GetPatien tProfileMA S
  14559    This proc edure retr ieves the  patient pr ofile MAS  report dat a.
  14560    Input: aD FN - patie nt IEN
  14561  
  14562    CodeCR85  - rpm 4/13 /10
  14563    ========= ========== ========== ========== ========== ========== ========== ====}
  14564  
  14565   procedure  TfrmMain.G etPatientP rofileMAS( aDFN: Stri ng);
  14566   var
  14567     x: integ er;
  14568   begin
  14569     AnimateL ogo(True);
  14570     StatusBa rLoadPt.Ca ption := ' Downloadin g report.' ;
  14571     StatusBa rLoadPt.Re paint;
  14572     Applicat ion.Proces smessages;
  14573  
  14574     frmMain. RPCBroker1 .RemotePro cedure :=  'DVBAB REP ORTS';                           //PATIENT  PROFILE
  14575     frmMain. RPCBroker1 .Param[1]. PType := l iteral;
  14576     frmMain. RPCBroker1 .Param[1]. Value := ' 7';
  14577     frmMain. RPCBroker1 .Param[2]. PType := l iteral;
  14578     frmMain. RPCBroker1 .Param[2]. Value := a DFN + '^'
  14579       + frmP atientProf ileMAS.Get DateRange  + '^'
  14580       + IntT oStr(Ord(f rmPatientP rofileMAS. IsShowAppt s)) + '^'
  14581       + IntT oStr(Ord(f rmPatientP rofileMAS. IsShowEdit s)) + '^'
  14582       + IntT oStr(Ord(f rmPatientP rofileMAS. IsShowEnro llment)) +  '^'
  14583       + IntT oStr(Ord(f rmPatientP rofileMAS. IsShowDisp ositions))  + '^'
  14584       + IntT oStr(Ord(f rmPatientP rofileMAS. IsShowTeam )) + '^'
  14585       + IntT oStr(Ord(f rmPatientP rofileMAS. IsShowMean sTest));
  14586  
  14587     frmMain. RPCBrokerC all;
  14588     try
  14589       frmMai n.RPCBroke r1.Call;
  14590     except
  14591       On EBr okerError  Do
  14592       begin
  14593         ANUR emoteProce dureCallin Progress : = False;
  14594         Show MessageCAP RI('RPC DV BAB REPORT S (Patient  Profile)  could not  be accesse d!');
  14595       end;
  14596     end;
  14597     QuickCop y(frmMain. RPCBroker1 .Results,  ReportMemo );
  14598     if Repor tMemo.Line s.Count >  0 then
  14599       for x  := Reportm emo.Lines. Count - 1  downto 0 d o
  14600         if R eportMemo. Lines[x] =  '-------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ----' Then
  14601           Re portMemo.L ines[x] :=  Copy(Repo rtMemo.Lin es[x], 1,  78);
  14602  
  14603     if Repor tMemo.Line s.count =  0 then
  14604       Report Memo.Lines .Add('No d ata found  for reques ted report  criteria. ');
  14605     ReportMe mo.SelStar t := 0;
  14606     ReportMe mo.SelLeng th := 0;
  14607     AnimateL ogo(False) ;
  14608     StatusBa rLoadPt.Ca ption := ' Done.';
  14609     StatusBa rLoadPt.Re paint;
  14610     Applicat ion.Proces smessages;
  14611     ReportMe mo.Setfocu s;
  14612   end;
  14613  
  14614  
  14615   Procedure  TfrmMain.M yTempExcep tionHandle r(Sender:  TObject; E : Exceptio n);
  14616   Begin
  14617     (*
  14618      if (pos ('Read of  address',e .message)> 0) and (De bugSQA=Tru e) then be gin
  14619        Showm essageCAPR I('SQA Err or Trap: ' +e.message );
  14620        exit;
  14621      end;
  14622      if (pos ('Read of  address',e .message)> 0) and (De bugSQA<>Tr ue) then b egin
  14623        exit;
  14624      end;
  14625      *)
  14626  
  14627       // Set  cursor to  default w henever th ere's an e xception
  14628     screen.c ursor := c rDefault;
  14629     // Do no thing
  14630   //  If Shu ttingDown= True then  exit;
  14631     //clipbr d.Clipboar d.SetTextB uf(Pchar(E .message)) ;
  14632     (*
  14633     If (Pos( 'XMEMOCODE ',uppercas e(E.messag e))=0) and
  14634        (Pos( 'XMEMOERRO RS',upperc ase(E.mess age))=0) a nd
  14635        (Pos( 'ACCESS VI OLATION',u ppercase(E .message)) =0) and
  14636        (Pos( 'Access vi olation at  address 0 04034F2 in  module',E .message)< 1) and
  14637        (E.me ssage<>'Ac cess viola tion at ad dress 0000 0000. Read  of addres s 00000000 ') and
  14638        (E.me ssage<>'Ca nnot chang e Visible  in OnShow  or OnHide' ) and
  14639        (E.me ssage<>'Ca nnot focus  a disable d or invis ible windo w')
  14640       // (E. message<>' Cannot mak e a visibl e window m odal')
  14641      then
  14642   *)
  14643     ShowMess ageCAPRI(E .message);
  14644   End;
  14645  
  14646   Procedure  KillProces s(hWindowH andle: int eger);
  14647   Var
  14648     hprocess ID: INTEGE R;
  14649     processH andle: THa ndle;
  14650     //DWResu lt: DWORD;
  14651   Begin
  14652     //SendMe ssageTimeo ut(hWindow Handle, WM _CLOSE, 0,  0,
  14653     //  SMTO _ABORTIFHU NG Or SMTO _NORMAL, 5 000, DWRes ult);
  14654  
  14655     If isWin dow(hWindo wHandle) T hen
  14656     Begin
  14657       // Pos tMessage(h WindowHand le, WM_QUI T, 0, 0);
  14658  
  14659       { Get  the proces s identifi er for the  window}
  14660       GetWin dowThreadP rocessID(h WindowHand le, @hproc essID);
  14661       If hpr ocessID <>  0 Then
  14662       Begin
  14663         { Ge t the proc ess handle  }
  14664         proc essHandle  := OpenPro cess(PROCE SS_TERMINA TE Or PROC ESS_QUERY_ INFORMATIO N,
  14665           Fa lse, hproc essID);
  14666         If p rocessHand le <> 0 Th en
  14667         Begi n
  14668           {  Terminate  the proces s }
  14669           Te rminatePro cess(proce ssHandle,  0);
  14670           Cl oseHandle( ProcessHan dle);
  14671         End;
  14672       End;
  14673     End;
  14674   End;
  14675  
  14676   Procedure  TfrmMain.F ormClose(S ender: TOb ject; Var  Action: TC loseAction );
  14677   Var
  14678     AppExcep tionFilena me: String ;
  14679     fileList : TStringL ist;
  14680     fileList DateCreate d: TString List;
  14681     FileName : String;
  14682     i: integ er;
  14683     j: integ er;
  14684     SaveHist oryFilenam e: String;
  14685     tempstri ng: String ;
  14686     x: integ er;
  14687  
  14688     Procedur e ListFile Dir(Path:  String; Fi leList: TS trings; Fi leListDate Created: T Strings);
  14689     Var
  14690       SR: TS earchRec;
  14691       lft: T FileTime;
  14692     Begin
  14693       If Fin dFirst(Pat h + '*.*',  faAnyFile , SR) = 0  Then
  14694       Begin
  14695         Repe at
  14696           Tr y
  14697              If (SR.Att r <> faDir ectory) Th en
  14698              Begin
  14699                FileList .Add(SR.Na me);
  14700                FileTime ToLocalFil eTime(SR.F indData.ft CreationTi me, lft);
  14701                FileList DateCreate d.Add(Floa tToStr(Fil eTimeToDat eTime(SR.F indData.ft LastWriteT ime)));
  14702              End;
  14703           Ex cept
  14704              messagebee p(0);
  14705           En d;
  14706         Unti l FindNext (SR) <> 0;
  14707         Find Close(SR);
  14708       End;
  14709     End;
  14710   Begin
  14711     RecordAu dit('Shutt ing down C APRI', 'Au dit');
  14712     Action : = caFree;
  14713     frmMain. Visible :=  false;
  14714     Try If f rmMain.Tag  = 12613 T hen frmMai n.OnCloseQ uery := ni l; Except  End;
  14715     // Clean  up old fo rm files.  Delete any  over 120  days old.
  14716     FileList  := TStrin gList.Crea te;
  14717     FileList DateCreate d := TStri ngList.Cre ate;
  14718     ListFile Dir(tempdi r, FileLis t, FileLis tDateCreat ed);
  14719     Try
  14720       If Fil eList.Coun t > 0 Then
  14721         For  x := 0 To  FileList.C ount - 1 D o
  14722         Begi n
  14723           {  get file n ames with  dates grea ter than 1 4 days thr ough 30 da ys old }
  14724           Fo r j := 14  To 180 Do                                                         { Iterate  }
  14725           Be gin
  14726              FileCreate NameForApp licationEx ceptionLog (AppExcept ionFilenam e, j);
  14727              FileName : = FileList .Strings[x ];
  14728              { CAPRI RE PORT BACKU PS }
  14729              If Pos('CA PRI_REPORT ', UpperCa se(FileNam e)) > 0 Th en
  14730                If (StrT oFloat(Fil eListDateC reated[x])  < date -  14) Then
  14731                  Delete File(tempd ir + FileL ist.String s[x]);
  14732              { SAVE HIS TORY FILE  }
  14733              If (StrCom p(PChar(Up perCase(Fi leList.Str ings[x])),  PChar(Upp erCase(App ExceptionF ilename)))  = 0) Then
  14734                If (StrT oFloat(Fil eListDateC reated[x])  < date -  14) Then
  14735                  Delete File(tempd ir + FileL ist.String s[x]);
  14736              FileCreate NameForSav eHistoryLo g(SaveHist oryFilenam e, j);
  14737              FileDelete OldSaveHis tory(FileL ist.String s[x], File ListDateCr eated[x],  SaveHistor yFilename) ;
  14738           En d;                                                                           { for }
  14739           //  if third  piece is " zip then i t's probab ly a form  file
  14740           If  (uppercas e(piece(Fi leList.Str ings[x], ' .', 3)) =  'ZIP') And  (piece(Fi leList.Str ings[x], ' .', 4) = ' ') Then
  14741           Be gin
  14742              //get file name witho ut extensi on
  14743              tempstring  := piece( FileList.S trings[x],  '.', 1);
  14744              // Check f or existen ce of "~"  and "^" ju st to be s ure it's a  form file
  14745              If (pos('~ ', tempstr ing) > 0)  And (pos(' ^', tempst ring) > 0)  Then
  14746              Begin
  14747                // Check  if older  than 90 da ys.
  14748                If StrTo Float(File ListDateCr eated[x])  < date - 9 0 Then
  14749                Begin
  14750                  Try
  14751                  Delete File(tempd ir + FileL ist.String s[x])Excep t
  14752                  End;
  14753                  Try
  14754                  Delete File(tempd ir + FileL ist.String s[x] + '.p nl.cde')Ex cept
  14755                  End;
  14756                  Try
  14757                  Delete File(tempd ir + FileL ist.String s[x] + '.p nl.frm')Ex cept
  14758                  End;
  14759                  Try
  14760                  Delete File(tempd ir + FileL ist.String s[x] + '.p nl.rep')Ex cept
  14761                  End;
  14762                End
  14763                Else
  14764                Begin
  14765                  // New er file fo und
  14766                End;
  14767  
  14768              End;
  14769           En d;
  14770         End;                                                                              { FOR  }
  14771     Finally
  14772       frmMai n.windowst ate := wsN ormal;                                                 // restore  if minimi zed or max imized
  14773       SaveCA PRISetting s;
  14774       Shutti ngDown :=  True;
  14775       //Rele ase all th e voice de scriptors
  14776       If ass igned(frmP roperties)  Then
  14777         For  I := 0 To  frmPropert ies.combob oxVoice.It ems.Count  - 1 Do
  14778           IS peechObjec tToken(Poi nter(frmPr operties.c omboboxVoi ce.Items.O bjects[I]) )._Release ;
  14779       Try
  14780       SPVoic e1.Disconn ect Except  End;
  14781       Try If  assigned( FPatientIn foBucket)  Then FreeA ndNil(FPat ientInfoBu cket)Excep t End;
  14782       Try If  assigned( FileList)  Then FreeA ndNil(File List)Excep t End;
  14783       Try If  assigned( FileListDa teCreated)  Then Free AndNil(Fil eListDateC reated)Exc ept End;
  14784       Try If  assigned( frmEditPat ientLists)  Then Free AndNil(frm EditPatien tLists)Exc ept End;
  14785       Try If  assigned( frmTelnet)  Then Free AndNil(frm Telnet)Exc ept End;
  14786       Try If  assigned( frmMacroEd itor) Then  FreeAndNi l(frmMacro Editor)Exc ept End;
  14787       Try If  assigned( formPrintC onfirm) Th en FreeAnd Nil(formPr intConfirm )Except En d;
  14788       Try If  assigned( formPrint)  Then Free AndNil(for mPrint)Exc ept End;
  14789       Try If  assigned( formNews)  Then FreeA ndNil(form News)Excep t End;
  14790       Try If  assigned( frmSpellCh eck) Then  FreeAndNil (frmSpellC heck)Excep t End;
  14791       Try If  assigned( frm508Mess ages) Then  FreeAndNi l(frm508Me ssages)Exc ept End;
  14792       Try If  assigned( frmLabGrap h) Then Fr eeAndNil(f rmLabGraph )Except En d;
  14793       Try If  assigned( formEssoSe lect) Then  FreeAndNi l(formEsso Select)Exc ept End;
  14794       Try If  assigned( frmPropert ies) Then  FreeAndNil (frmProper ties)Excep t End;
  14795       Try If  assigned( frmROFinde r) Then Fr eeAndNil(f rmROFinder )Except En d;
  14796       Try If  assigned( frmZipCode s) Then Fr eeAndNil(f rmZipCodes )Except En d;
  14797       Try If  assigned( FormTIUDis play) Then  FreeAndNi l(FormTIUD isplay)Exc ept End;
  14798       Try If  assigned( FormReport Builder) T hen FreeAn dNil(FormR eportBuild er)Except  End;
  14799       Try If  assigned( frmMailMan ) Then Fre eAndNil(fr mMailMan)E xcept End;
  14800       Try If  assigned( ContextorC ontrol) Th en FreeAnd Nil(Contex torControl )Except En d;
  14801       Try If  assigned( uHSCompone nts) Then  FreeAndNil (uHSCompon ents)Excep t End;
  14802       Try If  assigned( TempHSMemo ) Then Fre eAndNil(Te mpHSMemo)E xcept End;
  14803       Try If  assigned( listMedica lCenterDiv ision) The n FreeAndN il(listMed icalCenter Division)E xcept End;
  14804       Try If  assigned( listlabTes tNames) Th en FreeAnd Nil(listla bTestNames )Except En d;
  14805       Try If  assigned( UserKeys)  Then FreeA ndNil(User Keys)Excep t End;
  14806       Try If  assigned( listDocs)  Then FreeA ndNil(list Docs)Excep t End;
  14807       Try If  assigned( listExams)  Then Free AndNil(lis tExams)Exc ept End;
  14808       Try If  assigned( ListRestri ctedPatien ts) Then F reeAndNil( ListRestri ctedPatien ts)Except  End;
  14809       Try If  assigned( SurgeryRep orts) Then  FreeAndNi l(SurgeryR eports)Exc ept End;
  14810       Try If  assigned( uLocalRepo rtData) Th en FreeAnd Nil(uLocal ReportData )Except En d;
  14811       Try If  assigned( frmReports ) Then Fre eAndNil(fr mReports)E xcept End;
  14812       Try If  assigned( frmSearchT ext) then  FreeAndNil (frmSearch Text)Excep t End;     //CodeCR69 6 JRL 4/8/ 15
  14813       Try
  14814         If a ssigned(fr mReports)  Then
  14815         Begi n
  14816           Fr eeAndNil(f rmReports) ;
  14817         End;
  14818       Except
  14819       End;
  14820       try                                                                                 // CodeCR1 85 -MER 04 /2011
  14821         if A ssigned(Re flectionWr apper) the n begin
  14822           tr y
  14823              if Reflect ionWrapper .IsRunning  then
  14824                Reflecti onWrapper. TerminateE mulator;
  14825           fi nally
  14826              Reflection Wrapper.Fr ee;
  14827           en d;
  14828         end;
  14829       except
  14830         // d o nothing
  14831       end;
  14832       Try If  assigned( VocRehab)  Then FreeA ndNil(VocR ehab)Excep t End;                //CodeCR34 7 - JRL 5/ 22/12
  14833     End;
  14834     Try Kill Process(Ap plication. Handle); E xcept End;
  14835   End;
  14836  
  14837   Procedure  TfrmMain.S aveCAPRISe ttings;
  14838   Var
  14839     maxFlag:  Boolean;
  14840     x: integ er;
  14841     lslConfi g: TString List;                                                             // CodeCR1 68 -MER 04 /2011
  14842  
  14843     {
  14844       Return  TColor va lue in XXX XXX format
  14845       (X bei ng a hex d igit)
  14846     }
  14847  
  14848     Function
  14849         TCol orToHex(Co lor: TColo r)
  14850         : St ring;
  14851     Begin
  14852       Result  :=
  14853         { re d value }
  14854       IntToH ex(GetRVal ue(Color),  2) +
  14855         { gr een value  }
  14856       IntToH ex(GetGVal ue(Color),  2) +
  14857         { bl ue value }
  14858       IntToH ex(GetBVal ue(Color),  2);
  14859     End;
  14860  
  14861   Begin
  14862     If frmMa in.WindowS tate = wsM aximized T hen
  14863       maxfla g := true
  14864     Else
  14865       maxfla g := false ;
  14866     // CodeC R168 -MER  04/2011  P reviously,  a memoBox  was used  to save th e config
  14867     // infor mation.  T his result ed in prob lems when  the line w idth was g reater
  14868     // than  what the c ontrol cou ld contain .  The mem oBox has b een replac ed with
  14869     // a str inglist
  14870     lslConfi g := TStri ngList.Cre ate;
  14871     try
  14872       lslCon fig.Clear;
  14873       lslCon fig.Add(In tToStr(frm Main.Top)) ;
  14874       lslCon fig.Add(In tToStr(frm Main.Left) );
  14875       lslCon fig.Add(In tToStr(frm Main.Width ));
  14876       lslCon fig.Add(In tToStr(frm Main.Heigh t));
  14877       If max flag = tru e Then
  14878         lslC onfig.Add( 'WSMAXIMIZ ED')
  14879       Else
  14880         lslC onfig.Add( 'WSNORMAL' );
  14881       lslCon fig.Add(In tToStr(lst docs.width ));                                         //Clinical  docs slid er size
  14882       lslCon fig.Add(In tToStr(ORH ealthSumma ryUserList .width));                        //Health S ummary sli der size
  14883       lslCon fig.Add(In tToStr(ORR eportsAvai lable.widt h));                             //Reports  Tab slider  size
  14884       //Font  size
  14885       lslCon fig.Add(Fo ntDialog1. Font.Name) ;                                           //Font
  14886       lslCon fig.Add(In tToStr(Fon tDialog1.F ont.Size)) ;                                //Size
  14887       If Fon tDialog1.F ont.style  = [fsBold]  Then
  14888         lslC onfig.Add( 'TRUE')
  14889       Else
  14890         lslC onfig.Add( 'FALSE');
  14891       If Fon tDialog1.F ont.style  = [fsitali c] Then
  14892         lslC onfig.Add( 'TRUE')
  14893       Else
  14894         lslC onfig.Add( 'FALSE');
  14895       If Fon tDialog1.F ont.style  = [fsUnder line] Then
  14896         lslC onfig.Add( 'TRUE')
  14897       Else
  14898         lslC onfig.Add( 'FALSE');
  14899       If Fon tDialog1.F ont.style  = [fsStrik eout] Then
  14900         lslC onfig.Add( 'TRUE')
  14901       Else
  14902         lslC onfig.Add( 'FALSE');
  14903       //appl ication.pr ocessmessa ges;
  14904       //Keyb oard Sensi tivity
  14905       If ass igned(frmP roperties)  Then
  14906         lslC onfig.Add( IntToStr(f rmProperti es.ScrollB arKeyboard Sensitivit y.Position ));
  14907       // Las t selected
  14908       //appl ication.pr ocessmessa ges;
  14909       If Ess oVersion =  True Then
  14910       Begin
  14911         lslC onfig.Add( Uppercase( RemoteSite Name));
  14912       End
  14913       Else
  14914         lslC onfig.Add( '');
  14915       //appl ication.pr ocessmessa ges;
  14916       //Addr ess Info
  14917       If Mem oNameAddre ssHolder.L ines.Count  > 0 Then
  14918       Begin
  14919         For  x := 0 To  MemoNameAd dressHolde r.Lines.Co unt - 1 Do
  14920           ls lConfig.Ad d('~' + Me moNameAddr essHolder. Lines[x]);
  14921       End
  14922       Else
  14923         lslC onfig.Add( '^NONE^');
  14924  
  14925       // Tel net Window  Settings
  14926       If ass igned(frmT elnet) The n
  14927       Begin
  14928         lslC onfig.Add( inttostr(f rmTelnet.W idth));
  14929         lslC onfig.Add( inttostr(f rmTelnet.H eight));
  14930         lslC onfig.Add( inttostr(f rmTelnet.L eft));
  14931         lslC onfig.Add( inttostr(f rmTelnet.T op));
  14932         lslC onfig.Add( inttostr(f rmTelnet.I PTerminal1 .Font.Size ));
  14933         lslC onfig.Add( frmTelnet. IPTerminal 1.Font.Nam e);
  14934         lslC onfig.Add( TColorToHe x(ipc_Term BufForeCol or));
  14935         lslC onfig.Add( TColorToHe x(ipc_Term BufBackCol or));
  14936       End;
  14937  
  14938       // Spe ech Settin gs
  14939       If ass igned(frmP roperties)  Then
  14940       Begin
  14941         lslC onfig.Add( frmPropert ies.Combob oxVoice.It ems[frmPro perties.Co mboboxVoic e.ItemInde x]);
  14942         lslC onfig.Add( IntToStr(f rmProperti es.TrackBa rSpeechRat e.Position ));
  14943         lslC onfig.Add( IntToStr(f rmProperti es.TrackBa rSpeechVol ume.Positi on));
  14944         If f rmProperti es.CheckBo xActivateS peechPromp ts.Checked  = True Th en
  14945           ls lConfig.Ad d('TRUE')
  14946         Else
  14947           ls lConfig.Ad d('FALSE') ;
  14948       End;
  14949  
  14950       Try
  14951  
  14952  
  14953  
  14954  
  14955  
  14956       lslCon fig.SaveTo File('c:\c apri.cfg') Except
  14957       End;
  14958     finally
  14959       lslCon fig.Free;
  14960     end;
  14961   End;
  14962  
  14963   Procedure  TfrmMain.F ormActivat e(Sender:  TObject);
  14964   var tempCl ientItem:  TActionCli entItem;
  14965   Begin
  14966     StatusBa rLoadPt.Ca ption := ' Ready.';
  14967     Invalida te;
  14968     If Not A uditInProg ress Then
  14969       If Swi tchToSite  = '' Then
  14970         If E SSOConnect ing <> Tru e Then
  14971           Ap pStarted : = True;
  14972  
  14973  
  14974     tempClie ntItem :=  ActionManM ain.FindIt emByCaptio n('&Develo per');
  14975     If (File Exists(Tem pDir + 'ca priqrzdev. txt')) and  (Assigned (tempClien tItem)) Th en
  14976       tempCl ientItem.V isible :=  True
  14977     else if  Assigned(t empClientI tem) then
  14978       tempCl ientItem.V isible :=  False;
  14979     UpdateEd itBoxesFor ScreenRead er(self);                                              // -MER Co deCR120 8/ 2010
  14980   End;
  14981  
  14982   Procedure  TfrmMain.b tnLoadHSNa mesRemoteD ataClick(S ender: TOb ject);
  14983   Var
  14984     x: integ er;
  14985     deletefl ag: intege r;
  14986   Begin
  14987     If ANURe moteProced ureCallInP rogress =  True Then
  14988       exit;
  14989  
  14990     HSMemo.L ines.Clear ;
  14991     HSMemoLo cal.Lines. Clear;
  14992     frmMain. RPCBroker1 .Results.C lear;
  14993  
  14994     {Get HEA LTH SUMMAR Y TYPES us ing ORWRP  REPORT LIS TS CPRS Br oker Call}
  14995     RPCBroke r1.RemoteP rocedure : = 'ORWRP R EPORT LIST S';
  14996     Try
  14997     RPCBroke r1.Call Ex cept On EB rokerError  Do
  14998       Try
  14999       RPCBro ker1.Call  Except On  EBrokerErr or Do
  15000         Try
  15001         RPCB roker1.Cal l Except O n EBrokerE rror Do
  15002           Be gin
  15003              ANURemoteP rocedureCa llInProgre ss := Fals e;
  15004              frmMain.Sh ow;
  15005              Applicatio n.BringToF ront;
  15006              ShowMessag eCAPRI('RP C Broker c onnection  error!');
  15007           En d;
  15008         End;
  15009       End;
  15010     End;
  15011  
  15012     Repeat
  15013       RPCBro ker1.Resul ts.Delete( 0);
  15014     Until RP CBroker1.R esults[0]  = '[HEALTH  SUMMARY T YPES]';
  15015     RPCBroke r1.Results .Delete(0) ;
  15016     DeleteFl ag := -1;
  15017     If RPCBr oker1.Resu lts.Count  > 0 Then
  15018     Begin
  15019       For x  := 0 To RP CBroker1.R esults.Cou nt - 1 Do
  15020       Begin
  15021         If ( RPCBroker1 .Results[x ] = '$$END ') And (De leteFlag =  -1) Then
  15022           De leteFlag : = x;
  15023       End;
  15024       For x  := RPCBrok er1.Result s.Count -  1 Downto D eleteFlag  Do
  15025         RPCB roker1.Res ults.Delet e(x);
  15026  
  15027       ORHeal thSummaryU serList.It ems.Clear;
  15028       lbHeal thSummaryL ist.Items. Clear;
  15029       If RPC Broker1.Re sults.Coun t > 0 Then
  15030         For  x := 0 To  RPCBroker1 .Results.C ount - 1 D o
  15031         Begi n
  15032           If  Pos('ADHO C REPORT',  UpperCase (Piece(RPC Broker1.Re sults[x],  '^', 2)))  <> 1 Then
  15033           Be gin
  15034              lbHealthSu mmaryList. Items.Add( Copy(Piece (RPCBroker 1.Results[ x], '^', 1 ), 2, 99)) ; // Strip  off the f irst chara cter of "h "
  15035              ORHealthSu mmaryUserL ist.Items. Add(Piece( RPCBroker1 .Results[x ], '^', 2) );
  15036              //ShowMess ageCAPRI(R PCBroker1. Results[x] +'  '+(Cop y(Piece(RP CBroker1.R esults[x], '^',1),2,9 9))+'  '+( Piece(RPCB roker1.Res ults[x],'^ ',2)));
  15037           En d;
  15038         End;
  15039     End;
  15040  
  15041   End;
  15042  
  15043   Procedure  TfrmMain.B utton4Clic k(Sender:  TObject);
  15044   Var
  15045     x: integ er;
  15046   Begin
  15047     If Check ListBoxRem oteData.It ems.Count  > 0 Then
  15048       For x  := 0 To Ch eckListBox RemoteData .Items.Cou nt - 1 Do
  15049         Chec kListBoxRe moteData.C hecked[x]  := True;
  15050   End;
  15051  
  15052   Procedure  TfrmMain.B utton3Clic k(Sender:  TObject);
  15053   Var
  15054     x: integ er;
  15055     flag: bo olean;
  15056  
  15057   Begin
  15058     flag :=  false;
  15059     If check listboxRem oteData.It ems.Count  > 0 Then
  15060       For x  := 0 To ch ecklistbox RemoteData .Items.Cou nt - 1 Do
  15061         If c heckListbo xRemoteDat a.Checked[ x] Then
  15062           If  Piece(Lis tBoxRemote Data.Items [x], '^',  1) = '200'  Then
  15063              flag := tr ue;
  15064     If flag  = true The n
  15065     Begin
  15066       ShowMe ssageCAPRI ('RDV cann ot be run  on DoD/FHI E systems! ');
  15067       exit;
  15068     End;
  15069  
  15070     Tab95Con trol2.Tabs .Clear;
  15071     Tab95Con trol2.Tabs .Add('Loca l');
  15072     PanelRem oteData.Vi sible := F alse;
  15073     flag :=  False;
  15074     If check listboxRem oteData.It ems.Count  > 0 Then
  15075       For x  := 0 To ch ecklistbox RemoteData .Items.Cou nt - 1 Do
  15076         If c heckListbo xRemoteDat a.Checked[ x] Then
  15077         Begi n
  15078           fl ag := true ;
  15079           Ta b95Control 2.Tabs.Add (Piece(Lis tBoxRemote Data.Items [x], '^',  2));
  15080         End;
  15081     If flag  = true The n
  15082       btnLoa dHSNamesRe moteDataCl ick(Applic ation)
  15083     Else
  15084       btnLoa dHSNamesCl ick(Applic ation);
  15085   End;
  15086  
  15087   Procedure  TfrmMain.B uttonRDVCl ick(Sender : TObject) ;
  15088   Var
  15089     x: integ er;
  15090     a, b: St ring;
  15091   Begin
  15092     If ListB oxRemoteDa taPending. Items.Coun t > 0 Then
  15093     Begin
  15094       ShowMe ssageCAPRI ('This opt ion cannot  be select ed while r emote repo rts are pe nding.');
  15095       exit;
  15096     End;
  15097     PanelRem oteData.Vi sible := T rue;
  15098     PanelRem oteData.Br ingToFront ;
  15099     RPCBroke r1.RemoteP rocedure : = 'ORWCIRN  FACLIST';
  15100     RPCBroke r1.Param[0 ].Value :=  PatientIE N;
  15101     RPCBroke r1.Param[0 ].PType :=  literal;
  15102     RPCBroke rCall;
  15103     Try
  15104       RPCBro ker1.Call;
  15105     Except
  15106       On EBr okerError  Do
  15107       Begin
  15108         ANUR emoteProce dureCallIn Progress : = False;
  15109         Anim ateLogo(Fa lse);
  15110         Stat usBarLoadP t.Caption  := 'RPC OR WCIRN FACL IST could  not be acc essed!';
  15111         Stat usBarLoadP t.Repaint;
  15112         Appl ication.Pr ocessmessa ges;
  15113         Show MessageCAP RI('ORWCIR N FACLIST  could not  be accesse d!');
  15114       End
  15115     End;
  15116     CheckLis tBoxRemote Data.Items .Clear;
  15117     ListBoxR emoteData. Items.Clea r;
  15118     Tab95Con trol2.Tabs .Clear;
  15119     Tab95Con trol2.Tabs .Add('Loca l');
  15120     If Piece (RPCBroker 1.Results[ 0], '^', 1 ) = '-1' T hen
  15121     Begin
  15122       // Onl y local da ta or othe r problem
  15123       ShowMe ssageCAPRI (Piece(RPC Broker1.Re sults[0],  '^', 2));
  15124       PanelR emoteData. Visible :=  False;
  15125       btnLoa dHSNamesCl ick(Applic ation);
  15126     End
  15127     Else
  15128     Begin
  15129       // Oth er sites f ound
  15130       For x  := 0 To RP CBroker1.R esults.Cou nt - 1 Do
  15131       Begin
  15132         List BoxRemoteD ata.Items. Add(RPCBro ker1.Resul ts[x]);
  15133         a :=  Copy(Piec e(RPCBroke r1.Results [x], '^',  1) + '         ', 1,  8);
  15134         b :=  Copy(Piec e(RPCBroke r1.Results [x], '^',  2) + '                            ', 1, 25) ;
  15135         Chec kListBoxRe moteData.I tems.Add(a  + b + FMD ateTimeCon vert(Piece (RPCBroker 1.Results[ x], '^', 3 )));
  15136       End;
  15137     End;
  15138   End;
  15139  
  15140   Procedure  TfrmMain.T imerRemote DataTimer( Sender: TO bject);
  15141   Var
  15142     x, y: in teger;
  15143   Begin
  15144     If ANURe moteProced ureCallInP rogress =  True Then
  15145       exit;
  15146     If ListB oxRemoteDa taPending. Items.Coun t = 0 Then
  15147     Begin
  15148       TimerR emoteData. Enabled :=  False;
  15149       ShowMe ssageCAPRI ('All remo te data ha s been ret rieved.');
  15150       exit;
  15151     End;
  15152     For x :=  ListBoxRe moteDataPe nding.Item s.Count -  1 Downto 0  Do
  15153     Begin
  15154       // * =  Communica tion Probl em
  15155       If Lis tBoxRemote DataPendin g.Items[x]  <> '*' Th en
  15156       Begin
  15157         RPCB roker1.Rem oteProcedu re := 'XWB  REMOTE ST ATUS CHECK ';
  15158         RPCB roker1.Par am[1].Valu e := ListB oxRemoteDa taPending. Items[x];
  15159         RPCB roker1.Par am[1].PTyp e := liter al;
  15160         RPCB rokerCall;
  15161         Try
  15162           RP CBroker1.C all;
  15163         Exce pt
  15164           On  EBrokerEr ror Do
  15165           Be gin
  15166              ANURemoteP rocedureCa llInProgre ss := Fals e;
  15167              AnimateLog o(False);
  15168              StatusBarL oadPt.Capt ion := 'RP C XWB REMO TE STATUS  CHECK coul d not be a ccessed!';
  15169              StatusBarL oadPt.Repa int;
  15170              Applicatio n.Processm essages;
  15171              ShowMessag eCAPRI('RP C XWB REMO TE STATUS  CHECK coul d not be a ccessed!') ;
  15172           En d
  15173         End;
  15174       End
  15175       Else
  15176       Begin
  15177         RPCB roker1.Res ults.Clear ;
  15178         RPCB roker1.Res ults.Add(' 1^DONE');
  15179         //Li stBoxRemot eData.Item s.Add(^^^^ ^'+ListBox RemoteData Pending.It ems[x]);
  15180       End;
  15181       If Upp ercase(RPC Broker1.Re sults[0])  = '1^DONE'  Then
  15182       Begin
  15183         For  y := 0 To  listboxrem otedata.it ems.count  - 1 Do
  15184           If  Piece(Lis tBoxRemote Data.Items [y], '^',  6) = ListB oxRemoteDa taPending. Items[x] T hen
  15185           Be gin
  15186              ListBoxRem oteData.It ems[y] :=  ListBoxRem oteData.It ems[y] + ' ^' + 'DONE ';
  15187              //ShowMess ageCAPRI(' OK:'+ListB oxRemoteDa ta.Items[y ]);
  15188           En d;
  15189         List BoxRemoteD ataPending .Items.Del ete(x);
  15190       End;
  15191       If Pie ce(Upperca se(RPCBrok er1.Result s[0]), '^' , 1) = '-1 ' Then
  15192       Begin
  15193         Show MessageCAP RI(RPCBrok er1.Result s[0]);
  15194         For  y := 0 To  listboxrem otedata.it ems.count  - 1 Do
  15195           If  Piece(Lis tBoxRemote Data.Items [y], '^',  6) = ListB oxRemoteDa taPending. Items[x] T hen
  15196           Be gin
  15197              ListBoxRem oteData.It ems[y] :=  ListBoxRem oteData.It ems[y] + ' ^' + 'DONE ';
  15198              //ShowMess ageCAPRI(' OOPS:'+Lis tBoxRemote Data.Items [y]);
  15199           En d;
  15200         List BoxRemoteD ataPending .Items.Del ete(x);
  15201       End;
  15202     End;
  15203  
  15204   End;
  15205  
  15206   Procedure  TfrmMain.T ab95Contro l2Change(S ender: TOb ject);
  15207   Var
  15208     SiteName : String;
  15209     y: integ er;
  15210  
  15211     Procedur e UpdateCo mboBoxHSSe ctions;
  15212     Var
  15213       tempRi chEdit: TR ichEdit;
  15214       x: int eger;
  15215     Begin
  15216       screen .cursor :=  crHourgla ss;
  15217       ComboB oxHSSectio ns.Items.C lear;
  15218       tempRi chEdit :=  Nil;
  15219       If HSM emo.Visibl e = True T hen
  15220         temp RichEdit : = HSMemo A s TRichEdi t;
  15221       If HSM emoLocal.V isible = T rue Then
  15222         temp RichEdit : = HSMemoLo cal As TRi chEdit;
  15223       If tem pRichEdit. Lines.Coun t = 0 Then
  15224         exit ;
  15225       Progre ssBarLoadP t.Position  := 0;
  15226       Progre ssBarLoadP t.Max := t empRichEdi t.Lines.Co unt - 1;
  15227       Progre ssBarLoadP t.Visible  := True;
  15228       For x  := 1 To te mpRichEdit .Lines.Cou nt - 1 Do
  15229       Begin
  15230         Prog ressBarLoa dPt.Positi on := x;
  15231         If x  / 1000 =  trunc(x /  1000) Then
  15232           St atusBarLoa dPt.Captio n := 'Scan ning ' + I nttoStr(x)  + ' of '  + inttoStr (tempRichE dit.Lines. Count);
  15233         Appl ication.Pr ocessMessa ges;
  15234         If t empRichEdi t.Lines[x  - 1] = ''  Then
  15235           If  Copy(temp RichEdit.L ines[x], 1 , 5) = '-- ---' Then
  15236              ComboBoxHS Sections.I tems.Add(t empRichEdi t.Lines[x] );
  15237       End;
  15238       Progre ssBarLoadP t.Visible  := False;
  15239       screen .cursor :=  crDefault ;
  15240     End;
  15241   Begin
  15242     ComboBox HSSections .Items.Cle ar;
  15243     If Tab95 Control2.T abIndex =  0 Then
  15244     Begin
  15245       ANURem oteProcedu reCallInPr ogress :=  true;
  15246       Status BarLoadPt. Caption :=  'Download ing Health  Summary.' ;
  15247       Status BarLoadPt. Repaint;
  15248       Applic ation.Proc essmessage s;
  15249       Animat eLogo(True );
  15250       HSMemo .Visible : = False;
  15251       HSMemo Local.Brin gToFront;
  15252       HSMemo Local.Visi ble := Tru e;
  15253       Update ComboBoxHS Sections;
  15254       Animat eLogo(Fals e);
  15255       Status BarLoadPt. Caption :=  'Ready.';
  15256       Status BarLoadPt. Repaint;
  15257       Applic ation.Proc essmessage s;
  15258       ANURem oteProcedu reCallInPr ogress :=  False;
  15259       exit;
  15260     End;
  15261     AnimateL ogo(True);
  15262     StatusBa rLoadPt.Ca ption := ' Checking f or Report. ';
  15263     StatusBa rLoadPt.Re paint;
  15264     Applicat ion.Proces smessages;
  15265     SiteName  := Tab95C ontrol2.Ta bs[Tab95Co ntrol2.Tab Index];
  15266     HSMemo.L ines.Clear ;
  15267     HSMemo.L ines.Add(' ');
  15268     HSMemo.L ines.Add(' Waiting fo r data...' );
  15269     HSMemoLo cal.Visibl e := False ;
  15270     HSMemo.V isible :=  True;
  15271     For y :=  0 To list boxremoted ata.items. count - 1  Do
  15272       If Sit eName = Pi ece(ListBo xRemoteDat a.Items[y] , '^', 2)  Then
  15273         If ( (Piece(Lis tBoxRemote Data.Items [y], '^',  6) <> '')  And (Piece (ListBoxRe moteData.I tems[y], ' ^', 7) = ' DONE')) Or  (Piece(Li stBoxRemot eData.Item s[y], '^',  6) = '*')  Then
  15274         Begi n
  15275           //  * = Commu nication P roblem
  15276           If  Piece(Lis tBoxRemote Data.Items [y], '^',  6) <> '*'  Then
  15277           Be gin
  15278              RPCBroker1 .RemotePro cedure :=  'XWB REMOT E GETDATA' ;
  15279              RPCBroker1 .Param[1]. Value := P iece(ListB oxRemoteDa ta.Items[y ], '^', 6) ; // Remot e transact ion id
  15280              RPCBroker1 .Param[1]. PType := l iteral;
  15281              RPCBrokerC all;
  15282              Try
  15283                RPCBroke r1.Call;
  15284              Except
  15285                On EBrok erError Do
  15286                Begin
  15287                  ANURem oteProcedu reCallInPr ogress :=  False;
  15288                  Animat eLogo(Fals e);
  15289                  HSMemo .Visible : = True;
  15290                  Status BarLoadPt. Caption :=  'RPC REMO TE GETDATA  could not  be access ed!';
  15291                  Status BarLoadPt. Repaint;
  15292                  Applic ation.Proc essmessage s;
  15293                  ShowMe ssageCAPRI ('RPC REMO TE GETDATA  could not  be access ed!');
  15294                End;
  15295              End;
  15296           En d
  15297           El se
  15298           Be gin
  15299              RPCBroker1 .Results.C lear;
  15300              HSMemo.Lin es.Clear;
  15301              HSMemo.Lin es.Add('Re mote data  transmissi on error:  Communicat ion error' );
  15302              AnimateLog o(False);
  15303              StatusBarL oadPt.Capt ion := 'Re ady.';
  15304              StatusBarL oadPt.Repa int;
  15305              Applicatio n.Processm essages;
  15306              screen.cur sor := crD efault;
  15307              exit;
  15308           En d;
  15309  
  15310           // Build Repo rt
  15311           AN URemotePro cedureCall InProgress  := true;
  15312           HS Memo.Lines .Clear;
  15313           Co mboBoxHSSe ctions.Ite ms.Clear;
  15314           sc reen.curso r := crHou rglass;
  15315  
  15316           HS Memo.SetSe lTextBuf(R PCBroker1. Results.Ge tText);
  15317  
  15318           sc reen.curso r := crDef ault;
  15319           If  ListBoxRe moteDataPe nding.Item s.Count >  0 Then
  15320              TimerRemot eData.Enab led := Tru e;
  15321           // End Of Bui ld Report
  15322         End;
  15323     HSMemo.B ringToFron t;
  15324     HSMemo.V isible :=  True;
  15325     HSMemo.S elStart :=  1;
  15326     HSMemo.S elLength : = 1;
  15327     Try
  15328     HSMemo.S etFocus Ex cept
  15329     End;
  15330     HSMemo.S elStart :=  0;
  15331     HSMemo.S elLength : = 0;
  15332     Try
  15333     HSMemo.S etFocus Ex cept
  15334     End;
  15335     UpdateCo mboBoxHSSe ctions;
  15336     ANURemot eProcedure CallinProg ress := Fa lse;
  15337     AnimateL ogo(False) ;
  15338     StatusBa rLoadPt.Ca ption := ' Ready.';
  15339     StatusBa rLoadPt.Re paint;
  15340     Applicat ion.Proces smessages;
  15341   End;
  15342  
  15343   Procedure  TfrmMain.B utton5Clic k(Sender:  TObject);
  15344   Begin
  15345     PanelRem oteData.Vi sible := F alse;
  15346   End;
  15347  
  15348   Procedure  TfrmMain.b tnDivision sClick(Sen der: TObje ct);
  15349   Var
  15350     anuapptp ointer: St ring;
  15351     anudivis ion: Strin g;
  15352     x: integ er;
  15353   Begin
  15354     AnimateL ogo(True);
  15355     StatusBa rLoadPt.Ca ption := ' Finding di visions... ';
  15356     StatusBa rLoadPt.Re paint;
  15357     Applicat ion.Proces smessages;
  15358     If lstDo cs.Items.C ount > 0 T hen
  15359     Begin
  15360       btnDiv isions.Ena bled := Fa lse;
  15361       Divisi onRun := T rue;
  15362       Button Search.Ena bled := Fa lse;
  15363       For x  := 0 To ls tDocs.Item s.Count -  1 Do
  15364       Begin
  15365         // G et Divison  and Add a t Front of  List
  15366         If D ivisionRun  = False T hen
  15367           ex it;                                                                          // In case  list chan ges
  15368         FMGe tsTIU.IENS  := Piece( lstDocs.It ems[x], '^ ', 2);
  15369         FMGe tsTIU.GetD ata;
  15370         Try
  15371         anua pptpointer  := FMGets TIU.GetFie ld('1205') .FMDBInter nal Except  anuapptpo inter := ' '
  15372         End;                                                                              // Pointer  to visit
  15373         anud ivision :=  '';
  15374         If a nuapptpoin ter <> ''  Then
  15375         Begi n
  15376           FM GetsHospit alLocation .IENS := a nuapptpoin ter;
  15377           FM GetsHospit alLocation .GetData;
  15378           Tr y
  15379           an udivision  := FMGetsH ospitalLoc ation.GetF ield('3.5' ).FMDBExte rnal Excep t
  15380           En d;
  15381         End;
  15382         anud ivision :=  anudivisi on + '   ' ;
  15383         anud ivision :=  Copy(anud ivision, 1 , 3);
  15384         lstD ocs.Items[ x] := anud ivision +  '  ' + lst docs.items [x];
  15385         appl ication.pr ocessmessa ges;
  15386         appl ication.pr ocessmessa ges;
  15387         appl ication.pr ocessmessa ges;
  15388         //
  15389       End;
  15390     End;
  15391     ButtonSe arch.Enabl ed := True ;
  15392     AnimateL ogo(False) ;
  15393     StatusBa rLoadPt.Ca ption := ' Ready.';
  15394     StatusBa rLoadPt.Re paint;
  15395     Applicat ion.Proces smessages;
  15396   End;
  15397  
  15398   Procedure  TfrmMain.b tnMultiCli ck(Sender:  TObject);
  15399   Begin
  15400     If FormR eportbuild er = Nil T hen
  15401       formRe portBuilde r := Tform ReportBuil der.Create (frmMain);
  15402     FormRepo rtBuilder. Left := fr mMain.Left  + frmMain .width - f ormreportB uilder.Wid th - 16;
  15403     FormRepo rtBuilder. Top := frm Main.Top +  frmMain.h eight - fo rmreportBu ilder.Heig ht - 84;
  15404     SetWindo wPos(formR eportBuild er.Handle,  hwnd_TopM ost, 0, 0,  0, 0,
  15405       SWP_NO ACTIVATE O r SWP_NOMO VE Or
  15406       SWP_NO SIZE Or SW P_NOSENDCH ANGING);
  15407     FormRepo rtBuilder. Show;
  15408   End;
  15409  
  15410   Procedure  TfrmMain.l stDocsChan ge(Sender:  TObject);
  15411   Begin
  15412     LabelDoc sFound.Cap tion := In tToStr(lst Docs.Items .Count) +  ' Items';
  15413   End;
  15414  
  15415   Procedure  TfrmMain.b uttonClinD ocDateRang eClick(Sen der: TObje ct);
  15416   Var
  15417     inE: Int eger;
  15418     ProcName : String;
  15419   Begin
  15420     ProcName  := 'TfrmM ain.button ClinDocDat eRangeClic k';
  15421     inE := 0 ;
  15422     Try
  15423       If For mDateRange  = Nil The n
  15424         Form DateRange  := TFormDa teRange.Cr eate(Appli cation);
  15425       // -ME R CodeCR12 2 9/2010 s tart chang e block
  15426       inE :=  1;
  15427       FormDa teRange.Fo nt := pane l1.font;
  15428       FormDa teRange.rb tnByDate.F ont := pan el1.font;
  15429       FormDa teRange.rb tnNumber.F ont := pan el1.font;
  15430       FormDa teRange.rb tnAll.Font  := panel1 .font;
  15431       FormDa teRange.bt nOK.Font : = panel1.f ont;
  15432       FormDa teRange.bt nCancel.Fo nt := pane l1.font;
  15433       FormDa teRange.gr pStartDate .Font := p anel1.font ;
  15434       FormDa teRange.gr pEndDate.F ont := pan el1.font;
  15435       FormDa teRange.gr bMaxNumber .Font := p anel1.font ;
  15436       FormDa teRange.dt pStartDate .Font := p anel1.font ;
  15437       FormDa teRange.dt pEndDate.F ont := pan el1.font;
  15438       FormDa teRange.ed bNumber.Fo nt := pane l1.font;
  15439       FormDa teRange.bt nOK.Height  := Panel1 .Height;
  15440       FormDa teRange.bt nCancel.He ight := Pa nel1.Heigh t;
  15441       inE :=  2;
  15442       if For mDateRange .ShowModal  = mrOK th en begin
  15443         inE  := 3;
  15444         if ( FormDateRa nge.rbtnBy Date.Check ed) then b egin
  15445           in E := 4;
  15446           bu ttonClinDo cDateRange .Caption : = FormatDa teTime('mm m d, yyyy' , FormDate Range.dtpS tartDate.D ate)
  15447              + ' to ' +  FormatDat eTime('mmm  d, yyyy',  FormDateR ange.dtpEn dDate.Date );
  15448           Cl inDocDateR angeSelect ed := True ;
  15449         end  else if (F ormDateRan ge.rbtnNum ber.Checke d) then be gin
  15450           in E := 5;
  15451           Nu mberClinDo csToRetrie ve := StrT oInt(FormD ateRange.e dbNumber.T ext);
  15452           bu ttonClinDo cDateRange .Caption : = IntToStr (NumberCli nDocsToRet rieve) + '  Documents ';
  15453           Cl inDocDateR angeSelect ed := Fals e;
  15454         end  else begin
  15455           in E := 6;
  15456           bu ttonClinDo cDateRange .Caption : = 'All Doc uments';
  15457           Nu mberClinDo csToRetrie ve := 3276 7;                                          // this co nstitutes  "show all"
  15458           Cl inDocDateR angeSelect ed := Fals e;
  15459         end;
  15460         inE  := 7;
  15461         Divi sionRun :=  False;
  15462         Tab9 5Control1C hange(Appl ication);
  15463       end;                                                                                // -MER Co deCR122 9/ 2010 end c hange bloc k
  15464       button search.ena bled := tr ue;
  15465     Except
  15466       ShowMe ssage('Err or at ' +  UnitName +  '.' + Pro cName + '  line=' + I ntToStr(in E));
  15467     End;
  15468   End;
  15469  
  15470   Procedure  TfrmMain.C omboBoxHSS ectionsCha nge(Sender : TObject) ;
  15471   Var
  15472     tempRich Edit: TRic hEdit;
  15473     foundat:  longint;
  15474     tempstri ng: String ;
  15475   Begin
  15476     tempRich Edit := Ni l;
  15477     If ANURe moteProced ureCallInP rogress =  True Then
  15478       exit;
  15479     If Combo BoxHSSecti ons.Text =  '' Then
  15480       exit;
  15481     If HSMem o.Visible  = True The n
  15482       tempRi chEdit :=  HSMemo As  TRichEdit;
  15483     If HSMem oLocal.Vis ible = Tru e Then
  15484       tempRi chEdit :=  HSMemoLoca l As TRich Edit;
  15485     If tempR ichEdit.Li nes.Count  = 0 Then
  15486       exit;
  15487     foundat  := tempRic hEdit.Find Text(Combo BoxHSSecti ons.Text,  0, length( temprichEd it.Text),  []);
  15488     If Found At <> -1 T hen
  15489     Begin
  15490       Try
  15491       tempRi chEdit.Set Focus Exce pt
  15492       End;
  15493       //Firs t jump to  bottom.
  15494       tempRi chEdit.Sel Start := l ength(temp RichEdit.T ext) - 2;
  15495       tempRi chEdit.Sel Length :=  2;
  15496       tempSt ring := te mpRichEdit .SelText;
  15497       tempRi chEdit.Sel Text := '' ;
  15498       tempri chedit.sel text := te mpstring;
  15499       //Now  find text
  15500       tempRi chEdit.Sel Start := F oundAt;
  15501       tempRi chEdit.Sel Length :=  Length(Com boBoxHSSec tions.Text );
  15502       // For ce jump to  section
  15503       tempRi chEdit.Sel Text := Co mboBoxHSSe ctions.Tex t;
  15504       // Re- Highlight
  15505       tempRi chEdit.Sel Start := F oundAt;
  15506       tempRi chEdit.Sel Length :=  Length(Com boBoxHSSec tions.Text );
  15507       // Scr oll down a  few lines
  15508  
  15509     End;
  15510     //end;
  15511   End;
  15512  
  15513   Procedure  TfrmMain.F MEditStree t1Exit(Sen der: TObje ct);
  15514   Var
  15515     x: integ er;
  15516     tempEdit : TEdit;
  15517   Begin
  15518     tempEdit  := Sender  As TEdit;
  15519     // Remov e trailing  spaces
  15520     If Lengt h(TempEdit .Text) > 0  Then
  15521     Begin
  15522       x := l ength(Temp Edit.text) ;
  15523       Repeat
  15524         Begi n
  15525           If  Copy(Temp Edit.Text,  x, 1) = '  ' Then
  15526              TempEdit.T ext := cop y(TempEdit .text, 1,  x - 1)
  15527           El se
  15528              x := 1;
  15529           de c(x);
  15530       End Un til x = 0;
  15531     End;
  15532     // Remov e leading  spaces
  15533     If Lengt h(TempEdit .Text) > 0  Then
  15534     Begin
  15535       x := 0 ;
  15536       Repeat
  15537         Begi n
  15538           If  Copy(Temp Edit.Text,  1, 1) = '  ' Then
  15539           Be gin
  15540              TempEdit.T ext := cop y(TempEdit .text, 2,  length(Tem pEdit.text ) - 1);
  15541              dec(x);
  15542           En d
  15543           El se
  15544              x := lengt h(TempEdit .text);
  15545           in c(x);
  15546       End Un til x > le ngth(TempE dit.text);
  15547     End;
  15548     TempEdit .Text := U ppercase(T empEdit.Te xt);
  15549   End;
  15550  
  15551   Procedure  TfrmMain.H SMemoChang e(Sender:  TObject);
  15552   Begin
  15553     SetFont;
  15554   End;
  15555  
  15556   Procedure  TfrmMain.H SMemoLocal Change(Sen der: TObje ct);
  15557   Begin
  15558     SetFont;
  15559   End;
  15560  
  15561   Procedure  TfrmMain.R eportMemoC hange(Send er: TObjec t);
  15562   Begin
  15563     SetFont;
  15564   End;
  15565  
  15566   Procedure  TfrmMain.M emoAppoint mentsChang e(Sender:  TObject);
  15567   Begin
  15568     SetFont;
  15569   End;
  15570  
  15571   Procedure  TfrmMain.b tnGraphVSC lick(Sende r: TObject );
  15572   Var
  15573     x, y: in teger;
  15574     line: St ring;
  15575   Begin
  15576     If ANURe moteProced ureCallInP rogress =  True Then
  15577       exit;
  15578     If memod ocs.Lines. Count > 0  Then
  15579     Begin
  15580       Animat eLogo(True );
  15581       Status BarLoadPt. Caption :=  'Analyzin g values.' ;
  15582       Status BarLoadPt. Repaint;
  15583       Applic ation.Proc essmessage s;
  15584  
  15585       formGr aphVS := T formGraphV S.Create(f rmMain);
  15586       formGr aphVS.Char tVS.Series [0].Clear;
  15587       formGr aphVS.Char tVS.Series [1].Clear;
  15588       formGr aphVS.Char tVS.Series [2].Clear;
  15589       formGr aphVS.Char tVS.Title. Text.Clear ;
  15590       formGr aphVS.Char tVS.Title. Text.Add(' Vitals/Mea surements  Report');
  15591       formGr aphVS.List BoxVS.Clea r;
  15592       // Sea rch for vi tals types
  15593       For x  := 0 To me modocs.lin es.count -  1 Do
  15594       Begin
  15595         line  := memodo cs.lines[x ];
  15596         //
  15597         //
  15598         //   Find vital  types fir st
  15599         If ( pos(':', l ine) > 3)  And (lengt h(line) >  4) Then
  15600         Begi n                                                                            // Found a  vital typ e?
  15601           //  Check to  be sure 4  spaces and  then a ch aracter.   If so, it' s a line w ith a vita l
  15602           If  (line[1]  = ' ') And  (line[2]  = ' ') And  (line[3]  = ' ') And  (line[4]  = ' ') And  (line[5]  <> ' ') Th en
  15603           Be gin
  15604              line := re movespaces (line);
  15605              line := Co py(line, 1 , pos(':',  line) - 1 );
  15606              If upperca se(Line) =  'T' Then
  15607                line :=  'TEMPERATU RE' + '^'  + Line
  15608              Else
  15609                If upper case(Line)  = 'P' The n
  15610                  line : = 'PULSE'  + '^' + Li ne
  15611                Else
  15612                  If upp ercase(Lin e) = 'R' T hen
  15613                    line  := 'RESPI RATION' +  '^' + Line
  15614                  Else
  15615                    If u ppercase(L ine) = 'B/ P' Then
  15616                      li ne := 'BLO OD PRESSUR E' + '^' +  Line
  15617                    Else
  15618                      If  uppercase (Line) = ' WT' Then
  15619                         line := 'W EIGHT' + ' ^' + Line
  15620                      El se
  15621                         If upperca se(Line) =  'HT' Then
  15622                           line :=  'HEIGHT' +  '^' + Lin e
  15623                         Else
  15624                           Line :=  Uppercase( Line) + '^ ' + Line;                        // All oth ers, just  use whatev er it is
  15625              If formGra phVS.ListB oxVS.Items .Count > 0  Then
  15626                For y :=  0 To form GraphVS.Li stBoxVS.It ems.Count  - 1 Do
  15627                  If for mGraphVS.L istBoxVS.I tems[y] =  Line Then
  15628                    Line  := '';
  15629              If Line <>  '' Then
  15630                formGrap hVS.ListBo xVS.Items. Add(Line);
  15631           En d;
  15632         End;
  15633         Anim ateLogo(Fa lse);
  15634         Stat usBarLoadP t.Caption  := 'Ready. ';
  15635         Stat usBarLoadP t.Repaint;
  15636         Appl ication.Pr ocessmessa ges;
  15637       End;
  15638       //
  15639       If for mGraphVS.l istBoxVS.I tems.Count  = 0 Then
  15640       Begin
  15641         Show MessageCAP RI('Nothin g found to  graph in  the curren t report.' );
  15642         exit ;
  15643       End;
  15644       formGr aphVS.Show Modal;
  15645       formGr aphVS.rele ase;
  15646       formGr aphVS := N il;
  15647     End;
  15648   End;
  15649  
  15650   Procedure  TfrmMain.b tnExamFina lReportCli ck(Sender:  TObject);
  15651   Var
  15652     labonly:  String;
  15653     Remote:  String;                                                                      // CodeCR7 11 JRL 6/8 /15
  15654   Begin
  15655     labonly  := '0';
  15656     If Appli cation.Mes sageBox('D o you want  just the  lab/x-ray  results?',  'Reprint  Final Repo rt', 4) =  6 Then
  15657     Begin
  15658       labonl y := '1';
  15659     End;
  15660  
  15661     If FMExa mRequestLi stBox.Item Index = -1  Then
  15662       exit;
  15663  
  15664     {CodeCR1 80 - rpm 4 /11/11 - u se TfrmRep orts.FormA ctivate lo gic that f orces
  15665                                  D UZ(2) to C LAIMS logi n division }
  15666     if EssoV ersion the n
  15667     begin
  15668       RPCBro ker1.Remot eProcedure  := 'DVBAB  SET DIVIS ION';
  15669       RPCBro ker1.Param [1].Value  := RemoteU serDivisio nNumber;
  15670       RPCBro ker1.Param [1].PType  := literal ;
  15671  
  15672       Try
  15673         RPCB roker1.Cal l;
  15674       Except
  15675         On E BrokerErro r Do
  15676         Begi n
  15677           AN URemotePro cedureCall InProgress  := False;
  15678           An imateLogo( False);
  15679           St atusBarLoa dPt.Captio n := 'RPC  DVBAB SET  DIVISION c ould not b e accessed !';
  15680           St atusBarLoa dPt.Repain t;
  15681           Ap plication. Processmes sages;
  15682           Sh owMessageC APRI('DVBA B SET DIVI SION could  not be ac cessed!');
  15683         End;
  15684       End;
  15685     end;
  15686  
  15687     If ESSOV ersion the n                                                                 // CodeCR7 11 JRL 6/8 /15
  15688       Remote  := '1'                                                                      // CodeCR7 11 JRL 6/8 /15
  15689     else                                                                                  // CodeCR7 11 JRL 6/8 /15
  15690       Remote  := '0';                                                                     // CodeCR7 11 JRL 6/8 /15
  15691     RPCBroke r1.Results .Clear;
  15692     RPCBroke r1.RemoteP rocedure : = 'DVBAB R EPORTS';                                    // RE-PRIN T C&P FINA L';
  15693     RPCBroke r1.Param[1 ].Value :=  '4';
  15694     RPCBroke r1.Param[1 ].PType :=  literal;
  15695   //RPCBroke r1.Param[2 ].Value :=  'V^^R^' +  labonly +  '^' + FME xamRequest ListBox.Ge tSelectedR ecord.IEN  + '^' + Pa tientIEN;
  15696     RPCBroke r1.Param[2 ].Value :=  'V^^R^' +  labonly +  '^' + FME xamRequest ListBox.Ge tSelectedR ecord.IEN  + '^' + Pa tientIEN +  '^^' + Re mote; // C odeCR711 J RL 6/8/15
  15697     RPCBroke r1.Param[2 ].PType :=  literal;
  15698  
  15699     RPCBroke rCall;
  15700     Try
  15701       RPCBro ker1.Call;
  15702     Except
  15703       On EBr okerError  Do
  15704       Begin
  15705         ANUR emoteProce dureCallIn Progress : = False;
  15706         Anim ateLogo(Fa lse);
  15707         // D VBAB REPRI NT C&P FIN AL
  15708         Stat usBarLoadP t.Caption  := 'RPC DV BAB REPORT S could no t be acces sed!';
  15709         Stat usBarLoadP t.Repaint;
  15710         Appl ication.Pr ocessmessa ges;
  15711         Show MessageCAP RI('Connec tion to se rver for D VBAB REPOR TS could n ot be esta blished!') ;
  15712       End;
  15713     End;
  15714  
  15715     //Build  Report
  15716     StatusBa rLoadPt.Ca ption := ' Downloadin g report.' ;
  15717     StatusBa rLoadPt.Re paint;
  15718     Applicat ion.Proces smessages;
  15719     ANURemot eProcedure CallInProg ress := tr ue;
  15720     ReportMe mo.Lines.C lear;
  15721     screen.c ursor := c rHourglass ;
  15722  
  15723     ReportMe mo.SetSelT extBuf(RPC Broker1.Re sults.GetT ext);
  15724  
  15725     screen.c ursor := c rDefault;
  15726     ReportMe mo.Visible  := True;
  15727     ReportMe mo.SelStar t := 0;
  15728     ReportMe mo.SelLeng th := 0;
  15729     Try
  15730     ReportMe mo.SetFocu s Except
  15731     End;
  15732     ANURemot eProcedure CallinProg ress := Fa lse;
  15733     AnimateL ogo(False) ;
  15734     StatusBa rLoadPt.Ca ption := ' Ready.';
  15735     StatusBa rLoadPt.Re paint;
  15736     Applicat ion.Proces smessages;
  15737     //End Of  Build Rep ort
  15738  
  15739     ORReport sAvailable .ItemIndex  := 2;
  15740     Page95Co ntrol1.Act ivePage :=  TabReport s
  15741   End;
  15742  
  15743   Procedure  TfrmMain.b tnAdmissio nsClick(Se nder: TObj ect);
  15744   Var
  15745     x: integ er;
  15746   //  strLis t: TString List;
  15747  
  15748     { functi on GetAdmi ssionsDate (inStr: St ring): Str ing;
  15749     var
  15750       str1:  String;
  15751     begin
  15752       Result  := '';
  15753       if inS tr > '' th en begin
  15754         str1  := MFunSt r.Piece(in Str, U, 1) ;
  15755         Resu lt := str1 ;
  15756       end;
  15757     end;                                                                                  // GetAdmi ssionsDate
  15758  
  15759     function  SortAdmis sionsByDat e(List: TS tringList;  Index1, I ndex2: Int eger): Int eger; // C odeCR708 r pk 5/19/20 15
  15760     var
  15761       iret:  Integer;
  15762       FMDT1,  FMDT2: TF MDateTime;
  15763       DT1, D T2: TDateT ime;
  15764       dtstr1 , dtstr2:  String;
  15765  
  15766     begin
  15767       Result  := 0;
  15768       DT1 :=  0;
  15769       DT2 :=  0;
  15770  
  15771       dtstr1  := GetAdm issionsDat e(List[Ind ex1]);
  15772       dtstr2  := GetAdm issionsDat e(List[Ind ex2]);
  15773  
  15774       FMDT1  := CAPRISu pport.Make FMDateTime (dtstr1);
  15775       FMDT2  := CAPRISu pport.Make FMDateTime (dtstr2);
  15776  
  15777       if FMD T1 > -1 th en
  15778         DT1  := CAPRISu pport.FMDa teTimetoDa teTime(FMD T1);
  15779       if FMD T2 > -1 th en
  15780         DT2  := CAPRISu pport.FMDa teTimetoDa teTime(FMD T2);
  15781  
  15782       iret : = CompareD ateTime(DT 1, DT2);
  15783       if Rev erseAdminS ortOrder t hen                                                    // CodeCR7 08 rpk 8/2 7/2015
  15784         // r everse the  sort orde r; make it  newest to  oldest
  15785         iret  := -iret;
  15786  
  15787       Result  := iret;
  15788     end; }//  SortExamR equestByDa te
  15789  
  15790   Begin                                                                                   // btnAdmi ssionsClic k
  15791     If ANURe moteProced ureCallInP rogress =  True Then
  15792       exit;
  15793     AnimateL ogo(True);
  15794   //  Status BarLoadPt. Caption :=  'Download ing past a ppointment s.';
  15795     StatusBa rLoadPt.Ca ption := ' Downloadin g admissio ns.';
  15796     StatusBa rLoadPt.Re paint;
  15797     Applicat ion.Proces smessages;
  15798  
  15799     lblApptS tatus.Capt ion := 'Ad missions';
  15800  
  15801     {Use CPR S Visit Lo ader ORWPT  ADMITLST}
  15802     RPCBroke r1.RemoteP rocedure : = 'ORWPT A DMITLST';
  15803     RPCBroke r1.Param[0 ].Value :=  PatientIE N;
  15804     RPCBroke r1.Param[0 ].PType :=  literal;
  15805     RPCBroke rCall;
  15806     Try
  15807       RPCBro ker1.Call;
  15808     Except
  15809       On EBr okerError  Do
  15810       Begin
  15811         ANUR emoteProce dureCallIn Progress : = False;
  15812         Anim ateLogo(Fa lse);
  15813         Stat usBarLoadP t.Caption  := 'RPC OR WPT ADMITL ST could n ot be acce ssed!';
  15814         Stat usBarLoadP t.Repaint;
  15815         Appl ication.Pr ocessmessa ges;
  15816         Show MessageCAP RI('Connec tion to se rver for O RWPT ADMIT LST could  not be est ablished!' );
  15817       End;
  15818     End;
  15819  
  15820     { strLis t := TStri ngList.Cre ate;                                                     // CodeC R708 rpk 5 /19/2015
  15821     try                                                                                   // CodeCR7 08 rpk 5/1 9/2015
  15822       strLis t.Assign(R PCBroker1. Results);                                              // CodeCR7 08 rpk 5/1 9/2015
  15823       strLis t.CustomSo rt(@SortAd missionsBy Date);                                      // CodeCR7 08 rpk 5/1 9/2015
  15824       RPCBro ker1.Resul ts.Assign( strList);                                              // CodeCR7 08 rpk 5/1 9/2015
  15825     finally                                                                               // CodeCR7 08 rpk 5/1 9/2015
  15826       strLis t.Free;                                                                      // CodeCR7 08 rpk 5/1 9/2015
  15827     end; }//  CodeCR708  rpk 5/19/ 2015
  15828  
  15829     MemoAppo intments.L ines.Clear ;
  15830     If RPCBr oker1.Resu lts.Count  > 0 Then
  15831     Begin
  15832       For x  := 0 To RP CBroker1.R esults.Cou nt - 1 Do
  15833       Begin
  15834         memo appointmen ts.lines.a dd(Copy(FM DateTimeCo nvert(Piec e(RPCBroke r1.Results [x], '^',  1)) + '                      ',  1, 20) + '  ' +
  15835           Co py('  Ward : ' + Piec e(RPCBroke r1.Results [x], '^',  3) + '                            ', 1, 25)  + ' ' +
  15836           Co py('  Sour ce: ' + Pi ece(RPCBro ker1.Resul ts[x], '^' , 4) + '                      ',  1, 20));
  15837       End;
  15838       memoap pointments .lines.add ('');
  15839       memoap pointments .lines.add ('NOTE: De tailed des criptions  of admissi ons are av ailable on  the CAPRI  reports t ab.');
  15840     End
  15841     Else
  15842     Begin
  15843       MemoAp pointments .Lines.Add ('No admis sions foun d.');
  15844     End;
  15845     AnimateL ogo(False) ;
  15846     MemoAppo intments.S elStart :=  0;                                                    // CodeCR7 08 rpk 7/7 /2015
  15847     MemoAppo intments.S elLength : = 0;
  15848     if MemoA ppointment s.CanFocus  then                                                  // CodeCR7 08 rpk 7/7 /2015
  15849       MemoAp pointments .Setfocus;
  15850     StatusBa rLoadPt.Ca ption := ' Ready.';
  15851     StatusBa rLoadPt.Re paint;
  15852     Applicat ion.Proces smessages;
  15853   End;
  15854  
  15855   Procedure  TfrmMain.b tnMulti2Cl ick(Sender : TObject) ;
  15856   Begin
  15857     If ANURe moteProced ureCallInP rogress =  True Then
  15858       exit;
  15859     formRepo rtBuilderA uto := Tfo rmReportBu ilderAuto. Create(frm Main);
  15860     formRepo rtBuilderA uto.button ClinDocDat eRange.Cap tion := fr mMain.butt onClinDocD ateRange.C aption;
  15861     formRepo rtBuilderA uto.ShowMo dal;
  15862     formRepo rtBuilderA uto.releas e;
  15863     formRepo rtBuilderA uto := Nil ;
  15864   End;
  15865  
  15866   Procedure  TfrmMain.T imerInfoBo xTimer(Sen der: TObje ct);
  15867   Begin
  15868     inc(dvba timerinfob ox);
  15869     //5 seco nds, 250ms  each)
  15870     If dvbat imerinfobo x >= 5 The n
  15871     Begin
  15872       TimerI nfoBox.Ena bled := Fa lse;
  15873       TimerI nfoBox.Int erval := 5 00;                                                    // Reset b ack to def ault in ca se code ch anged it
  15874       frmInf oBox.relea se;
  15875       frmInf oBox := Ni l;
  15876     End
  15877     Else
  15878     Begin
  15879       (*
  15880           If  frmInfoBo x.Label1.V isible=tru e then
  15881              frmInfoBox .Label1.Vi sible:=Fal se
  15882           El se frmInfo Box.Label1 .Visible:= True;
  15883           fr mInfoBox.B ringToFron t;
  15884           *)
  15885     End;
  15886   End;
  15887  
  15888   //Provide  a horizont al scrollb ar for a l ist box
  15889   {********* ********** ********** ********** ********** ********** ********** **
  15890    Listbox w ith horizo ntal scrol lbar
  15891    MaxWidth  < 0 : adap t automati cally to l argest ite m
  15892    MaxWidth  >= 0: use  value of M axWidth fo r width of  scrollabl e area
  15893    ********* ********** ********** ********** ********** ********** ********** **}
  15894  
  15895   Procedure  TfrmMain.H orScrollBa r(ListBox:  TListBox;  MaxWidth:  integer);
  15896   Var
  15897     i, w: in teger;
  15898   Begin
  15899     If MaxWi dth >= 0 T hen
  15900       SendMe ssage(List Box.Handle , LB_SETHO RIZONTALEX TENT, MaxW idth, 0)
  15901     Else
  15902     Begin
  15903       { get  largest it em }
  15904       For i  := 0 To Li stBox.Item s.Count -  1 Do
  15905         With  ListBox D o
  15906         Begi n
  15907           w  := Canvas. TextWidth( Items[i]);
  15908           If  w > MaxWi dth Then
  15909              MaxWidth : = w;
  15910         End;
  15911       SendMe ssage(List Box.Handle , LB_SETHO RIZONTALEX TENT,
  15912         MaxW idth + Get SystemMetr ics(SM_CXF RAME), 0);
  15913     End;
  15914   End;
  15915  
  15916   Procedure  TfrmMain.b tnAdHocCli ck(Sender:  TObject);
  15917   Begin
  15918     Tab95Con trol2.TabI ndex := 0;
  15919     Tab95Con trol2.Tabs .Clear;
  15920     Tab95Con trol2.Tabs .Add('Loca l');
  15921  
  15922     frmRepor tsAdhocCom ponent1 :=  tfrmRepor tsAdhocCom ponent1.cr eate(frmMa in);
  15923     uListSta te := GetA dhocLookup ();
  15924     ListBoxR emoteDataP ending.Ite ms.Clear;                                              // Clear r emote repo rt retriev al
  15925  
  15926     uHSCompo nents.Clea r;
  15927     frmRepor tsAdhocCom ponent1.Sh owmodal;
  15928     ANURemot eProcedure CallInProg ress := tr ue;
  15929     frmRepor tsAdhocCom ponent1.Re lease;
  15930     frmRepor tsAdhocCom ponent1 :=  Nil;
  15931     HSMemoLo cal.Lines. Clear;
  15932     ComboBox HSSections .Items.Cle ar;
  15933     screen.c ursor := c rHourglass ;
  15934  
  15935     HSMemoLo cal.SetSel TextBuf(uL ocalReport Data.GetTe xt);
  15936     ORHealth SummaryUse rList.Item Index := - 1;
  15937  
  15938     screen.c ursor := c rDefault;
  15939     HSMemoLo cal.BringT oFront;
  15940     HSMemoLo cal.Visibl e := True;
  15941     HSMemoLo cal.SelSta rt := 0;
  15942     HSMemoLo cal.SelLen gth := 0;
  15943     Try
  15944     HSMemoLo cal.SetFoc us Except
  15945     End;
  15946  
  15947     Tab95Con trol2Chang e(Applicat ion);
  15948     ANURemot eProcedure CallinProg ress := Fa lse;
  15949     AnimateL ogo(False) ;
  15950     StatusBa rLoadPt.Ca ption := ' Ready.';
  15951     StatusBa rLoadPt.Re paint;
  15952     Applicat ion.Proces smessages;
  15953     screen.c ursor := c rDefault;
  15954   End;
  15955  
  15956   Procedure  TfrmMain.t empToolCli ck(Sender:  TObject);
  15957   Var
  15958     TempMenu Item: TAct ion;
  15959     xx: inte ger;
  15960     TempProg ramName: A rray[0..10 24] Of cha r;
  15961   Begin
  15962     if not ( Sender.Cla ssName = ' TAction')  then exit;
  15963     TempMenu Item := Se nder As TA ction;
  15964     xx := st rToInt(Pie ce(tempMen uItem.Name , 'l', 2)) ;
  15965     StrPCopy (TempProgr amName, pC har(Piece( FMListBoxC APRITools. Items[xx],  ';', 3))) ;
  15966     WinExec( TempProgra mName, SW_ SHOWNORMAL );
  15967   End;
  15968  
  15969   Procedure  TfrmMain.B uttonOKSur geryReport sClick(Sen der: TObje ct);
  15970   Begin
  15971     PanelSur geryReport s.Visible  := False;
  15972     RPCBroke r1.RemoteP rocedure : = 'DVBAB R EPORTS';                                    //OPERATIO N REPORT
  15973     RPCBroke r1.Param[1 ].Value :=  '8';
  15974     RPCBroke r1.Param[1 ].PType :=  literal;
  15975     RPCBroke r1.Param[2 ].PType :=  literal;
  15976     RPCBroke r1.Param[2 ].Value :=  PatientIE N + '^' +
  15977       Piece( SurgeryRep orts[ORLis tBoxSurger yReports.I temIndex],  '^', 1);
  15978     RPCBroke rCall;
  15979     Try
  15980       RPCBro ker1.Call;
  15981     Except
  15982       On EBr okerError  Do
  15983       Begin
  15984         ANUR emoteProce dureCallIn Progress : = False;
  15985         Anim ateLogo(Fa lse);
  15986         Stat usBarLoadP t.Caption  := 'DVBAB  REPORTS co uld not be  accessed! ';
  15987         Stat usBarLoadP t.Repaint;
  15988         Appl ication.Pr ocessmessa ges;
  15989         Show MessageCAP RI('DVBAB  OPERATION  REPORT cou ld not be  accessed!' );
  15990       End;
  15991     End;
  15992     QuickCop y(RPCBroke r1.Results , ReportMe mo);
  15993     If Repor tMemo.Line s.Count =  0 Then
  15994     Begin
  15995       Report Memo.Lines .Add('No d ata found  for reques ted surger y report.   This is n ormally be cause the  report is  not yet co mpleted.') ;
  15996     End;
  15997   End;
  15998  
  15999   Procedure  TfrmMain.B uttonCance lSurgeryRe portsClick (Sender: T Object);
  16000   Begin
  16001     PanelSur geryReport s.Visible  := False;
  16002   End;
  16003  
  16004   Procedure  TfrmMain.O RListBoxSu rgeryRepor tsChange(S ender: TOb ject);
  16005   Begin
  16006     ButtonOK SurgeryRep orts.Enabl ed := True ;
  16007   End;
  16008  
  16009   // DoD tab  function  - DoD tab  is no long er display ed so this  function  will 
  16010   // never e xecute.  P atch 193 J RL 7/21/16
  16011   Procedure  TfrmMain.B uttonGCPRG oClick(Sen der: TObje ct);
  16012   Var
  16013     x, xx, y : integer;
  16014     reportty pe: String ;
  16015     laststri ng: String ;
  16016     space: S tring;
  16017     ReportSh own: Boole an;
  16018     StationN o: String;                                                                   //required  for local  FHIE conn ections
  16019   Begin
  16020     StationN o := '';
  16021     If ANURe moteProced ureCallInP rogress Th en
  16022       exit;
  16023  
  16024     If (User DivisionNu mber = '')  Or (UserD ivision =  '') Then
  16025     Begin
  16026       ShowMe ssageCAPRI ('Cannot i dentify yo ur divisio n.  This f unction is  cancelled .');
  16027       ORList BoxDODRepo rtTypes.It emIndex :=  -1;
  16028       exit;
  16029     End;
  16030  
  16031     x := 0;
  16032  
  16033     If dtpDO DStartDate .Date > dt pDODEndDat e.Date The n                                //CodeCR10 2 - rpm 4/ 12/10
  16034     Begin
  16035       ShowMe ssageCAPRI ('Start mu st not be  greater th an end dat e.');
  16036       ORList BoxDODRepo rtTypes.It emIndex :=  -1;
  16037       exit;
  16038     End;
  16039  
  16040     // Allow  @ sign FM  access to  run the b locked rep orts
  16041     // for d evelopment  purposes.
  16042     If Copy( ORListBoxD ODReportTy pes.Items[ ORListBoxD ODReportTy pes.ItemIn dex], 1, 1 ) = '~' Th en
  16043       If Pos ('@', user filemancod e) < 0 The n
  16044       Begin
  16045         Show MessageCAP RI('That r eport type  is not av ailable ri ght now.') ;
  16046         ORLi stBoxDODRe portTypes. ItemIndex  := -1;
  16047         exit ;
  16048       End;
  16049  
  16050     If RPCBr okerDOD.Co nnected Th en
  16051     Begin
  16052       ShowMe ssageCAPRI ('A broker  call is a lready in  progress.   Cannot ex ecute this  report re quest');
  16053       exit;
  16054     End;
  16055  
  16056     ORListBo xDODReport Types.enab led := fal se;
  16057     sleep(50 0);                                                                          // Need th is to deal  with Brok er calls c licked qui ckly in su ccession.
  16058  
  16059     Button1. Enabled :=  False;
  16060  
  16061     Try
  16062       For xx  := 0 To 4  Do
  16063         For  y := 0 To  4 Do
  16064           VA WrapGridDO D.Cells[xx , y] := '' ;
  16065     Except
  16066     End;
  16067  
  16068     RPCBroke rDOD.ANUFH IEConnecti on := True ;
  16069     RPCBroke rDOD.Conne cted := Fa lse;
  16070     RPCBroke rDOD.RPCTi meLimit :=  28800;
  16071  
  16072     // Save  ESSO versi on
  16073     AnimateL ogo(True);
  16074     StatusBa rLoadPt.Ca ption := ' Connecting  to DoD se rver.';
  16075     StatusBa rLoadPt.Re paint;
  16076     Applicat ion.Proces smessages;
  16077     //Set DO D Broker d ivision an d get BSE  token from  home serv er
  16078     RPCBroke rDOD.ANUst rDivisionH ome := RPC Broker1.AN UstrDivisi onHome;
  16079     RPCBroke rDOD.Conne ct2HomeSer ver(RPCBro ker1.ANUAc cessCodeHo me,
  16080       RPCBro ker1.ANUVe rifyCodeHo me,
  16081       RPCBro ker1.ANUst rServerHom e,
  16082       RPCBro ker1.ANUst rPortHome,
  16083       False) ;
  16084     If Not R PCBrokerDO D.CreateCo ntext('DVB A CAPRI GU I') Then
  16085     Begin
  16086       ShowMe ssageCAPRI ('FHIE: Co uld not us e option " DVBA CAPRI  GUI!"');
  16087       applic ation.term inate;
  16088     End;
  16089  
  16090     //determ ine statio n number r equired fo r local FH IE connect ions;
  16091     // short -circuit w hen no sta tion numbe r
  16092     if NOT E SSOVersion  then
  16093     begin
  16094       Statio nNo := Pie ce(GetDivi sion(ESSOV ersion, RP CBrokerDOD ), '^', 3) ;
  16095       if Sta tionNo = ' ' then
  16096       begin
  16097         RPCB rokerDOD.A NUFHIEConn ection :=  False;
  16098         RPCB rokerDOD.C onnected : = False;
  16099         Show MessageCap ri('Could  not determ ine local  station nu mber for F HIE connec tion.');
  16100         Exit ;
  16101       end;
  16102     end;
  16103     RPCBroke rDOD.Conne cted := Fa lse;
  16104     sleep(10 00);
  16105     RPCBroke rDOD.Serve r := Piece (FHIESiteL ocation, ' ,', 1);
  16106     RPCBroke rDOD.Liste nerPort :=  StrtoInt( Piece(FHIE SiteLocati on, ',', 2 ));
  16107     RPCBroke rDOD.ANUUs erSpecs :=
  16108       Author SSN + '^'  +
  16109       Author Name + '^'  +
  16110       UserDi vision + ' ^' +                                                              // Site
  16111       UserDi visionNumb er + '^' +                                                        // Site nu m
  16112       Author IEN;
  16113  
  16114     //Connec t to remot e server w ith BSE to ken
  16115     RPCBroke rDOD.Conne ct2RemoteS erver(RPCB rokerDOD.S erver,
  16116       IntToS tr(RPCBrok erDOD.List enerPort),
  16117       False,  True, Sta tionNo);
  16118     If Not R PCBrokerDO D.CreateCo ntext('DVB A CAPRI GU I') Then
  16119     Begin
  16120       ShowMe ssageCAPRI ('FHIE: Co uld not us e option " DVBA CAPRI  GUI!"');
  16121       applic ation.term inate;
  16122     End;
  16123     If RPCBr okerDOD.Co nnected =  False Then
  16124     Begin
  16125       ShowMe ssageCAPRI ('FHIE: Co uld not us e option " DVBA CAPRI  GUI!"');
  16126       applic ation.term inate;
  16127     End;
  16128  
  16129     If Patie ntIENDoD =  '' Then
  16130     Begin
  16131       //Show MessageCAP RI('icn: ' +patientic n);
  16132       Status BarLoadPt. Caption :=  'Matching  patient o n FHIE.';
  16133       Status BarLoadPt. Repaint;
  16134       Applic ation.Proc essmessage s;
  16135       RPCBro kerDOD.Rem oteProcedu re := 'DVB AB FIND DF N BY ICN';
  16136       RPCBro kerDOD.Par am[0].Valu e := patie ntICN;
  16137       RPCBro kerDOD.Par am[0].PTyp e := liter al;
  16138       RPCBro kerCall;
  16139       Try
  16140         RPCB rokerDOD.C all;
  16141       Except
  16142         On E : EBrokerE rror Do
  16143         Begi n
  16144           AN URemotePro cedureCall InProgress  := False;
  16145           An imateLogo( False);
  16146           St atusBarLoa dPt.Captio n := 'RPC  DVBAB FIND  DFN BY IC N could no t be acces sed!';
  16147           St atusBarLoa dPt.Repain t;
  16148           Ap plication. Processmes sages;
  16149           Sh owMessageC APRI('XWB  DVBAB FIND  DFN BY IC N could no t be acces sed!'
  16150              + #13#10 +  #13#10 +  'Error: '  + E.Messag e);
  16151           //  Set back  ESSO versi on
  16152           RP CBrokerDOD .Connected  := False;
  16153           RP CBrokerDOD .ANUFHIECo nnection : = False;
  16154           OR ListBoxDOD ReportType s.enabled  := true;
  16155           RP CBrokerDOD .Connected  := False;
  16156           sl eep(1000);
  16157           ex it;
  16158         End;
  16159       End;
  16160       If RPC BrokerDOD. Results[0]  = 'NOT A  VALID ICN'  Then
  16161       Begin
  16162         ANUR emoteProce dureCallIn Progress : = False;
  16163         Anim ateLogo(Fa lse);
  16164         Stat usBarLoadP t.Caption  := 'Could  not match  patient on  FHIE.';
  16165         Stat usBarLoadP t.Repaint;
  16166         Appl ication.Pr ocessmessa ges;
  16167         Show MessageCAP RI('Unable  to find p atient on  FHIE.');
  16168         RPCB rokerDOD.C onnected : = False;
  16169         RPCB rokerDOD.A NUFHIEConn ection :=  False;
  16170         ORLi stBoxDODRe portTypes. enabled :=  true;
  16171         RPCB rokerDOD.C onnected : = False;
  16172         slee p(1000);
  16173         exit ;
  16174       End
  16175       Else
  16176         Pati entIENDoD  := RPCBrok erDOD.Resu lts[0];
  16177       RPCBro kerDOD.ANU FHIEConnec tion := Fa lse;
  16178     End;
  16179  
  16180  
  16181     PanelFHI EOptions.V isible :=  False;
  16182     RPCBroke rDOD.ANUFH IEConnecti on := True ;
  16183     StatusBa rLoadPt.Ca ption := ' Querying D oD report. ';
  16184     StatusBa rLoadPt.Re paint;
  16185     Applicat ion.Proces smessages;
  16186     RPCBroke rDOD.Remot eProcedure  := 'DVBAB  DOD REPOR T';
  16187     RPCBroke rDOD.Param [1].Value  := Patient IENDoD;                                     // IEN on  remote sys tem
  16188     RPCBroke rDOD.Param [1].PType  := literal ;
  16189     RPCBroke rDOD.Param [2].Value  := Piece(O RListBoxDO DReportTyp es.Items[O RListBoxDO DReportTyp es.ItemInd ex], '^',  2); // Rep ort Type
  16190     reportty pe := RPCB rokerDOD.P aram[2].Va lue;
  16191     RPCBroke rDOD.Param [2].PType  := literal ;
  16192     RPCBroke rDOD.Param [3].Value  := FMToDat eConvert(F ormatDateT ime('mm/dd /yyyy', dt pDODStartD ate.DateTi me)); //Be gin Date / /CodeCR102  - rpm 4/1 2/10
  16193     RPCBroke rDOD.Param [3].PType  := literal ;
  16194     RPCBroke rDOD.Param [4].Value  := FMToDat eConvert(F ormatDateT ime('mm/dd /yyyy', dt pDODEndDat e.DateTime )); // End  Date //Co deCR102 -  rpm 4/12/1 0
  16195     RPCBroke rDOD.Param [4].PType  := literal ;
  16196     RPCBroke rDOD.Param [5].Value  := EditDOD MaxItems.T ext;
  16197     RPCBroke rDOD.Param [5].PType  := literal ;
  16198     RPCBroke rDOD.Param [6].Value  := Piece(O RListBoxDO DReportTyp es.Items[O RListBoxDO DReportTyp es.ItemInd ex], '^',  3); // Tem p Global N ame
  16199     RPCBroke rDOD.Param [6].PType  := literal ;
  16200     HeaderCo ntrolDODAl lergies.Vi sible := F alse;
  16201     HeaderCo ntrolDODCo nsults.Vis ible := Fa lse;
  16202     HeaderCo ntrolDODLR C.Visible  := False;
  16203     HeaderCo ntrolDODDC S.Visible  := False;
  16204     HeaderCo ntrolDODLR CY.Visible  := False;
  16205     HeaderCo ntrolDODPN s.Visible  := False;
  16206     HeaderCo ntrolDODMI .Visible : = False;
  16207     HeaderCo ntrolDODRR .Visible : = False;
  16208     RichEdit DODReport. Lines.Clea r;
  16209     PanelDOD Grids.Visi ble := Fal se;
  16210     RichEdit DODTempRep ort.Lines. Clear;
  16211     //ShowMe ssageCAPRI (RPCBroker DOD.Param[ 3].Value+'      '+RPC BrokerDOD. Param[4].V alue);
  16212  
  16213     Progress BarLoadPt. Position : = 0;
  16214     Progress BarLoadPt. Visible :=  True;
  16215     Progress BarLoadPt. Max := 100 ;
  16216     TimerFHI ERunning.E nabled :=  True;
  16217  
  16218     RPCBroke rCall;
  16219     Try
  16220       RPCBro kerDOD.Cal l;
  16221     Except
  16222       On EBr okerError  Do
  16223       Begin
  16224         ANUR emoteProce dureCallIn Progress : = False;
  16225         Anim ateLogo(Fa lse);
  16226         Stat usBarLoadP t.Caption  := 'RPC DV BAB DOD RE PORT could  not be ac cessed!';
  16227         Stat usBarLoadP t.Repaint;
  16228         Appl ication.Pr ocessmessa ges;
  16229         // S et back ES SO version
  16230         RPCB rokerDOD.C onnected : = False;
  16231         Prog ressBarLoa dPt.Visibl e := False ;
  16232         Prog ressBarLoa dPt.Positi on := 0;
  16233         Time rFHIERunni ng.Enabled  := False;
  16234         Show MessageCAP RI('RPC DV BAB DOD RE PORT could  not be ac cessed!');
  16235         RPCB rokerDOD.A NUFHIEConn ection :=  False;
  16236         ORLi stBoxDODRe portTypes. enabled :=  true;
  16237         RPCB rokerDOD.C onnected : = False;
  16238         slee p(1000);
  16239         exit ;
  16240       End;
  16241     End;
  16242     RichEdit DODTempRep ort.SetSel TextBuf(RP CBrokerDOD .Results.G etText);
  16243     PanelDOD Grids.Visi ble := Fal se;
  16244  
  16245     //Progre ssBarLoadP t.Visible: =False;
  16246     Progress BarLoadPt. Position : = 0;
  16247     TimerFHI ERunning.E nabled :=  False;
  16248     RPCBroke rDOD.ANUFH IEConnecti on := True ;
  16249     If RPCBr okerDOD.Re sults.Coun t = 0 Then
  16250     Begin
  16251       RichEd itDODRepor t.Lines.Ad d('No data  was retur ned for th e selected  report ty pe.');
  16252     End
  16253     Else
  16254       If RPC BrokerDOD. results.Co unt > 0 Th en
  16255       Begin
  16256  
  16257         Repo rtShown :=  False;
  16258  
  16259         If R eportType  = 'ADT' Th en
  16260         Begi n
  16261           Re portShown  := True;
  16262           // RichEditDo dReport.Li nes:=RichE ditDoDTemp Report.Lin es;
  16263           If  TabDOD.Pa geIndex =  8 Then
  16264           Be gin
  16265              RichEditDO DReport.Vi sible := T rue;
  16266              RichEditDO DReport.Se tSelTextBu f(RichEdit DODTempRep ort.Lines. GetText);
  16267           En d;
  16268         End;
  16269  
  16270         If R eportType  = 'DS' The n
  16271         Begi n
  16272           If  RPCBroker DOD.Result s.Count >  0 Then
  16273           Be gin
  16274              ReportShow n := True;
  16275              If TabDOD. PageIndex  = 8 Then
  16276              Begin
  16277                PanelDOD Grids.Visi ble := Tru e;
  16278                HeaderCo ntrolDODDC S.Visible  := True;
  16279              End;
  16280              HeaderCont rolDODDCSS ectionResi ze(HeaderC ontrolDODD CS, Header ControlDOD DCS.Sectio ns[0]);
  16281              VAWrapGrid DOD.RowCou nt := 1;
  16282              y := 0;
  16283              x := 0;
  16284              Repeat
  16285                Begin
  16286                  If Pos ('^', RPCB rokerDOD.R esults[x])  > 0 Then
  16287                  Begin
  16288                    //If  RPCBroker DOD.Result s[x]='1^No
  16289                    VAWr apGridDOD. Cells[0, y ] := Piece (Piece(RPC BrokerDOD. Results[x] , '^', 2),  ';', 1);
  16290                    inc( x);
  16291                    If P iece(Piece (RPCBroker DOD.Result s[x - 1],  '^', 2), ' ;', 1) <>  'No remote  patient d ata found  for these  request pa rameters.'  Then
  16292                    Begi n
  16293                      VA WrapGridDO D.Cells[1,  y] := Pie ce(RPCBrok erDOD.Resu lts[x], '^ ', 2);
  16294                      in c(x);
  16295                      VA WrapGridDO D.Cells[2,  y] := Pie ce(RPCBrok erDOD.Resu lts[x], '^ ', 2);
  16296                      in c(x);
  16297                      VA WrapGridDO D.Cells[3,  y] := Pie ce(RPCBrok erDOD.Resu lts[x], '^ ', 2);
  16298                      in c(x);
  16299                      VA WrapGridDO D.Cells[4,  y] := Pie ce(RPCBrok erDOD.Resu lts[x], '^ ', 2);
  16300                      in c(x);
  16301                      VA WrapGridDO D.Cells[5,  y] := Pie ce(RPCBrok erDOD.Resu lts[x], '^ ', 2);
  16302                      in c(x);
  16303                      VA WrapGridDO D.Cells[6,  y] := Pie ce(RPCBrok erDOD.Resu lts[x], '^ ', 2);
  16304                      in c(x);
  16305                    End
  16306                    Else
  16307                    Begi n
  16308                      in c(x);
  16309                      in c(x);
  16310                      in c(x);
  16311                      in c(x);
  16312                      in c(x);
  16313                      in c(x);
  16314                    End;
  16315                    inc( y);
  16316                    VAWr apGridDOD. RowCount : = y;
  16317                  End
  16318                  Else
  16319                  Begin
  16320                  End;
  16321                  Repeat  inc(x)Unt il (x >= R PCBrokerDO D.Results. Count) Or  (Piece(RPC BrokerDOD. Results[x] , '^', 1)  = '1');
  16322              End Until  x >= RPCBr okerDOD.Re sults.Coun t;
  16323              VAWrapGrid DODClick(A pplication );
  16324              //RichEdit DODReport. Visible:=T rue;
  16325              //RichEdit DODReport. SetSelText Buf(RichEd itDODTempR eport.Line s.GetText) ;
  16326           En d;
  16327         End;
  16328  
  16329         If R eportType  = 'LRC' Th en
  16330         Begi n                                                                            // chem/he m
  16331           Bu tton1.Enab led := Tru e;
  16332           Re portShown  := True;
  16333           If  TabDOD.Pa geIndex =  8 Then
  16334           Be gin
  16335              PanelDODGr ids.Visibl e := True;
  16336              HeaderCont rolDODLRC. Visible :=  True;
  16337              PanelFHIEO ptions.Vis ible := Tr ue;
  16338           En d;
  16339           He aderContro lDODLRCSec tionResize (HeaderCon trolDODLRC , HeaderCo ntrolDODLR C.Sections [0]);
  16340           VA WrapGridDO D.RowCount  := 1;
  16341           y  := 0;
  16342           x  := 0;
  16343           Pr ogressBarL oadPt.Max  := RPCBrok erDOD.Resu lts.Count;
  16344           Re peat
  16345              Begin
  16346                If Pos(' ^', RPCBro kerDOD.Res ults[x]) >  0 Then
  16347                Begin
  16348                  VAWrap GridDOD.Ce lls[0, y]  := Piece(R PCBrokerDO D.Results[ x], '^', 1 );
  16349                  VAWrap GridDOD.Ce lls[1, y]  := Piece(R PCBrokerDO D.Results[ x], '^', 3 );
  16350                  VAWrap GridDOD.Ce lls[2, y]  := Piece(R PCBrokerDO D.Results[ x], '^', 4 );
  16351                  VAWrap GridDOD.Ce lls[3, y]  := Piece(R PCBrokerDO D.Results[ x], '^', 6 );
  16352                  VAWrap GridDOD.Ce lls[4, y]  := Piece(R PCBrokerDO D.Results[ x], '^', 5 );
  16353                  VAWrap GridDOD.Ce lls[5, y]  := Piece(R PCBrokerDO D.Results[ x], '^', 2 );
  16354                  VAWrap GridDOD.Ce lls[6, y]  := Piece(R PCBrokerDO D.Results[ x], '^', 7 );
  16355                  VAWrap GridDOD.Ce lls[7, y]  := Piece(R PCBrokerDO D.Results[ x], '^', 8 );
  16356                  inc(y) ;
  16357                  VAWrap GridDOD.Ro wCount :=  y;
  16358                End
  16359                Else
  16360                Begin
  16361                End;
  16362                inc(x);
  16363                Progress BarLoadPt. Position : = x;
  16364                Progress BarLoadPt. Repaint;
  16365                StatusBa rLoadPt.Re paint;
  16366           En d Until x  >= RPCBrok erDOD.Resu lts.Count;
  16367           VA WrapGridDO DClick(App lication);
  16368         End;
  16369         If R eportType  = 'RXOP' T hen
  16370         Begi n                                                                            // Outpati ent Pharma cy
  16371           Re portShown  := True;
  16372           If  RichEditD ODTempRepo rt.Lines.C ount > 0 T hen
  16373              x := RichE ditDODTemp Report.Lin es.Count -  1;
  16374           an uremotepro cedurecall inprogress  := true;
  16375           cu rsor := cr Hourglass;
  16376           Ri chEditDODR eport.Visi ble := Fal se;
  16377           Pr ogressBarL oadPt.Max  := RPCBrok erDOD.Resu lts.Count;
  16378           Re peat
  16379              Begin
  16380                If Piece (RichEditD ODTempRepo rt.Lines[x ], ';', 1)  <> 'No re mote patie nt data fo und for th ese reques t paramete rs.' Then
  16381                Begin
  16382                  RichEd itDODTempR eport.Line s.Insert(x  + 1, '');
  16383                  RichEd itDODTempR eport.Line s[x] := 'S ite: ' + P iece(RichE ditDODTemp Report.Lin es[x], ';' , 1);
  16384                  dec(x) ;
  16385                  RichEd itDODTempR eport.Line s[x] := 'S IG:  ' + R ichEditDOD TempReport .Lines[x];
  16386                  dec(x) ;
  16387                  RichEd itDODTempR eport.Line s.Insert(x , 'PROVIDE R: ' + Pie ce(Piece(R ichEditDOD TempReport .Lines[x],  '^', 4),  ';', 2) +  '  DATE: '  + FMDateT imeConvert (Piece(Ric hEditDODTe mpReport.L ines[x],
  16388                    '^',  2)));
  16389                  RichEd itDODTempR eport.Line s[x + 1] : = Piece(Pi ece(RichEd itDODTempR eport.Line s[x + 1],  '^', 3), ' ;', 2) + '   Quantity : ' + Piec e(RichEdit DODTempRep ort.Lines[ x + 1], '^ ', 7) + '   Status: '
  16390                    + Pi ece(Piece( RichEditDO DTempRepor t.Lines[x  + 1], '^',  5), ';',  2);
  16391                  dec(x) ;
  16392                End
  16393                Else
  16394                Begin
  16395                  //Rich EditDODTem pReport.Li nes.Add('N o remote p atient dat a found fo r these re quest para meters.');
  16396                  x := - 1;
  16397                End;
  16398                Progress BarLoadPt. Position : = x;
  16399                Progress BarLoadPt. Repaint;
  16400                StatusBa rLoadPt.Re paint;
  16401           En d Until x  < 0;
  16402           an uremotepro cedurecall inprogress  := False;
  16403           cu rsor := cr Default;
  16404           Ri chEditDODR eport.Visi ble := Tru e;
  16405           Ri chEditDODR eport.SetS elTextBuf( RichEditDO DTempRepor t.Lines.Ge tText);
  16406         End;
  16407         If R eportType  = 'MI' The n
  16408         Begi n                                                                            // Microbi ology
  16409           Re portShown  := True;
  16410           Pa nelDODGrid s.Visible  := True;
  16411           He aderContro lDODMI.Vis ible := Tr ue;
  16412           He aderContro lDODMISect ionResize( HeaderCont rolDODMI,  HeaderCont rolDODMI.S ections[0] );
  16413           VA WrapGridDO D.RowCount  := 1;
  16414           y  := 0;
  16415           x  := 0;
  16416           Pr ogressBarL oadPt.Max  := RPCBrok erDOD.Resu lts.Count;
  16417           Re peat
  16418              Begin
  16419                If Pos(' ^', RPCBro kerDOD.Res ults[x]) >  0 Then
  16420                Begin
  16421                  //Line  1
  16422                  VAWrap GridDOD.Ce lls[0, y]  := Piece(R PCBrokerDO D.Results[ x], '^', 1 ); //Colle ct Date/Ti me
  16423                  VAWrap GridDOD.Ce lls[1, y]  := Piece(R PCBrokerDO D.Results[ x], '^', 6 ); //Repor t Status
  16424                  VAWrap GridDOD.Ce lls[2, y]  := Piece(R PCBrokerDO D.Results[ x], '^', 5 ); //Lab T est
  16425                  inc(x) ;
  16426                  If Pos ('^', RPCB rokerDOD.R esults[x])  = 0 Then
  16427                    Repe at
  16428                      Be gin
  16429                         //Text Lin e
  16430                         inc(x);
  16431                    End  Until Pos( '^', RPCBr okerDOD.Re sults[x])  > 0;
  16432                  //Smea r Results?
  16433                  inc(x) ;
  16434                  VAWrap GridDOD.Ce lls[3, y]  := Piece(R PCBrokerDO D.Results[ x], '^', 3 ); //Resul t
  16435                  inc(x) ;
  16436                  //Site
  16437                  inc(x) ;
  16438                End;
  16439                inc(y);
  16440                Progress BarLoadPt. Position : = x;
  16441                Progress BarLoadPt. Repaint;
  16442                StatusBa rLoadPt.Re paint;
  16443  
  16444           En d Until (x  >= RPCBro kerDOD.Res ults.Count ) Or (y >=  RPCBroker DOD.Result s.Count);
  16445           VA WrapGridDO D.RowCount  := y;
  16446           VA WrapGridDO DClick(App lication);
  16447         End;
  16448         If R eportType  = 'RR' The n
  16449         Begi n                                                                            // Radiolo gy
  16450           Re portShown  := True;
  16451           Pa nelDODGrid s.Visible  := True;
  16452           He aderContro lDODRR.Vis ible := Tr ue;
  16453           He aderContro lDODRRSect ionResize( HeaderCont rolDODRR,  HeaderCont rolDODRR.S ections[0] );
  16454           VA WrapGridDO D.RowCount  := 1;
  16455           y  := 0;
  16456           x  := 0;
  16457           Pr ogressBarL oadPt.Max  := RPCBrok erDOD.Resu lts.Count;
  16458           Re peat
  16459              Begin
  16460                If Pos(' ^', RPCBro kerDOD.Res ults[x]) >  0 Then
  16461                Begin
  16462                  //Line  1
  16463                  VAWrap GridDOD.Ce lls[0, y]  := FMDateT imeConvert (Piece(RPC BrokerDOD. Results[x] , '^', 1)) ; //Date/T ime
  16464                  VAWrap GridDOD.Ce lls[1, y]  := Piece(R PCBrokerDO D.Results[ x], '^', 2 ); //Test  Type
  16465                  VAWrap GridDOD.Ce lls[2, y]  := Piece(R PCBrokerDO D.Results[ x], '^', 4 ); //Statu s
  16466                  inc(x) ;
  16467                  If Pos ('^', RPCB rokerDOD.R esults[x])  = 0 Then
  16468                    Repe at
  16469                      Be gin
  16470                         //Text Lin e
  16471                         inc(x);
  16472                    End  Until (Pos ('^', RPCB rokerDOD.R esults[x])  > 0) Or ( x >= RPCBr okerDOD.Re sults.Coun t - 1);
  16473                End;
  16474                inc(y);
  16475                Progress BarLoadPt. Position : = x;
  16476                Progress BarLoadPt. Repaint;
  16477                StatusBa rLoadPt.Re paint;
  16478           En d Until (x  >= RPCBro kerDOD.Res ults.Count  - 1) Or ( y > RPCBro kerDOD.Res ults.Count  - 1);
  16479           VA WrapGridDO D.RowCount  := y;
  16480           VA WrapGridDO DClick(App lication);
  16481         End;
  16482  
  16483         If R eportType  = 'LRO' Th en
  16484         Begi n                                                                            // Lab Ord ers
  16485           Re portShown  := True;
  16486           y  := 0;
  16487           sp ace := '                                                                                        ';  // 80 spa ces
  16488           an uremotepro cedurecall inprogress  := true;
  16489           cu rsor := cr Hourglass;
  16490           Ri chEditDODR eport.Visi ble := Fal se;
  16491           Pr ogressBarL oadPt.Max  := RPCBrok erDOD.Resu lts.Count;
  16492           Re peat
  16493              Begin
  16494                If Piece (RichEditD ODTempRepo rt.Lines[y ], ';', 1)  <> '^^^^^ ^^^^' Then
  16495                Begin
  16496                  RichEd itDODRepor t.Lines.Ad d(
  16497                    Copy (Piece(Ric hEditDODTe mpReport.L ines[y], ' ^', 1) + s pace, 1, 1 8) + '  '  + // Date/ Time
  16498                    Copy (Piece(Pie ce(RichEdi tDODTempRe port.Lines [y], '^',  2), ';', 2 ) + space,  1, 32) +  // Test Ty pe
  16499                    'Spe cimen: ' +  Piece(Pie ce(RichEdi tDODTempRe port.Lines [y], '^',  3), ';', 2 ) // Speci men Type
  16500                    );
  16501                  RichEd itDODRepor t.Lines.Ad d(
  16502                    Copy (Piece(Ric hEditDODTe mpReport.L ines[y], ' ^', 5) + s pace, 1, 1 7) + // St atus
  16503                    'Urg ency: ' +  Copy(Piece (RichEditD ODTempRepo rt.Lines[y ], '^', 4)  + space,  1, 26) + / / Urgency
  16504                    'Col lect Type:  ' + Piece (RichEditD ODTempRepo rt.Lines[y ], '^', 10 ) // Lab/W ard collec t
  16505                    );
  16506                  RichEd itDODRepor t.Lines.Ad d('                   Provider:  ' + Piece( Piece(Rich EditDODTem pReport.Li nes[y], '^ ', 6), ';' , 2)); //  Site
  16507                  RichEd itDODRepor t.Lines.Ad d('                   Date/Time  Lab Ordere d:       '  + Piece(R ichEditDOD TempReport .Lines[y],  '^', 7));  // Date/T ime Lab Or dered
  16508                  RichEd itDODRepor t.Lines.Ad d('                   Date/Time  Results Av ailable: '  + Piece(R ichEditDOD TempReport .Lines[y],  '^', 9));  // Date/T ime Result s Availabl e
  16509                  RichEd itDODRepor t.Lines.Ad d('                   Accession  #:' + Piec e(RichEdit DODTempRep ort.Lines[ y], '^', 8 )); // Acc ession #
  16510                  inc(y) ;
  16511                  RichEd itDODRepor t.Lines.Ad d('                   Site: ' +  Piece(Rich EditDODTem pReport.Li nes[y], '; ', 1)); //  Site
  16512                  RichEd itDODRepor t.Lines.Ad d('');                                      // Separat or line
  16513                End
  16514                Else
  16515                Begin
  16516                  inc(y) ;
  16517                  RichEd itDODRepor t.Lines.Ad d(Piece(Ri chEditDODT empReport. Lines[y],  ';', 1));
  16518                End;
  16519                inc(y);
  16520                Progress BarLoadPt. Position : = y;
  16521                Progress BarLoadPt. Repaint;
  16522                StatusBa rLoadPt.Re paint;
  16523                statusba rloadpt.ca ption := ' Line ' + i nttostr(y)  + ' of '  + inttostr (RPCBroker DOD.Result s.Count) +  '              ';
  16524  
  16525           En d Until y  >= RPCBrok erDOD.Resu lts.Count;
  16526           Ri chEditDODR eport.Visi ble := Tru e;
  16527           cu rsor := cr Default;
  16528           an uremotepro cedurecall inprogress  := false;
  16529         End;
  16530         If ( ReportType  = 'CY') O r (ReportT ype = 'SP' ) Then
  16531         Begi n                                                                            // Surgica l Patholog y/Cytology
  16532           Re portShown  := True;
  16533           Pa nelDODGrid s.Visible  := True;
  16534           He aderContro lDODLRCY.V isible :=  True;
  16535           He aderContro lDODLRCYSe ctionResiz e(HeaderCo ntrolDODLR C, HeaderC ontrolDODL RC.Section s[0]);
  16536           VA WrapGridDO D.RowCount  := 1;
  16537           y  := -1;
  16538           x  := 0;
  16539           la ststring : = '';
  16540           Pr ogressBarL oadPt.Max  := RPCBrok erDOD.Resu lts.Count;
  16541           Re peat
  16542              Begin
  16543                Try
  16544                  If RPC BrokerDOD. Results[1]  = '' Then
  16545                  Begin
  16546                    VAWr apGridDod. Cells[0, 0 ] := 'No r emote pati ent data f ound for t hese reque st paramet ers.'
  16547                  End;
  16548                Except
  16549                End;
  16550                If Pos(' ^', RPCBro kerDOD.Res ults[x]) >  0 Then
  16551                Begin
  16552                  If las tstring <>  '' Then
  16553                    VAWr apGridDOD. Cells[3, y ] := Piece (laststrin g, ';', 1) ;          // Site
  16554                  inc(y) ;
  16555                  VAWrap GridDOD.Ce lls[0, y]  := Piece(R PCBrokerDO D.Results[ x], '^', 1 ); // Coll ect Date
  16556                  inc(x) ;
  16557                  VAWrap GridDOD.Ce lls[2, y]  := FMDateT imeConvert (Piece(RPC BrokerDOD. Results[x] , '^', 2)) ; // Repor t Date/Tim e
  16558                  inc(x) ;
  16559                  VAWrap GridDOD.Ce lls[1, y]  := RPCBrok erDOD.Resu lts[x];               // Specime n Type
  16560                  inc(x) ;
  16561                  VAWrap GridDOD.Ro wCount :=  y + 1;
  16562                End
  16563                Else
  16564                Begin
  16565                  LastSt ring := RP CBrokerDOD .Results[x ];
  16566                End;
  16567                inc(x);
  16568                Progress BarLoadPt. Position : = x;
  16569                Progress BarLoadPt. Repaint;
  16570                StatusBa rLoadPt.Re paint;
  16571           En d Until x  >= RPCBrok erDOD.Resu lts.Count;
  16572           If  (laststri ng <> '')  And (lasts tring <> ' No remote  patient da ta found f or these r equest par ameters.')  Then
  16573              VAWrapGrid DOD.Cells[ 3, y] := P iece(lasts tring, ';' , 1);                 // Site
  16574           VA WrapGridDO DClick(App lication);
  16575         End;
  16576  
  16577         // P rogress No tes
  16578  
  16579         If ( ReportType  = 'PN') T hen
  16580         Begi n                                                                            // Progres s Notes
  16581           Re portShown  := True;
  16582           Pa nelDODGrid s.Visible  := True;
  16583           He aderContro lDODPNs.Vi sible := T rue;
  16584           He aderContro lDODPNsSec tionResize (HeaderCon trolDODPNs , HeaderCo ntrolDODPN s.Sections [0]);
  16585           VA WrapGridDO D.RowCount  := 1;
  16586           y  := 0;
  16587           x  := 0;
  16588           la ststring : = '';
  16589           Pr ogressBarL oadPt.Max  := RPCBrok erDOD.Resu lts.Count;
  16590           Qu ickCopy(RP CBrokerDoD .Results,  RichEditDo DTempRepor t);
  16591           Re peat
  16592              Begin
  16593                // CodeC R179 -MER  04/2011 Th e record r eturned is  not alway s as the
  16594                //   fol lowing cod e expected  it to be.   As a res ult x was  being
  16595                //   inc remented b eyond the  last item  of RPCBrok erDOD.Resu lts.  This
  16596                //   exc eption han dling bloc k was adde d to prote ct against  the
  16597                //   res ulting ind ex out of  bounds exc eptions
  16598                try
  16599                  VAWrap GridDOD.Ce lls[0, y]  := Piece(R PCBrokerDO D.Results[ x], '^', 2 );
  16600                  inc(x) ;
  16601                  inc(x) ;                                                                 // Skip 2n d field, n ot sure wh at it's fo r
  16602                  VAWrap GridDOD.Ce lls[1, y]  := Piece(R PCBrokerDO D.Results[ x], '^', 2 );
  16603                  inc(x) ;
  16604                  VAWrap GridDOD.Ce lls[2, y]  := Piece(R PCBrokerDO D.Results[ x], '^', 2 );
  16605                  inc(x) ;
  16606                  VAWrap GridDOD.Ce lls[3, y]  := Piece(R PCBrokerDO D.Results[ x], '^', 2 );
  16607                  inc(x) ;
  16608                  If (Pi ece(RPCBro kerDOD.Res ults[x], ' ^', 1) <>  '7') Then
  16609                    Repe at inc(x);
  16610                    Unti l (Piece(R PCBrokerDO D.Results[ x], '^', 1 ) = '7');
  16611                  VAWrap GridDOD.Ce lls[4, y]  := Piece(R PCBrokerDO D.Results[ x], '^', 2 );
  16612                  inc(x) ;
  16613                  If (Pi ece(RPCBro kerDOD.Res ults[x], ' ^', 1) <>  '8') Then
  16614                    Repe at inc(x);
  16615                    Unti l (Piece(R PCBrokerDO D.Results[ x], '^', 1 ) = '8');
  16616                  inc(x) ;
  16617                except
  16618                  x := R PCBrokerDO D.Results. Count;
  16619                end;
  16620                VAWrapGr idDOD.RowC ount := y  + 1;
  16621                inc(y);
  16622                Progress BarLoadPt. Position : = x;
  16623                Progress BarLoadPt. Repaint;
  16624                StatusBa rLoadPt.Re paint;
  16625           En d Until x  >= RPCBrok erDOD.Resu lts.Count;
  16626           VA WrapGridDO D.RowCount  := y;
  16627           If  (laststri ng <> '')  And (lasts tring <> ' No remote  patient da ta found f or these r equest par ameters.')  Then
  16628              VAWrapGrid DOD.Cells[ 3, y] := P iece(lasts tring, ';' , 1);                 // Site
  16629           VA WrapGridDO DClick(App lication);
  16630         End;
  16631  
  16632         // C onsult Rep orts
  16633         If ( ReportType  = 'CONS')  Then
  16634         Begi n                                                                            // Surgica l Patholog y/Cytology
  16635           Re portShown  := True;
  16636           Pa nelDODGrid s.Visible  := True;
  16637           He aderContro lDODConsul ts.Visible  := True;
  16638           Pa nelFHIEOpt ions.Visib le := True ;
  16639           He aderContro lDODConsul tsSectionR esize(Head erControlD ODConsults , HeaderCo ntrolDODCo nsults.Sec tions[0]);
  16640           VA WrapGridDO D.RowCount  := 1;
  16641           y  := 0;
  16642           x  := 0;
  16643           Pr ogressBarL oadPt.Max  := RPCBrok erDOD.Resu lts.Count;
  16644           Re peat
  16645              Begin
  16646                If Pos(' 1^', RPCBr okerDOD.Re sults[x])  = 1 Then
  16647                Begin
  16648                  VAWrap GridDOD.Ce lls[0, y]  := Piece(P iece(RPCBr okerDOD.Re sults[x],  '^', 2), ' ;', 1);
  16649                  inc(x) ;
  16650                  VAWrap GridDOD.Ce lls[1, y]  := Piece(R PCBrokerDO D.Results[ x], '^', 2 );
  16651                  inc(x) ;
  16652                  VAWrap GridDOD.Ce lls[2, y]  := Piece(R PCBrokerDO D.Results[ x], '^', 2 );
  16653                  inc(x) ;
  16654                  VAWrap GridDOD.Ce lls[3, y]  := Piece(R PCBrokerDO D.Results[ x], '^', 2 );
  16655                  inc(x) ;
  16656                  VAWrap GridDOD.Ce lls[4, y]  := Piece(R PCBrokerDO D.Results[ x], '^', 2 );
  16657                  inc(x) ;
  16658                  VAWrap GridDOD.Ce lls[5, y]  := Piece(R PCBrokerDO D.Results[ x], '^', 2 );
  16659                  // inc (x);
  16660                  inc(y) ;
  16661                  Repeat
  16662                    Begi n
  16663                      in c(x);
  16664                  End Un til ((x =  RPCBrokerD OD.Results .Count - 1 ) Or (Pos( '1^', RPCB rokerDOD.R esults[x])  = 1));
  16665                  VAWrap GridDOD.Ro wCount :=  y;
  16666                End
  16667                Else
  16668                Begin
  16669                  inc(x) ;
  16670                End;
  16671                Progress BarLoadPt. Position : = x;
  16672                Progress BarLoadPt. Repaint;
  16673                StatusBa rLoadPt.Re paint;
  16674           En d Until x  >= RPCBrok erDoD.Resu lts.Count;
  16675           VA WrapGridDO DClick(App lication);
  16676           If  (laststri ng <> '')  And (lasts tring <> ' No remote  patient da ta found f or these r equest par ameters.')  Then
  16677              VAWrapGrid DOD.Cells[ 3, y] := P iece(lasts tring, ';' , 1);                 // Site
  16678           VA WrapGridDO DClick(App lication);
  16679         End;
  16680  
  16681         // A llergies
  16682         If ( ReportType  = 'ALRG')  Then
  16683         Begi n                                                                            // Allergi es
  16684           Re portShown  := True;
  16685           Pa nelDODGrid s.Visible  := True;
  16686           He aderContro lDODAllerg ies.Visibl e := True;
  16687           Pa nelFHIEOpt ions.Visib le := True ;
  16688           He aderContro lDODAllerg iesSection Resize(Hea derControl DODAllergi es, Header ControlDOD Allergies. Sections[0 ]);
  16689           VA WrapGridDO D.RowCount  := 1;
  16690           y  := 0;
  16691           x  := 0;
  16692           Pr ogressBarL oadPt.Max  := RPCBrok erDoD.Resu lts.Count;
  16693           Re peat
  16694              Begin
  16695                If Pos(' 1^', RPCBr okerDoD.Re sults[x])  = 1 Then
  16696                Begin
  16697                  VAWrap GridDOD.Ce lls[0, y]  := Piece(P iece(RPCBr okerDoD.Re sults[x],  '^', 2), ' ;', 1);
  16698                  //VAWr apGridDOD. Cells[0,y] :=Piece(RP CBrokerDoD .Results[x ],'^',2);
  16699                  inc(x) ;
  16700                  VAWrap GridDOD.Ce lls[1, y]  := Piece(R PCBrokerDo D.Results[ x], '^', 2 );
  16701                  inc(x) ;
  16702                  VAWrap GridDOD.Ce lls[2, y]  := Piece(R PCBrokerDo D.Results[ x], '^', 2 );
  16703                  inc(x) ;
  16704                  inc(x) ;                                                                 // Not use d
  16705                  inc(y) ;
  16706                  If x <  RPCBroker DoD.Result s.Count -  1 Then
  16707                    Repe at
  16708                      Be gin
  16709                         inc(x);
  16710                    End  Until ((x  = RPCBroke rDoD.Resul ts.Count -  1) Or (Po s('1^', RP CBrokerDoD .Results[x ]) = 1));
  16711                  VAWrap GridDOD.Ro wCount :=  y;
  16712                End
  16713                Else
  16714                Begin
  16715                  inc(x) ;
  16716                End;
  16717                Progress BarLoadPt. Position : = x;
  16718                Progress BarLoadPt. Repaint;
  16719                StatusBa rLoadPt.Re paint;
  16720           En d Until x  >= RPCBrok erDoD.Resu lts.Count;
  16721           VA WrapGridDO DClick(App lication);
  16722           If  (laststri ng <> '')  And (lasts tring <> ' No remote  patient da ta found f or these r equest par ameters.')  Then
  16723              VAWrapGrid DOD.Cells[ 3, y] := P iece(lasts tring, ';' , 1);                 // Site
  16724           VA WrapGridDO DClick(App lication);
  16725         End;
  16726  
  16727         // R eport type  not coded , so use s tandard di splay
  16728         // A mbulatory  Data repor t will use  this
  16729         If R eportShown  = False T hen
  16730         Begi n
  16731           Pa nelDODGrid s.Visible  := False;
  16732           x  := 0;
  16733           Pr ogressBarL oadPt.Max  := RPCBrok erDoD.Resu lts.Count;
  16734           If  RPCBroker DoD.Result s.Count >  0 Then
  16735              Repeat
  16736                Begin
  16737                  RichEd itDODRepor t.Lines.Ad d(RPCBroke rDoD.Resul ts[x]);
  16738                  inc(x) ;
  16739                  Progre ssBarLoadP t.Position  := x;
  16740                  Progre ssBarLoadP t.Repaint;
  16741                  Status BarLoadPt. Repaint;
  16742              End Until  x >= RPCBr okerDoD.Re sults.Coun t;
  16743         End;
  16744  
  16745       End;
  16746  
  16747     RPCBroke rDoD.Conne cted := Fa lse;
  16748     sleep(10 00);
  16749  
  16750     // Set b ack ESSO v ersion
  16751     // The f ollowing c ode was ch anged beca use Togus  was lockin g after an  FHIE call
  16752     ESSOConn ecting :=  true;
  16753     RPCBroke r1.Connect ed := Fals e;
  16754     sleep(10 00);
  16755     //RPCBro ker1.Conne cted := tr ue;  BSE m od - rpm 4 /8/09
  16756     If Not C onnectToSe rver('DVBA  CAPRI GUI ') Then
  16757     Begin
  16758       ShowMe ssageCAPRI ('FHIE1: C ould not u se option  "DVBA CAPR I GUI!"');
  16759       applic ation.term inate;
  16760     End;
  16761     If RPCBr oker1.Conn ected = Fa lse Then
  16762     Begin
  16763       ShowMe ssageCAPRI ('FHIE2: C ould not u se option  "DVBA CAPR I GUI!"');
  16764       applic ation.term inate;
  16765     End;
  16766     ESSOConn ecting :=  False;
  16767     //////// ////////// ////////// ////////// ////////// ////////// ////////// //////////
  16768  
  16769     Progress BarLoadPt. Visible :=  False;
  16770     //RPCBro kerDoD.Con nected:=Fa lse;
  16771     TimeSinc eLastBroke rCall := 2 9;                                                     //Force pu lse
  16772     RPCBroke rDOD.ANUFH IEConnecti on := Fals e;
  16773  
  16774     AnimateL ogo(False) ;
  16775     StatusBa rLoadPt.Ca ption := ' Ready.';
  16776     StatusBa rLoadPt.Re paint;
  16777     Applicat ion.Proces smessages;
  16778     ORListBo xDODReport Types.enab led := tru e;
  16779   End;
  16780  
  16781   // DoD tab  function  - DoD tab  is no long er display ed so this  function  will 
  16782   // never e xecute.  P atch 193 J RL 7/21/16
  16783   Procedure  TfrmMain.H eaderContr olDODLRCSe ctionResiz e(
  16784     HeaderCo ntrol: THe aderContro l; Section : THeaderS ection);
  16785   Begin
  16786     VAWrapGr idDOD.ColC ount := 8;
  16787     VAWrapGr idDOD.ColW idths[0] : = HeaderCo ntrolDODLR C.Sections [0].Width  - 2;
  16788     VAWrapGr idDOD.ColW idths[1] : = HeaderCo ntrolDODLR C.Sections [1].Width  - 2;
  16789     VAWrapGr idDOD.ColW idths[2] : = HeaderCo ntrolDODLR C.Sections [2].Width  - 1;
  16790     VAWrapGr idDOD.ColW idths[3] : = HeaderCo ntrolDODLR C.Sections [3].Width  - 1;
  16791     VAWrapGr idDOD.ColW idths[4] : = HeaderCo ntrolDODLR C.Sections [4].Width  - 1;
  16792     VAWrapGr idDOD.ColW idths[5] : = HeaderCo ntrolDODLR C.Sections [5].Width  - 1;
  16793     VAWrapGr idDOD.ColW idths[6] : = HeaderCo ntrolDODLR C.Sections [6].Width  - 1;
  16794     VAWrapGr idDOD.ColW idths[7] : = HeaderCo ntrolDODLR C.Sections [7].Width  - 1;
  16795   End;
  16796  
  16797   // DoD tab  function  - DoD tab  is no long er display ed so this  function  will 
  16798   // never e xecute.  P atch 193 J RL 7/21/16
  16799   Procedure  TfrmMain.E ditDODMaxI temsExit(S ender: TOb ject);
  16800   Begin
  16801     Try
  16802       If Str ToInt(Edit DODMaxItem s.Text) <  1 Then
  16803     EditDODM axItems.Te xt := '100 ' Except
  16804     End;
  16805     Try
  16806     EditDODM axItems.Te xt := IntT oStr(StrTo Int(EditDO DMaxItems. Text))Exce pt EditDOD MaxItems.T ext := '10 0'
  16807     End;
  16808   End;
  16809  
  16810   Procedure  TfrmMain.T ab95Contro l3Change(S ender: TOb ject);
  16811   Begin
  16812     ScrollBo xAddress.V isible :=  False;
  16813     PanelApp ointments. Visible :=  False;
  16814     If Tab95 Control3.T abs[Tab95C ontrol3.Ta bIndex] =  '&V)  Addr ess' Then
  16815     Begin
  16816       Scroll BoxAddress .Visible : = True;
  16817     End;
  16818     If Tab95 Control3.T abs[Tab95C ontrol3.Ta bIndex] =  '&W)  Appo intments'  Then
  16819     Begin
  16820       PanelA ppointment s.Visible  := True;
  16821     End;
  16822   End;
  16823  
  16824   {========= ========== ========== ========== ========== ========== ========== =========
  16825     ca508Lis tBoxIPR1Va lueQuery
  16826       ca508L istBoxIPR1 ValueQuery  is a meth od that wi ll build a  string to  be
  16827         annu nciated by  a screen  reader for  ListBoxIP R1 items.   The probl em this
  16828         meth od correct s is the i nability o f a screen  reader to  list the  component
  16829         form s (sub-ite ms) listed  below a m erged form  item.
  16830         Note : Sub-item s start wi th '!'.  T he '!' is  a flag to  format dif ferently
  16831         and  prevent se lection.   The '!' ch aracter is  stripped  out on dis play.
  16832  
  16833     Modifica tion Histo ry:
  16834       CodeCR 117 - 11/2 010 Method  created - MER
  16835    ========= ========== ========== ========== ========== ========== ========== =========}
  16836  
  16837   procedure  TfrmMain.c a508ListBo xIPR1Value Query(Send er: TObjec t;
  16838     var Text : string);
  16839   var
  16840     lText: s tring;
  16841     lNdx: in teger;
  16842   begin
  16843     lNdx :=  ListBoxIPR 1.ItemInde x;
  16844     lText :=  '';
  16845     if (lNdx  > -1) the n begin
  16846       lText  := Copy(Li stBoxIPR1. Items[lNdx ], 2, Leng th(ListBox IPR1.Items [lNdx]) -  1);
  16847       Inc(lN dx);
  16848       while  (lNdx <= ( ListBoxIPR 1.Items.Co unt - 1))  and                              // not out  of range
  16849         (Cop y(ListBoxI PR1.Items[ lNdx], 1,  1) = '!')                                   // this it em is a su b-item
  16850         do b egin
  16851         lTex t := lText  + ',  Inc ludes form  ' + Copy( ListBoxIPR 1.Items[lN dx], 2, Le ngth(ListB oxIPR1.Ite ms[lNdx])  - 1);
  16852         Inc( lNdx);
  16853       end;
  16854     end;
  16855     Text :=  lText;
  16856   end;
  16857  
  16858  
  16859   procedure  TfrmMain.c bxSortExam ReqClick(S ender: TOb ject);
  16860   begin
  16861     case cbx SortExamRe q.ItemInde x of
  16862       0:                                                                                  // Ascendi ng
  16863         Reve rseExamReq uestSortOr der := Fal se;
  16864       1:                                                                                  // Descend ing
  16865         Reve rseExamReq uestSortOr der := Tru e;
  16866     end;
  16867  
  16868     ExamRequ estRefresh .Click;
  16869   end;                                                                                    // cbxSort ExamReqCli ck
  16870  
  16871   // DoD tab  function  - DoD tab  is no long er display ed so this  function  will 
  16872   // never e xecute.  P atch 193 J RL 7/21/16
  16873   Procedure  TfrmMain.V AWrapGridD ODClick(Se nder: TObj ect);
  16874   Var
  16875     x, y, z:  integer;
  16876     reportty pe: String ;
  16877     labdata:  String;
  16878   Begin
  16879     If VAWra pGridDOD.R ow < 0 The n
  16880       exit;
  16881     ReportTy pe := Piec e(ORListBo xDODReport Types.Item s[ORListBo xDODReport Types.Item Index], '^ ', 2); //  Report Typ e
  16882     RichEdit DODReport. Lines.Clea r;
  16883     If Repor tType = 'P N' Then
  16884     Begin
  16885       x := 0 ;
  16886       y := 0 ;
  16887       RichEd itDODRepor t.Visible  := False;
  16888       Repeat
  16889         Begi n
  16890           Re peat
  16891              inc(x);
  16892           Un til Piece( RichEditDO DTempRepor t.Lines[x] , '^', 1)  = '6';
  16893           If  VAWrapGri dDOD.Row =  y Then
  16894           Be gin
  16895              Repeat
  16896                RichEdit DODReport. Lines.Add( Piece(Rich EditDODTem pReport.Li nes[x], '^ ', 2));
  16897                inc(x);
  16898              Until Piec e(RichEdit DODTempRep ort.Lines[ x], '^', 1 ) <> '6';
  16899              // Force c ursor to t op
  16900              RichEditDO DReport.Li nes.Insert (0, '');
  16901              RichEditDO DReport.Li nes.Delete (0);
  16902              RichEditDO DReport.Vi sible := T rue;
  16903              exit;
  16904           En d
  16905           El se
  16906           Be gin
  16907              Repeat
  16908                inc(x);
  16909              Until Piec e(RichEdit DODTempRep ort.Lines[ x], '^', 1 ) <> '6';
  16910           En d;
  16911           Re peat
  16912              inc(x);
  16913           Un til Piece( RichEditDO DTempRepor t.Lines[x] , '^', 1)  = '8';
  16914           in c(x);
  16915           in c(y);
  16916       End Un til x >= R ichEditDOD TempReport .Lines.Cou nt;
  16917       // For ce cursor  to top
  16918       RichEd itDODRepor t.Lines.In sert(0, '' );
  16919       RichEd itDODRepor t.Lines.De lete(0);
  16920       RichEd itDODRepor t.Visible  := True;
  16921     End;
  16922     If Repor tType = 'C ONS' Then
  16923     Begin
  16924       x := 0 ;
  16925       y := 0 ;
  16926       If Ric hEditDODTe mpReport.L ines.Count  = 0 Then
  16927         exit ;
  16928  
  16929       // Sea rch for th e right re port chunk  in the re turned dat a
  16930       If VAW rapGridDOD .Row > y T hen
  16931         Repe at
  16932           Be gin
  16933              inc(x);
  16934              If Pos('1^ ', RichEdi tDODTempRe port.Lines [x]) = 1 T hen
  16935                inc(y);
  16936         End  Until y =  VAWrapGrid DOD.Row;
  16937  
  16938       // Fin d report a t 7th piec e
  16939       Repeat
  16940         Begi n
  16941           in c(x);
  16942       End Un til Pos('7 ^', RichEd itDODTempR eport.Line s[x]) = 1;
  16943  
  16944       // Add  the repor t and forc e exit at  end
  16945       RichEd itDODRepor t.Visible  := False;
  16946       Repeat
  16947         Begi n
  16948           Ri chEditDODR eport.Line s.Add(Piec e(RichEdit DODTempRep ort.Lines[ x], '^', 2 ));
  16949           in c(x);
  16950           If  x < RichE ditDODTemp Report.Lin es.Count -  1 Then
  16951              If Pos('7^ ', RichEdi tDODTempRe port.Lines [x]) <> 1  Then
  16952                x := Ric hEditDODTe mpReport.L ines.Count  + 1;
  16953       End Un til x > Ri chEditDODT empReport. Lines.Coun t - 1;
  16954       // For ce to top
  16955       RichEd itDoDRepor t.Lines.In sert(0, '' );
  16956       RichEd itDoDRepor t.Lines.De lete(0);
  16957       RichEd itDODRepor t.Visible  := True;
  16958  
  16959     End;
  16960  
  16961     If Repor tType = 'A LRG' Then
  16962     Begin
  16963       x := 0 ;
  16964       y := 0 ;
  16965       If Ric hEditDODTe mpReport.L ines.Count  = 0 Then
  16966         exit ;
  16967  
  16968       // Sea rch for th e right re port chunk  in the re turned dat a
  16969       If VAW rapGridDOD .Row > y T hen
  16970         Repe at
  16971           Be gin
  16972              inc(x);
  16973              If Pos('1^ ', RichEdi tDODTempRe port.Lines [x]) = 1 T hen
  16974                inc(y);
  16975         End  Until y =  VAWrapGrid DOD.Row;
  16976  
  16977       // Fin d report a t 6th piec e
  16978       If Pie ce(RichEdi tDODTempRe port.Lines [x], '^',  2) = 'No r emote pati ent data f ound for t hese reque st paramet ers.' Then
  16979         exit ;
  16980       RichEd itDODRepor t.Lines.Ad d('Facilit y:  ' + Pi ece(Piece( RichEditDO DTempRepor t.Lines[x] , '^', 2),  ';', 1));
  16981       inc(x) ;
  16982       RichEd itDODRepor t.Lines.Ad d('Charact eristic (A llergy Rea ctant):  '  + Piece(R ichEditDOD TempReport .Lines[x],  '^', 2));
  16983       inc(x) ;
  16984       RichEd itDODRepor t.Lines.Ad d('Type:   ' + Piece( RichEditDO DTempRepor t.Lines[x] , '^', 2)) ;
  16985       inc(x) ;
  16986       RichEd itDODRepor t.Lines.Ad d('Comment s:  ');
  16987       RichEd itDODRepor t.Visible  := False;
  16988       Repeat
  16989         Begi n
  16990           in c(x);
  16991       End Un til Pos('6 ^', RichEd itDODTempR eport.Line s[x]) = 1;
  16992  
  16993       // Add  the repor t and forc e exit at  end
  16994       RichEd itDODRepor t.Visible  := False;
  16995       Repeat
  16996         Begi n
  16997           Ri chEditDODR eport.Line s.Add(Piec e(RichEdit DODTempRep ort.Lines[ x], '^', 2 ));
  16998           in c(x);
  16999           If  x < RichE ditDODTemp Report.Lin es.Count -  1 Then
  17000              If Pos('6^ ', RichEdi tDODTempRe port.Lines [x]) <> 1  Then
  17001                x := Ric hEditDODTe mpReport.L ines.Count  + 1;
  17002       End Un til x > Ri chEditDODT empReport. Lines.Coun t - 1;
  17003       // For ce to top
  17004       RichEd itDoDRepor t.Lines.In sert(0, '' );
  17005       RichEd itDoDRepor t.Lines.De lete(0);
  17006       RichEd itDODRepor t.Visible  := True;
  17007  
  17008     End;
  17009  
  17010     If Repor tType = 'L RC' Then
  17011     Begin
  17012       x := 0 ;
  17013       y := 0 ;
  17014       Try
  17015         If P iece(RichE ditDODTemp Report.Lin es[1], ';' , 1) = 'No  remote pa tient data  found for  these req uest param eters.' Th en
  17016         Begi n
  17017           VA WrapGridDO D.Cells[0,  0] := Pie ce(RichEdi tDODTempRe port.Lines [1], ';',  1);
  17018           ex it;
  17019         End;
  17020       Except
  17021       End;
  17022       If VAW rapGridDOD .Row <> x  Then
  17023         Repe at
  17024           Be gin
  17025              inc(y);
  17026              If Pos('^' , RichEdit DODTempRep ort.Lines[ y]) > 0 Th en
  17027                inc(x);
  17028         End  Until x =  VAWrapGrid DOD.Row;
  17029       //Gene ral Info
  17030       RichEd itDODRepor t.Lines.Ad d('** Lab  Test Detai ls **');
  17031       labdat a := RichE ditDODTemp Report.Lin es[y];
  17032       RichEd itDODRepor t.Lines.Ad d('Date:      ' + Pie ce(labdata , '^', 1)) ;
  17033       RichEd itDODRepor t.Lines.Ad d('Test:      ' + Pie ce(labdata , '^', 3)) ;
  17034       RichEd itDODRepor t.Lines.Ad d('Specime n: ' + Pie ce(labdata , '^', 2)) ;
  17035       RichEd itDODRepor t.Lines.Ad d('Result:    ' + Pie ce(labdata , '^', 4)  + ' ' + Pi ece(labdat a, '^', 6) );
  17036       RichEd itDODRepor t.Lines.Ad d('Flag:      ' + Pie ce(labdata , '^', 5)) ;
  17037       RichEd itDODRepor t.Lines.Ad d('Ref Low :  ' + Pie ce(labdata , '^', 7)) ;
  17038       RichEd itDODRepor t.Lines.Ad d('Ref Hig h: ' + Pie ce(labdata , '^', 8)) ;
  17039       inc(y) ;
  17040       //Loca tion
  17041       RichEd itDODRepor t.Lines.Ad d('Site:      ' + Pie ce(RichEdi tDODTempRe port.Lines [y], ';',  1));
  17042       inc(y) ;
  17043       // Get  comments,  if any
  17044       If (Po s('^', Ric hEditDODTe mpReport.L ines[y]) =  0) Then
  17045       Begin
  17046         Rich EditDODRep ort.Lines. Add('Comme nts:');
  17047         Repe at
  17048           Be gin
  17049              RichEditDO DReport.Li nes.Add(Ri chEditDODT empReport. Lines[y]);
  17050              inc(y);
  17051         End  Until (y >  RichEditD ODTempRepo rt.Lines.C ount - 1)  Or (Pos('^ ', RichEdi tDODTempRe port.Lines [y]) > 0);
  17052       End;
  17053     End;
  17054     If Repor tType = 'D S' Then
  17055     Begin
  17056       RichEd itDoDRepor t.Lines.Cl ear;
  17057       x := - 1;
  17058       y := - 1;
  17059       Repeat
  17060         Begi n
  17061           in c(x);
  17062           If  piece(Ric hEditDODTe mpReport.L ines[x], ' ^', 1) = ' 1' Then
  17063              inc(y);
  17064           If  y = VAWra pGridDod.R ow Then
  17065              y := -2;
  17066       End Un til y = -2 ;
  17067       //Repo rt
  17068       Repeat
  17069         Begi n
  17070           in c(x);
  17071           If  x > RichE ditDODTemp Report.Lin es.Count T hen
  17072              exit;
  17073       End Un til Piece( RichEditDO DTempRepor t.Lines[x] , '^', 1)  = '9';
  17074       dec(x) ;
  17075       Repeat
  17076         inc( x);
  17077         Rich EditDoDRep ort.Lines. Add(Piece( RichEditDO DTempRepor t.Lines[x] , '^', 2)) ;
  17078       Until  (x >= Rich EditDodTem pReport.Li nes.Count)  Or (Piece (RichEditD odTempRepo rt.Lines[x ], '^', 1)  <> '9');
  17079     End;
  17080     If Repor tType = 'M I' Then
  17081     Begin
  17082       x := 0 ;
  17083       y := 0 ;
  17084       If VAW rapGridDOD .Row <> x  Then
  17085         Repe at
  17086           Be gin
  17087              inc(y);
  17088              If Pos('^' , RichEdit DODTempRep ort.Lines[ y]) > 0 Th en
  17089              Begin
  17090                inc(x);
  17091                Repeat
  17092                  inc(y) ;
  17093                Until Po s('^', Ric hEditDODTe mpReport.L ines[y]) >  0;
  17094                inc(y);                                                                    //Results  line
  17095                inc(y);                                                                    //Site Lin e
  17096              End;
  17097         End  Until (x =  VAWrapGri dDOD.Row)  Or (y > VA WrapGridDO D.Row);
  17098       //Repo rt
  17099       inc(y) ;                                                                            // Skip fi rst line t hat's used  to popula te the gri d
  17100       Repeat
  17101         Begi n
  17102           in c(y);
  17103           If  Pos('^',  RichEditDO DTempRepor t.Lines[y] ) = 0 Then
  17104              RichEditDO DReport.Li nes.Add(Ri chEditDODT empReport. Lines[y]);
  17105       End Un til (Pos(' ^', RichEd itDODTempR eport.Line s[y]) > 0)  Or (y > R ichEditDOD Report.Lin es.Count);
  17106       inc(y) ;
  17107       inc(y) ;                                                                            // Results  Line
  17108       If Pie ce(RichEdi tDODTempRe port.Lines [y], ';',  1) <> '' T hen
  17109         Rich EditDODRep ort.Lines. Add('Site:  ' + Piece (RichEditD ODTempRepo rt.Lines[y ], ';', 1) ); // Site  Line
  17110     End;
  17111     If Repor tType = 'R R' Then
  17112     Begin                                                                                 // Radiolo gy
  17113       x := 0 ;
  17114       y := 0 ;
  17115       z := 0 ;                                                                            // Used as  backup co unter to f orce exit
  17116       If VAW rapGridDOD .Row <> x  Then
  17117         Repe at
  17118           Be gin
  17119              If Pos('^' , RichEdit DODTempRep ort.Lines[ y]) > 0 Th en
  17120              Begin
  17121                inc(x);
  17122                Repeat
  17123                  inc(y) ;
  17124                Until (P os('^', Ri chEditDODT empReport. Lines[y])  > 0) Or (y  > RichEdi tDODTempRe port.Lines .Count - 1 );
  17125              End;
  17126              inc(z);
  17127         End  Until (x =  VAWrapGri dDOD.Row)  Or (x > VA WrapGridDO D.Row) Or  ((z > 1000 0) And ((x  = 0) And  (y = 0)));
  17128       RichEd itDoDRepor t.visible  := False;
  17129       //Repo rt
  17130       Repeat
  17131         Begi n
  17132           in c(y);
  17133           If  Pos('^',  RichEditDO DTempRepor t.Lines[y] ) = 0 Then
  17134              RichEditDO DReport.Li nes.Add(Ri chEditDODT empReport. Lines[y]);
  17135       End Un til (y > R ichEditDOD TempReport .Lines.Cou nt - 1) Or  (Pos('^',  RichEditD ODTempRepo rt.Lines[y ]) > 0);
  17136       If x =  VAWrapGri dDOD.RowCo unt - 1 Th en
  17137       Begin
  17138         If P iece(RichE ditDODRepo rt.Lines[R ichEditDOD Report.Lin es.Count -  2], ';',  1) <> '' T hen
  17139           Ri chEditDODR eport.Line s[RichEdit DODReport. Lines.Coun t - 2] :=  ('Site: '  + Piece(Ri chEditDODR eport.Line s[RichEdit DODReport. Lines.Coun t - 2], '; ', 1)) //  Site Line
  17140       End
  17141       Else
  17142       Begin
  17143         If P iece(RichE ditDODRepo rt.Lines[R ichEditDOD Report.Lin es.Count -  1], ';',  1) <> '' T hen
  17144           Ri chEditDODR eport.Line s[RichEdit DODReport. Lines.Coun t - 1] :=  ('Site: '  + Piece(Ri chEditDODR eport.Line s[RichEdit DODReport. Lines.Coun t - 1], '; ', 1)); //  Site Line
  17145       End;
  17146       RichEd itDoDRepor t.Lines.In sert(0, '' );
  17147       RichEd itDoDRepor t.Lines.De lete(0);
  17148       RichEd itDoDRepor t.visible  := True;
  17149     End;
  17150     If (Repo rtType = ' CY') Or (R eportType  = 'SP') Th en
  17151     Begin
  17152       //rra  1249163 be gin
  17153       If VAW rapGridDod .Cells[0,  0] = 'No r emote pati ent data f ound for t hese reque st paramet ers.' Then
  17154         exit ;                                                                            // Surgica l Patholog y/Cytology     x:=0;
  17155       y := 0 ;
  17156       x := 0 ;
  17157       if VAW rapGridDOD .Row <> x  then
  17158       begin
  17159         whil e x <> VAW rapGridDOD .Row do
  17160         begi n
  17161           in c(y);
  17162           if  Pos('^',  RichEditDO DTempRepor t.Lines[y] ) > 0 then
  17163           be gin                                                                          // Skip 2  lines
  17164              inc(x);
  17165              inc(y);
  17166           en d;
  17167         end;
  17168       end;
  17169  
  17170       inc(y,  2);                                                                         //  Jan 10 , 2001^010 111 CG 192
  17171       if x =  0 Then
  17172         inc( y);                                                                          // Need to  do this f or 1st ent ry to get  the pointe r to the r ight spot;
  17173            / / Add repo rt
  17174       while  (y < RichE ditDODTemp Report.Lin es.Count)  and (Pos(' ^', RichEd itDODTempR eport.Line s[y]) < 1)  do
  17175       begin
  17176         Rich EditDODRep ort.Lines. Add(RichEd itDODTempR eport.Line s[y]);
  17177         inc( y);
  17178       end;
  17179       RichEd itDODRepor t.Lines[Ri chEditDODR eport.Line s.Count -  1] := 'Sit e: ' + Pie ce(RichEdi tDODReport .Lines[Ric hEditDODRe port.Lines .Count - 1 ], ';', 1) ;
  17180     end;
  17181       //rra  1249163 en d
  17182   End;
  17183  
  17184   // DoD tab  function  - DoD tab  is no long er display ed so this  function  will 
  17185   // never e xecute.  P atch 193 J RL 7/21/16
  17186   Procedure  TfrmMain.H eaderContr olDODLRCYS ectionResi ze(
  17187     HeaderCo ntrol: THe aderContro l; Section : THeaderS ection);
  17188   Begin
  17189     VAWrapGr idDOD.ColC ount := 4;
  17190     VAWrapGr idDOD.ColW idths[0] : = HeaderCo ntrolDODLR CY.Section s[0].Width  - 2;
  17191     VAWrapGr idDOD.ColW idths[1] : = HeaderCo ntrolDODLR CY.Section s[1].Width  - 2;
  17192     VAWrapGr idDOD.ColW idths[2] : = HeaderCo ntrolDODLR CY.Section s[2].Width  - 1;
  17193     VAWrapGr idDOD.ColW idths[3] : = HeaderCo ntrolDODLR CY.Section s[3].Width  - 1;
  17194   End;
  17195  
  17196   // DoD tab  function  - DoD tab  is no long er display ed so this  function  will 
  17197   // never e xecute.  P atch 193 J RL 7/21/16
  17198   Procedure  TfrmMain.H eaderContr olDODMISec tionResize (
  17199     HeaderCo ntrol: THe aderContro l; Section : THeaderS ection);
  17200   Begin
  17201     VAWrapGr idDOD.ColC ount := 4;
  17202     VAWrapGr idDOD.ColW idths[0] : = HeaderCo ntrolDODMI .Sections[ 0].Width -  2;
  17203     VAWrapGr idDOD.ColW idths[1] : = HeaderCo ntrolDODMI .Sections[ 1].Width -  2;
  17204     VAWrapGr idDOD.ColW idths[2] : = HeaderCo ntrolDODMI .Sections[ 2].Width -  1;
  17205     VAWrapGr idDOD.ColW idths[3] : = HeaderCo ntrolDODMI .Sections[ 3].Width -  1;
  17206   End;
  17207  
  17208   // DoD tab  function  - DoD tab  is no long er display ed so this  function  will 
  17209   // never e xecute.  P atch 193 J RL 7/21/16
  17210   Procedure  TfrmMain.H eaderContr olDODRRSec tionResize (
  17211     HeaderCo ntrol: THe aderContro l; Section : THeaderS ection);
  17212   Begin
  17213     VAWrapGr idDOD.ColC ount := 3;
  17214     VAWrapGr idDOD.ColW idths[0] : = HeaderCo ntrolDODRR .Sections[ 0].Width -  2;
  17215     VAWrapGr idDOD.ColW idths[1] : = HeaderCo ntrolDODRR .Sections[ 1].Width -  2;
  17216     VAWrapGr idDOD.ColW idths[2] : = HeaderCo ntrolDODRR .Sections[ 2].Width -  1;
  17217   End;
  17218  
  17219   // DoD tab  function  - DoD tab  is no long er display ed so this  function  will 
  17220   // never e xecute.  P atch 193 J RL 7/21/16
  17221   Procedure  TfrmMain.B utton1Clic k(Sender:  TObject);
  17222   Var
  17223     x, y: in teger;
  17224     foundfla g: boolean ;
  17225   Begin
  17226     If ANURe moteProced ureCallInP rogress =  True Then
  17227       exit;
  17228     frmGraph FHIE := Tf rmGraphFHI E.Create(f rmMain);
  17229     frmGraph FHIE.Chart FHIEData.S eries[0].C lear;
  17230     frmGraph FHIE.Chart FHIEData.S eries[1].C lear;
  17231     frmGraph FHIE.Chart FHIEData.S eries[2].C lear;
  17232     frmGraph FHIE.Chart FHIEData.T itle.Text. Clear;
  17233     frmGraph FHIE.Chart FHIEData.T itle.Text. Add('Selec t a Test t o Graph');
  17234     frmGraph FHIE.ListB oxTests.It ems.Clear;
  17235     // Add t ests, only  once thou gh
  17236     If VAWra pGridDOD.R owCount >  0 Then
  17237       For y  := 0 To VA WrapGridDO D.RowCount  - 1 Do
  17238       Begin
  17239         foun dflag := f alse;
  17240         If f rmGraphFHI E.ListBoxT ests.Items .Count > 0  Then
  17241         Begi n
  17242           Tr y
  17243              For x := 0  To frmGra phFHIE.Lis tBoxTests. Items.Coun t - 1 Do
  17244                If frmGr aphFHIE.Li stBoxTests .Items[x]  = VAWrapGr idDOD.Cell s[1, y] Th en
  17245                  foundf lag := tru e;
  17246              If FoundFl ag = False  Then
  17247                frmGraph FHIE.ListB oxTests.It ems.Add(VA WrapGridDO D.Cells[1,  y]);
  17248           Ex cept
  17249           En d;
  17250         End
  17251         Else
  17252         Try
  17253           fr mGraphFHIE .ListBoxTe sts.Items. Add(VAWrap GridDOD.Ce lls[1, y]) ;
  17254         Exce pt
  17255         End;
  17256       End;
  17257  
  17258     frmGraph FHIE.ShowM odal;
  17259     frmGraph FHIE.relea se;
  17260     frmGraph FHIE := Ni l;
  17261   End;
  17262  
  17263   Procedure  TfrmMain.B uttonCPTCo pyrightCli ck(Sender:  TObject);
  17264   Begin
  17265     buttonCP TCopyright .Visible : = False;
  17266     MemoCPTC opyright.V isible :=  False;
  17267   End;
  17268  
  17269   Procedure  TfrmMain.T imerFHIERu nningTimer (Sender: T Object);
  17270   Begin
  17271     // Updat es progres s meter so  that it i s at 100%  after 3 mi nutes
  17272     Progress BarLoadPt. Position : = Progress BarLoadPt. Position +  1;
  17273     If Progr essBarLoad Pt.Positio n >= 100 T hen
  17274     Begin
  17275       TimerF HIERunning .Enabled : = False;
  17276       RPCBro kerDOD.Con nected :=  False;
  17277       Progre ssBarLoadP t.Visible  := False;
  17278       ANURem oteProcedu reCallInPr ogress :=  False;
  17279       ShowMe ssageCAPRI ('DoD repo rt is taki ng a long  time to ru n.  It wil l continue  to run in  the backg round, but  you must  re-run thi s report l ater to re trieve all  of the re sults.');
  17280       ANURem oteProcedu reCallInPr ogress :=  False;
  17281       ORList BoxDoDRepo rtTypes.En abled := T rue;
  17282       Status BarLoadPt. Caption :=  'FHIE rep ort did no t finish.' ;
  17283       frmMai n.AnimateL ogo(False) ;
  17284     End;
  17285   End;
  17286  
  17287   Procedure  TfrmMain.T imerHaltTi mer(Sender : TObject) ;
  17288   Var
  17289     x: integ er;
  17290   Begin
  17291     messageb eep(0);
  17292     timerhal t.enabled  := false;
  17293     For x :=  1 To 500  Do
  17294       applic ation.proc essmessage s;
  17295     frmMain. show;
  17296     frmMain. activate;
  17297     applicat ion.termin ate;
  17298   End;
  17299  
  17300   Procedure  TfrmMain.H eaderContr olDODDCSSe ctionResiz e(
  17301     HeaderCo ntrol: THe aderContro l; Section : THeaderS ection);
  17302   Begin
  17303     //
  17304     VAWrapGr idDOD.ColC ount := 6;
  17305     VAWrapGr idDOD.ColW idths[0] : = HeaderCo ntrolDODDC S.Sections [0].Width  - 2;
  17306     VAWrapGr idDOD.ColW idths[1] : = HeaderCo ntrolDODDC S.Sections [1].Width  - 2;
  17307     VAWrapGr idDOD.ColW idths[2] : = HeaderCo ntrolDODDC S.Sections [2].Width  - 1;
  17308     VAWrapGr idDOD.ColW idths[3] : = HeaderCo ntrolDODDC S.Sections [3].Width  - 1;
  17309     VAWrapGr idDOD.ColW idths[4] : = HeaderCo ntrolDODDC S.Sections [4].Width  - 1;
  17310     VAWrapGr idDOD.ColW idths[5] : = HeaderCo ntrolDODDC S.Sections [5].Width  - 1;
  17311   End;
  17312  
  17313   Procedure  TfrmMain.B uttonIPRDi splayClick (Sender: T Object);
  17314   Var
  17315     SenderNa me: String ;
  17316   Begin
  17317     Inherite d;
  17318     SenderNa me := 'frm main.butto niprdispla y';
  17319     PNCSShow Modal(
  17320       FMComm entsMemo,                                                                    //FMCommen tsMemo       : TFMMem o;   //FMC ommentsMem o: TFMMemo ;
  17321       FMEdit IPR10,                                                                       //FMEditIP R10          : TFMEdi t;   //FME ditIPR10:  TFMEdit;
  17322       FMEdit IPR11,                                                                       //FMEditIP R11          : TFMEdi t;   //FME ditIPR11:  TFMEdit;
  17323       FMEdit IPR2,                                                                        //FMEditIP R2           : TFMEdi t;   //FME ditIPR2: T FMEdit;
  17324       FMEdit IPR6,                                                                        //FMEditIP R6           : TFMEdi t;   //FME ditIPR6: T FMEdit;
  17325       FMEdit IPR7,                                                                        //FMEditIP R7           : TFMEdi t;   //FME ditIPR7: T FMEdit;
  17326       FMEdit IPR8,                                                                        //FMEditIP R8           : TFMEdi t;   //FME ditIPR8: T FMEdit;
  17327       FMEdit ReviewStat us,                                                               //FMEditRe viewStatus   : TFMEdi t;   //FME ditReviewS tatus: TFM Edit;
  17328       FMGets IPRFile,                                                                     //FMGetsIP RFile        : TFMGet s;   //FMG etsIPRFile : TFMGets;
  17329       FMGets IPRFile3,                                                                    //FMGetsIP RFile3       : TFMGet s;   //FMG etsIPRFile 3: TFMGets ;
  17330       FMGets TemplateIn fo,                                                               //FMGetsTe mplateInfo   : TFMGet s;   //FMG etsTemplat eInfo: TFM Gets;
  17331       FMList boxIPR1,                                                                     //FMListBo x            : TFMLis tBox;//FML istboxIPR1  : TFMList Box;
  17332       ListBo xIPR1,                                                                       //ListBoxI PR1          : TListB ox;  //Lis tBoxIPR1:  TListBox;
  17333       MiniZi p1,                                                                          //MiniZip1              : TMiniZ ip;  //Min iZip1: TMi niZip;
  17334       FMMemo FormDefini tion,                                                             //mmoFormD efinition    : TRichE dit; //FMM emoFormDef inition: T RichEdit;
  17335       RichEd itReport,                                                                    //mmoRepor t            : TRichE dit; //Ric hEditRepor t: TRichEd it;
  17336       FMMemo ReportDefi nition,                                                           //mmoRepor tDefinitio n : TRichE dit; //FMM emoReportD efinition:  TRichEdit ;
  17337       FMMemo ScriptDefi nition,                                                           //mmoScrip tDefinitio n : TRichE dit; //FMM emoScriptD efinition:  TRichEdit ;
  17338       Sender ,                                                                            //Sender                : TObjec t;
  17339       Sender Name,                                                                        //SenderNa me           : String ;
  17340       Status BarLoadPt,                                                                   //StatusMs g            : TLabel ;    //Sta tusBarLoad Pt: TLabel ;
  17341       xFMEdi tObjectCou nt,                                                               //xFMEditO bjectCount   : TFMEdi t;   //xFM EditObject Count: TFM Edit;
  17342       xFMTem platesUtil ized                                                              //xFMTempl atesUtiliz ed: TFMMem o    //xFM TemplatesU tilized: T FMMemo;
  17343       );
  17344   End;
  17345  
  17346   Procedure  TfrmMain.B uttonIPRDe leteClick( Sender: TO bject);
  17347   Var
  17348     TempFMLi stbox: TFM Listbox;
  17349     //tempAu thorIEN: S tring;
  17350     tempTran scriberIEN : String;
  17351     x: integ er;
  17352     s: Strin g;
  17353   Begin
  17354     Inherite d;
  17355     If PNCSF orm <> Nil  Then
  17356     Begin
  17357       Showme ssageCAPRI ('You have  an exam t emplate op en.  Delet e cannot b e performe d until th e template  is closed .');
  17358       actToo lsBringExa mToFront.E xecute;
  17359       exit;
  17360     End;
  17361  
  17362     If ANURe moteProced ureCallInP rogress =  True Then
  17363       exit;
  17364  
  17365     If butto nIPRDelete .enabled =  false The n
  17366       exit;
  17367  
  17368     FMListbo xIPR1.Item Index := F MListBoxIP R1.Items.C ount - 1 -  ListBoxIP R1.ItemInd ex;
  17369     TempFMLi stbox := F MListboxIP R1 As TFML istBox;
  17370  
  17371     FMGetsIP RFile.IENS  := TempFM ListBox.Ge tSelectedR ecord.IEN;
  17372     FMGetsIP RFile.GetA ndFill;
  17373     FMGetsIP RFile3.IEN S := FMGet sIPRFile.I ENS;
  17374     FMGetsIP RFile3.Get AndFill;
  17375     If (FMEd itIPR8.Tex t <> '') A nd (FMEdit IPR8.Text  <> 'JAN 01 , 1980') A nd (FMEdit IPR8.Text  <> 'JAN 1,  1980') An d
  17376       (FMEdi tIPR8.Text  <> 'JAN 1 ,1980') Th en
  17377       Locked  := True
  17378     Else
  17379       Locked  := False;                                                                   {If there  is a saved  date, loc k the reco rd}
  17380     If Locke d = True T hen
  17381     Begin
  17382       ShowMe ssageCAPRI ('You can' 't delete  a signed f orm!');
  17383       exit;
  17384     End;
  17385     tempAuth orIEN := F MGetsIPRFi le3.GetFie ld('2').FM DBInternal ;
  17386     tempTran scriberIEN  := FMGets IPRFile3.G etField('1 0').FMDBIn ternal;
  17387  
  17388     // QC #2 016 - jcs  - Prevent  unauthoriz ed user fr om deletin g an 'unlo cked' exam
  17389     // Comme nted out o riginal co de to make  this chec k the same  as the on e on the u nsigned
  17390     //form
  17391     if not f rmMain.IsA llowed2Ope nExam(FMGe tsIPRFile. IENS) then
  17392     begin
  17393       ShowMe ssageCAPRI ('You must  be author , transcri ber, or ho ld advance d security  privilege s to delet e this inc omplete te mplate.');
  17394       Exit;
  17395     end;
  17396  
  17397     //If Aut horIEN <>  tempAuthor IEN Then
  17398     //  If A uthorIEN < > tempTran scriberIEN  Then
  17399     //    If  Pos('@',  userfilema ncode) = 0  Then
  17400     //    Be gin
  17401     //       ShowMessag eCAPRI('Yo u must be  author, tr anscriber,  or hold a dvanced se curity pri vileges to  delete th is incompl ete templa te.');
  17402     //       exit;
  17403     //    En d;
  17404  
  17405     //If Loc ked=False  then if Ap plication. MessageBox ('CAUTION! !!  Are yo u really s ure you wa nt to dele te this un signed for m?','Cance l?',4)=IDY es then
  17406  
  17407     frmDelet eTemplate  := TfrmDel eteTemplat e.Create(s elf);
  17408     frmDelet eTemplate. memoTempla teInfo.Lin es.Clear;
  17409     frmDelet etemplate. memoTempla teInfo.Lin es.Add('   Name: ' +  Uppercase( Copy(frmMa in.Panel1. caption, 1 , Pos('  S SN#', frmM ain.Panel1 .Caption)) ) + '   SS N: ' + Pat ientSSN +  '   C-Numb er: ' +
  17410       frmMai n.CNumber. Caption);
  17411     frmDelet etemplate. memoTempla teInfo.Lin es.Add('') ;
  17412     frmDelet eTemplate. memoTempla teInfo.Lin es.Add(Lis tBoxIPR1.I tems[ListB oxIPR1.Ite mIndex]);
  17413     x := 1;
  17414     If ListB oxIPR1.Ite mIndex < L istBoxIPR1 .Items.Cou nt - 1 The n
  17415       If Cop y(ListBoxI PR1.Items[ ListBoxIPR 1.ItemInde x + 1], 1,  1) = '!'  Then
  17416         Repe at
  17417           s  := ListBox IPR1.Items [ListBoxIP R1.ItemInd ex + x];
  17418           s  := copy(s,  2, length (s) - 1);
  17419           fr mDeleteTem plate.memo TemplateIn fo.Lines.A dd(s);
  17420           in c(x);
  17421           If  x + ListB oxIPR1.Ite mIndex > L istBoxIPR1 .Items.Cou nt - 1 The n
  17422              x := 0;                                                                      // Need to  do this t o prevent  range chec k error af ter last i tem
  17423         Unti l (x = 0)  Or (Copy(L istBoxIPR1 .Items[Lis tBoxIPR1.I temIndex +  x], 1, 1)  <> '!');
  17424  
  17425     If Locke d = False  Then
  17426       If frm DeleteTemp late.ShowM odal = mrO K Then
  17427       Begin
  17428         Dele teRecord(f rmMain.RPC Broker1, ' 396.17', F MGetsIPRFi le3.IENS);
  17429         Butt onIPRRefre shClick(Ap plication) ;                                           {Refresh}
  17430       End;
  17431     frmDelet eTemplate. release;
  17432     ButtonIP RDelete.En abled := F alse;
  17433     ButtonIP RCopy.Enab led := Fal se;
  17434   End;
  17435  
  17436   Procedure  TfrmMain.D imMenuOpti ons;
  17437   Begin
  17438   //  Unsign edCPWorksh eets1.Enab led := Fal se;
  17439   //  UnCosi gnedTIUDoc uments1.en abled := f alse;
  17440   //  Select Patient1.E nabled :=  False;
  17441   //  BitBtn VistA.enab led := Fal se;
  17442   //  Report s1.Enabled  := False;
  17443   //  Change Forwarding Address1.E nabled :=  False;
  17444   //  Search foraPatien tGlobal1.E nabled :=  False;
  17445   //  Editel ectronicSi gnatureCod e1.Enabled  := False;
  17446   //  EditEx amListPara metersMAS1 .Enabled : = False;
  17447   //  EditCP ExamReport s1.enabled  := false;
  17448   //  Uncosi gnedCPWork sheetUtili ty1.Enable d := False ;
  17449   //  CheckR emoteConne ctions1.En abled := F alse;
  17450   //  RPCBro kerCallHis toryBuffer 1.enabled  := false;
  17451   //  EditRe moteUserSi teAccess1. Enabled :=  False;
  17452   //  EditPa tientLists 1.Enabled  := False;
  17453   //  AuditT rail1.Enab led := Fal se;
  17454   //  Consol idatedRepo rts1.Enabl ed := Fals e;
  17455   //  Proper ties1.Enab led := Fal se;
  17456   //  Vista1 .Enabled : = False;
  17457   //  Print1 .Enabled : = False;
  17458   //  Printe rSetup1.En abled := F alse;
  17459   //  Switch Sites1.Ena bled := Fa lse;
  17460   //  About1 .Enabled : = False;
  17461   //  CheckR emoteConne ctions1.En abled := F alse;
  17462   //  EditRe moteUserSi teAccess1. Enabled :=  False;
  17463   //  AuditT rail1.Enab led := Fal se;
  17464   //  Consol idatedRepo rts1.Enabl ed := Fals e;
  17465   End;
  17466  
  17467   Procedure  TfrmMain.R estoreMenu Options;
  17468   Begin
  17469   //  Unsign edCPWorksh eets1.Enab led := Tru e;
  17470   //  UnCosi gnedTIUDoc uments1.en abled := T rue;
  17471   //  Select Patient1.E nabled :=  True;
  17472   //  if ESS OVersion t hen
  17473   //    BitB tnVistA.en abled := T rue;   //o nly remote  connectio ns - rpm 3 /17/09
  17474   //  Report s1.Enabled  := True;
  17475   //  Change Forwarding Address1.E nabled :=  True;
  17476   //  Search foraPatien tGlobal1.E nabled :=  True;
  17477   //  Editel ectronicSi gnatureCod e1.Enabled  := True;
  17478   //  EditEx amListPara metersMAS1 .Enabled : = True;
  17479   //  EditCP ExamReport s1.enabled  := true;
  17480   //  Uncosi gnedCPWork sheetUtili ty1.Enable d := True;
  17481   //  CheckR emoteConne ctions1.En abled := T rue;
  17482   //  RPCBro kerCallHis toryBuffer 1.enabled  := true;
  17483   //  EditRe moteUserSi teAccess1. Enabled :=  True;
  17484   //  EditPa tientLists 1.Enabled  := True;
  17485   //  AuditT rail1.Enab led := Tru e;
  17486   //  Consol idatedRepo rts1.Enabl ed := True ;
  17487   //  Proper ties1.Enab led := Tru e;
  17488   //  Vista1 .Enabled : = True;
  17489   //  Print1 .Enabled : = True;
  17490   //  Printe rSetup1.En abled := T rue;
  17491   //  If Ess oVersion =  True Then
  17492   //    Swit chSites1.E nabled :=  True;
  17493   //  About1 .Enabled : = true;
  17494   //  CheckR emoteConne ctions1.En abled := t rue;
  17495   //  EditRe moteUserSi teAccess1. Enabled :=  true;
  17496   //  AuditT rail1.Enab led := tru e;
  17497   //  Consol idatedRepo rts1.Enabl ed := true ;
  17498   End;
  17499  
  17500   Procedure  TfrmMain.B uttonIPRRe freshClick (Sender: T Object);
  17501   Var
  17502     x: longi nt;
  17503     xx: inte ger;
  17504     ListPoin t: LongInt ;
  17505   Begin
  17506     Inherite d;
  17507     If ANURe moteProced ureCallInP rogress =  True Then
  17508       exit;
  17509     DimMenuO ptions;
  17510  
  17511     Page95Co ntrol1.Act ivePage :=  TabCPWork sheets;
  17512  
  17513  
  17514     if VaUti ls.ScreenR eaderActiv e then                                                 // -MER Co deCR117 10 /2010
  17515       LabelG ridHeader. Caption :=  'Template  Name, col umn 1 of 4 .  Date Si gned, colu mn 2 of 4.  Author, c olumn 3 of  4.  Statu s, column  4 of 4'
  17516     else
  17517       LabelG ridHeader. Caption :=  Format('% -33s %-4s% -19s  %-19 s  %-6s',  ['Template  Name', '' , 'Date Si gned', 'Au thor', 'St atus']);
  17518  
  17519     ListBoxI PR1.Items. Clear;
  17520     ButtonIP RCopy.Enab led := Fal se;
  17521     ButtonIP RDelete.En abled := F alse;
  17522     ButtonIP RCopy.Enab led := Fal se;
  17523     ButtonIP RDisplay.E nabled :=  False;
  17524  
  17525     {CodeCR1 74 - rpm 4 /12/11 - s treamlined  the follo wing secti on by retr ieving
  17526                                  t he entire  list at on ce and scr eening on  the
  17527                                  p atient's I EN.  This  eliminated  the need  for
  17528                                  F MListerIPR 2 and FMLi stBoxIPR2.  }
  17529     FMLister IPR1.Liste rFlags :=  [];                                                    //return e xternal va lues
  17530     FMLister IPR1.Numbe r := '*';                                                         //don't re strict num ber of rec ords retur ned
  17531     FMLister IPR1.PartL ist.Clear;                                                        //PartList  improves  selection  efficiency
  17532     FMLister IPR1.PartL ist.Add(Pa tientName) ;
  17533     FMLister IPR1.Scree n := 'I $P (^(0),U,1) =' + Patie ntIEN;                           //return o nly this p atient's r ecords
  17534     ListPoin t := ListB oxIPR1.Ite mIndex;
  17535  
  17536     FMListBo xIPR1.GetL ist;
  17537  
  17538     If ANURe moteProced ureCallInP rogress =  True Then
  17539       exit;
  17540  
  17541     // Now g et rid of  name at be ginning of  list sinc e we alrea dy know
  17542     // the p atient we' re accessi ng
  17543     For x :=  FMListBox IPR1.Items .Count - 1  Downto 0  Do
  17544       FMList BoxIPR1.It ems[x] :=  Copy(FMLis tBoxIPR1.I tems[x], P os('  ', F MListBoxIP R1.Items[x ]) + 4, 25 5);
  17545  
  17546     //figure  out merge d forms an d expand
  17547     If FMLis tBoxIPR1.I tems.Count  > 0 Then
  17548     Begin
  17549       For x  := FMListB oxIPR1.Ite ms.Count -  1 Downto  0 Do
  17550       Begin
  17551         If ( Copy(FMLis tBoxIPR1.I tems[x], 1 , Length(' *MERGED FO RM  ')) =  '*MERGED F ORM  ') Or
  17552           (C opy(FMList BoxIPR1.It ems[x], 1,  Length('M ERGED FORM   ')) = 'M ERGED FORM   ') Then
  17553         Begi n
  17554           //  Replace t he text bu t keep the  rest of t he line
  17555           If  Copy(FMLi stBoxIPR1. Items[x],  1, 1) = '* ' Then
  17556              FMListBoxI PR1.Items[ x] := '*ME RGED FORMS  - LISTED  BELOW:  '  + Copy(FML istBoxIPR1 .Items[x],  pos('  ',  FMListBox IPR1.Items [x]) + 2,  length(FML istBoxIPR1 .Items[x]) )
  17557           El se
  17558              FMListBoxI PR1.Items[ x] := 'MER GED FORMS  - LISTED B ELOW:  ' +  Copy(FMLi stBoxIPR1. Items[x],  pos('  ',  FMListBoxI PR1.Items[ x]) + 2, l ength(FMLi stBoxIPR1. Items[x])) ;
  17559           //  Insert in dividual m erge form  names here
  17560           FM ListBoxIPR 1.ItemInde x := x;
  17561           FM GetsIPRFil e3.IENS :=  FMListBox IPR1.GetSe lectedReco rd.IEN;
  17562           FM GetsIPRFil e3.GetAndF ill;
  17563           Fo r xx := 0  To xFMTemp latesUtili zed.Lines. Count - 1  Do
  17564           Be gin
  17565              Try
  17566                FMListBo xIPR1.Item s.Insert(x , '!' + Pi ece(xFMTem platesUtil ized.Lines [xx], '^',  2));
  17567              Except;
  17568                FMListBo xIPR1.Item s.Add('!'  + Piece(xF MTemplates Utilized.L ines[xx],  '^', 2));
  17569              End;
  17570           En d;
  17571         End;
  17572         //Sh owmessageC APRI('*'+F MListBoxIP R1.Items[x ]);
  17573       End;
  17574     End;
  17575  
  17576     FormatIP RList1;
  17577     ListBoxI PR1.Items. Clear;
  17578     For x :=  FMListBox IPR1.Items .Count - 1  Downto 0  Do
  17579     Begin
  17580       ListBo xIPR1.Item s.Add(FMLi stBoxIPR1. Items[x]);
  17581     End;
  17582  
  17583     ListBoxI PR1.ItemIn dex := Lis tPoint;
  17584     ListBoxI PR1Click(A pplication );
  17585     ListBoxI PR1.Repain t;
  17586     RestoreM enuOptions ;
  17587   End;
  17588  
  17589   Procedure  TfrmMain.B itBtnNewFo rmClick(Se nder: TObj ect);
  17590   Var
  17591     x, y: In teger;
  17592     nowdt: S tring;
  17593     sdate, e date, show user: Stri ng;
  17594     includef lag: boole an;
  17595     prefix:  String;
  17596     objectco unt: integ er;
  17597   Begin
  17598  
  17599     If Not I sRPCBroker Connected( ) Then Exi t;
  17600  
  17601     StatusBa rLoadPt.Ca ption := ' ';
  17602     StatusBa rLoadPt.Up date;
  17603  
  17604     If ANURe moteProced ureCallInP rogress Th en
  17605       exit;
  17606     If Sende r <> PNCSF orm Then
  17607       If IsP NCSOpen()  Then Exit;
  17608     If ANURe moteProced ureCallInP rogress =  True Then
  17609       exit;
  17610     RPCBroke r1.RemoteP rocedure : = 'ORWU DT ';
  17611     RPCBroke r1.Param[1 ].Value :=  'NOW';
  17612     RPCBroke r1.Param[1 ].PType :=  literal;
  17613     frmMain. RPCBrokerC all;
  17614     Try
  17615       RPCBro ker1.Call;
  17616     Except
  17617       On EBr okerError  Do
  17618       Begin
  17619         ANUR emoteProce dureCallIn Progress : = False;
  17620         Anim ateLogo(Fa lse);
  17621         Stat usBarLoadP t.Caption  := 'RPC OR WU DT coul d not be a ccessed!';
  17622         Stat usBarLoadP t.Repaint;
  17623         Appl ication.Pr ocessmessa ges;
  17624         Show MessageCAP RI('ORWU D T could no t be acces sed!');
  17625       End;
  17626     End;
  17627     nowdt :=  Piece(RPC Broker1.Re sults[0],  '.', 1);
  17628  
  17629     If Sende r <> PNCSF orm Then
  17630       PNCSFo rm := tPNC SForm.Crea te(applica tion);
  17631  
  17632     WaitForm .Visible : = True;
  17633     WaitForm .BringToFr ont;
  17634     WaitForm .Label1.Ca ption := ' Loading te mplate lis t...';
  17635     WaitForm .Label1.Re paint;
  17636     WaitForm .Repaint;
  17637  
  17638     If Sende r <> PNCSF orm Then
  17639       FormRe viewerUtil ity := TFo rmReviewer Utility.Cr eate(PNCSF orm);
  17640  
  17641     frmBrows eTemplates  := TfrmBr owseTempla tes.Create (frmMain);
  17642     //frmBro wseTemplat es.FMListb oxTemplate s.GetList;
  17643  
  17644     RPCBroke r1.RemoteP rocedure : = 'DVBAB T EMPLATE LI ST';
  17645     frmMain. RPCBrokerC all;
  17646     Try
  17647       RPCBro ker1.Call;
  17648     Except
  17649       On EBr okerError  Do
  17650       Begin
  17651         ANUR emoteProce dureCallIn Progress : = False;
  17652         Anim ateLogo(Fa lse);
  17653         Stat usBarLoadP t.Caption  := 'RPC DV BAB TEMPLA TE LIST co uld not be  accessed! ';
  17654         Stat usBarLoadP t.Repaint;
  17655         Appl ication.Pr ocessmessa ges;
  17656         Show MessageCAP RI('DVBAB  TEMPLATE L IST could  not be acc essed!');
  17657       End;
  17658     End;
  17659     frmBrows eTemplates .FMListbox Templates. Items.Clea r;
  17660     QuickCop y(RPCBroke r1.Results , frmBrows eTemplates .FMListbox Templates. Items);
  17661     QuickCop y(RPCBroke r1.Results , frmBrows eTemplates .FMListbox AllTemplat es.Items);
  17662  
  17663     tempAuth orIEN := A uthorIEN;
  17664     (*
  17665       frmBro wseTemplat es.Listbox Templates. Items.Clea r;
  17666       If frm BrowseTemp lates.FMLi stboxTempl ates.Items .Count>0 t hen
  17667         for  x:=0 to fr mBrowseTem plates.FML istboxTemp lates.Item s.Count-1  do
  17668           fr mBrowseTem plates.Lis tboxTempla tes.Items. Add(frmBro wseTemplat es.FMListb oxTemplate s.Items[x] );
  17669     *)
  17670     If frmBr owseTempla tes.FMList boxTemplat es.Items.C ount > 0 T hen
  17671       For x  := frmBrow seTemplate s.FMListbo xTemplates .Items.Cou nt - 1 Dow nto 0 Do
  17672       Begin
  17673         frmB rowseTempl ates.FMLis tboxTempla tes.ItemIn dex := x;
  17674         incl udeflag :=  false;
  17675         sdat e := Piece (frmBrowse Templates. FMListboxT emplates.I tems[x], ' ^', 2);
  17676         edat e := Piece (frmBrowse Templates. FMListboxT emplates.I tems[x], ' ^', 3);
  17677         show user := Pi ece(frmBro wseTemplat es.FMListb oxTemplate s.Items[x] , '^', 4);
  17678         obje ctcount :=  StrToIntD ef(Piece(f rmBrowseTe mplates.FM ListboxTem plates.Ite ms[x], '^' , 5), 0);
  17679  
  17680         //Sh owMessageC APRI(sdate +'*'+edate +'*'+showu ser);
  17681         pref ix := '';
  17682         If ( ShowUser =  '1') Or ( Showuser =  '') Then
  17683         Begi n
  17684           If  sdate = ' ' Then
  17685              includefla g := false ;
  17686           If  sdate <>  '' Then
  17687              If (sdate  <= nowdt)  And (edate  = '') The n
  17688                IncludeF lag := tru e
  17689              Else
  17690                If edate  <> '' The n
  17691                  If (sd ate <= now dt) And (E date > now dt) Then
  17692                    incl udeflag :=  true;
  17693           If  (Pos('@',  userfilem ancode) >  0) And (in cludeflag  <> true) T hen
  17694           Be gin
  17695              prefix :=  'ZZ_INACTI VE: ';
  17696              includefla g := true;
  17697           En d;
  17698         End;
  17699         If I ncludeFlag  = true Th en
  17700         Begi n
  17701           // frmBrowseT emplates.F MGetsTempl ateInfo.IE NS:=frmBro wseTemplat es.FMListb oxTemplate s.GetSelec tedRecord. IEN;
  17702           // frmBrowseT emplates.F MGetsTempl ateInfo.Ge tData;
  17703           fr mBrowseTem plates.Lis tboxTempla tes.Items. Add(prefix  + Piece(P iece(frmBr owseTempla tes.FMList boxTemplat es.Items[x ], '^', 1) , '~', 1)  + '^' +
  17704              Piece(frmB rowseTempl ates.FMLis tboxTempla tes.Items[ x], '^', 6 ) + '^' +  inttostr(o bjectcount ));
  17705         End;
  17706       End;
  17707  
  17708     WaitForm .Visible : = False;
  17709     If Sende r <> PNCSF orm Then
  17710       If frm BrowseTemp lates.Show Modal = mr Cancel The n
  17711       Begin
  17712         frmB rowseTempl ates.Relea se;
  17713         frmB rowseTempl ates := Ni l;
  17714         //       try
  17715         //         temp FormObject List.Clear ;
  17716         //       except
  17717         //       end;
  17718         //       try
  17719         //         temp MergeScrip ts.Clear;
  17720         //       except
  17721         //       end;
  17722  
  17723         PNCS form.Relea se;
  17724         If F ormReviewe rUtility < > Nil Then
  17725           Fo rmReviewer Utility.re lease;
  17726         Form ReviewerUt ility := N il;
  17727         PNCS Form := Ni l;
  17728         exit ;
  17729       End;
  17730  
  17731     If Sende r = PNCSFo rm Then
  17732       exit;
  17733  
  17734     x := 0;
  17735     If frmBr owseTempla tes.FMList BoxTemplat es.ItemInd ex <> -1 T hen
  17736     Begin
  17737       PNCSFo rm.xEditMo de.Text :=  'NEW';
  17738       PNCSFo rm.xEditFo rmNum.text  := inttos tr(whichme rgeform);
  17739       For y  := 0 To fr mBrowseTem plates.Ric hEditTempl atesUtiliz ed.Lines.C ount - 1 D o
  17740         PNCS Form.xFMTe mplatesUti lized.Line s.Add(frmB rowseTempl ates.RichE ditTemplat esUtilized .Lines[y]) ;
  17741       PNCSFo rm.xDateTi meOfNote.T ext := 'NE W FORM';
  17742       PNCSFo rm.xPatien tIENS.Capt ion := Pat ientIEN;
  17743       PNCSFo rm.xFMPati entName.Ca ption := P atientName ;
  17744       PNCSFo rm.xFMSSN. Caption :=  PatientSS N;
  17745       PNCSFo rm.xAuthor Button.Cap tion := Au thorName;
  17746  
  17747       screen .cursor :=  crHourgla ss;
  17748  
  17749       If Fou ndMergeFla g > 1 Then
  17750         pncs form.capti on := 'MER GED FORM'
  17751       Else
  17752         pncs form.capti on := frmB rowseTempl ates.Selec tedTemplat es[0];
  17753  
  17754       PNCSFo rm.ShowExa m;
  17755       QuickC opy(PNCSFo rm.localEx am.Code.Sc ript, PNCS Form.xMemo Code);
  17756       PNCSFo rm.SetupFo rm(Sender) ;
  17757       If frm BrowseTemp lates.rich EditPScrip t.Lines.Co unt > 0 Th en
  17758       Begin
  17759         Quic kcopy(frmB rowseTempl ates.richE ditPScript , PNCSForm .xMemoCode );
  17760         PNCS Form.zzzzE ditScriptS tyle.text  := 'PASCAL  SCRIPT';
  17761       End;
  17762       PNCSFo rm.xTimerG o.Enabled  := True;
  17763       screen .cursor :=  crdefault ;
  17764     End;
  17765     If x > 2 0 Then
  17766     Begin
  17767       ShowMe ssageCAPRI ('You can  have a max imum of 20  templates  open at a  time.');
  17768       exit;
  17769     End;
  17770   End;
  17771  
  17772   Procedure  TfrmMain.B itBtnUnsig nedFormsCl ick(Sender : TObject) ;
  17773   Begin
  17774     If Not I sRPCBroker Connected( ) Then Exi t;
  17775  
  17776     StatusBa rLoadPt.Ca ption := ' ';
  17777     StatusBa rLoadPt.Up date;
  17778  
  17779     If PNCSF orm <> Nil  Then
  17780     Begin
  17781       ShowMe ssageCAPRI ('You have  an open t emplate.   Please clo se it befo re trying  to perform  this func tion.');
  17782       exit;
  17783     End;
  17784     If Not A ssigned(Un signedView ) Then
  17785       Unsign edView :=  TUnsignedV iew.Create (frmMain);
  17786     Unsigned View.Butto n5Click(Ap plication) ;
  17787     Unsigned View.ShowM odal;
  17788     Unsigned View.Relea se;
  17789     Unsigned View := Ni l;
  17790     // Only  refresh if  a patient  has been  selected.
  17791     If Panel 1.Caption  <> '' Then
  17792       Button IPRRefresh Click(Appl ication);
  17793   End;
  17794  
  17795   Procedure  TfrmMain.F MListBoxIP R1DrawItem (Control:  TWinContro l;
  17796     Index: I nteger; Re ct: TRect;  State: TO wnerDrawSt ate);
  17797   Var
  17798     TempText : String;
  17799   Begin
  17800     Inherite d;
  17801     If ANULo calMods =  False Then
  17802       exit;
  17803  
  17804     If Panel 1.Visible  = False Th en
  17805       exit;
  17806     With (Co ntrol As T ListBox).C anvas Do                                               { draw on  control ca nvas, not  on the for m }
  17807     Begin
  17808       Font.C olor := cl WindowText ;                                                      {Set to de fault colo r}
  17809       TempTe xt := (Con trol As TL istBox).It ems[Index] ;
  17810       If Cop y((Control  As TListB ox).Items[ Index], 1,  1) = '*'  Then
  17811       Begin
  17812         Font .Color :=  clRed;                                                            {Change co lor to sho w unsigned }
  17813         Temp Text := Co py((Contro l As TList Box).Items [Index], 2 , Length(( Control As  TListBox) .Items[Ind ex]) - 1)
  17814       End;
  17815       If Cop y((Control  As TListB ox).Items[ Index], 1,  1) = '!'  Then
  17816       Begin
  17817         Font .Color :=  clOlive;                                                          {Change co lor to sho w unsigned }
  17818         Temp Text := Co py((Contro l As TList Box).Items [Index], 2 , Length(( Control As  TListBox) .Items[Ind ex]) - 1)
  17819       End;
  17820       Brush. Color := c lWindow;
  17821       FillRe ct(Rect);                                                                    { clear th e rectangl e }
  17822       TextOu t(Rect.Lef t, Rect.To p, TempTex t);                                         { display  the text }
  17823     End;
  17824   End;
  17825  
  17826   Procedure  TfrmMain.L istBoxIPR1 Click(Send er: TObjec t);
  17827   Var
  17828     x: integ er;
  17829   Begin
  17830     If ListB oxIPR1.Ite mIndex < 0  Then
  17831       exit;
  17832     If ANURe moteProced ureCallInP rogress =  True Then
  17833       exit;
  17834     If ListB oxIPR1.Ite mIndex > - 1 Then
  17835     Begin
  17836       Button IPRCopy.En abled := T rue;
  17837       Button IPRDisplay .Enabled : = True;
  17838       Button IPRDelete. Enabled :=  True;
  17839       Button IPRCopy.En abled := T rue;
  17840     End;
  17841     // Deal  with a sub -form comp onent bein g clicked
  17842     If Copy( ListBoxIPR 1.Items[Li stBoxIPR1. ItemIndex] , 1, 1) =  '!' Then
  17843     Begin
  17844       x := L istBoxIPR1 .ItemIndex ;
  17845       Repeat
  17846         dec( x);
  17847       Until  Copy(ListB oxIPR1.Ite ms[x], 1,  1) <> '!';
  17848       ListBo xIPR1.Item Index := x ;
  17849     End;
  17850   End;
  17851  
  17852   Procedure  TfrmMain.L istBoxIPR1 DblClick(S ender: TOb ject);
  17853   Begin
  17854     If ANURe moteProced ureCallInP rogress =  True Then
  17855       exit;
  17856     ListBoxI PR1Click(A pplication );
  17857     FMListbo xIPR1.Item Index := F MListBoxIP R1.Items.C ount - 1 -  ListBoxIP R1.ItemInd ex;
  17858     ButtonIP RDisplayCl ick(Applic ation);
  17859   End;
  17860  
  17861   Procedure  TfrmMain.L istBoxIPR1 DrawItem(C ontrol: TW inControl;
  17862     Index: I nteger; Re ct: TRect;  State: TO wnerDrawSt ate);
  17863   Var
  17864     TempText : String;
  17865     x: integ er;
  17866     lastinde x: integer ;
  17867     itemcoun t: integer ;
  17868     mergemod e: boolean ;
  17869     RectHeig ht: intege r;
  17870     tempStri ng: String ;
  17871     tempx: i nteger;
  17872     BitmapFl agRect: tR ect;
  17873  
  17874   Begin
  17875     Inherite d;
  17876     lastinde x := -1;
  17877     RectHeig ht := 0;
  17878     With (Co ntrol As T ListBox).C anvas Do                                               { draw on  control ca nvas, not  on the for m }
  17879     Begin
  17880       Font.C olor := cl WindowText ;                                                      {Set to de fault colo r}
  17881       Font.S tyle := [] ;
  17882       Brush. Color := c lWindow;
  17883       TempTe xt := (Con trol As TL istBox).It ems[Index] ;
  17884       TempSt ring := Te mpText;
  17885       MergeM ode := Fal se;
  17886       If Cop y(TempText , 1, 1) =  '*' Then
  17887       Begin
  17888         Font .Color :=  clRed;                                                            {Change co lor to sho w unsigned }
  17889         Temp Text := Co py((Contro l As TList Box).Items [Index], 2 , Length(( Control As  TListBox) .Items[Ind ex]) - 1)
  17890       End;
  17891       If Cop y(TempText , 1, 1) =  '!' Then
  17892       Begin
  17893         Font .Color :=  clOlive;                                                          {Change co lor to sho w unsigned }
  17894         //br ush.Color: =$00CFFCFE ;
  17895         Font .Style :=  [fsItalic] ;
  17896         Temp Text := '   ' + Piece (Temptext,  '!', 2);                                   // Get rid  of the '! ' at the b eginning a nd indent;
  17897       End;
  17898       // Dea l with fla gs
  17899  
  17900       If (Te mpString[1 ] <> '!')  And (TempT ext[1] <>  ' ') Then
  17901         If L ength(temp Text) > 36  Then
  17902         Begi n
  17903           If  (TempText [35] = 'Y' ) Or ((Tem pText[35]  = ' ') And  (copy(Tem ptext, len gth(Tempte xt) - 8, 8 ) <> 'COMP LETE')) Th en
  17904              TempText[3 5] := #128
  17905           El se
  17906              TempText[3 5] := ' ';                                                        // Flag Ne w
  17907           If  TempText[ 36] = 'Y'  Then
  17908              TempText[3 6] := #129
  17909           El se
  17910              TempText[3 6] := ' ';                                                        // Flag Gr een Flag
  17911           If  TempText[ 37] = 'Y'  Then
  17912              TempText[3 7] := #130
  17913           El se
  17914              TempText[3 7] := ' ';                                                        // Flag Ex clamation
  17915         End;
  17916       //Show messageCAP RI('*'+Cop y(TempStri ng,28,Leng th('MERGED  FORM  ')) +'*');
  17917       If Cop y(TempStri ng, 28, Le ngth('MERG ED FORM  ' )) = 'MERG ED FORM  '  Then
  17918       Begin
  17919         last index := i ndex;
  17920         Repe at
  17921           in c(lastinde x)
  17922         Unti l (lastind ex = (Cont rol As TLi stBox).Ite ms.Count -  1) Or (Co py((Contro l As TList Box).Items [lastindex ], 1, 1) < > '!');
  17923         // C heck last  item, in c ase this i s the end  of the lis t
  17924         If C opy((Contr ol As TLis tBox).Item s[lastinde x], 1, 1)  <> '!' The n
  17925           de c(lastinde x);
  17926         Item Count := L astindex -  Index + 1 ;
  17927         Rect Height :=  Rect.botto m - Rect.T op;
  17928         Rect .Bottom :=  Rect.Top  + (RectHei ght * Item Count);                          // Need th is for the  highlight ing
  17929         Rect .BottomRig ht.y := Re ct.Top + ( RectHeight  * ItemCou nt);
  17930         Merg eMode := T rue;
  17931       End;
  17932       If sta te = [odSe lected, od Focused] T hen
  17933         Brus h.Color :=  clBtnFace ;
  17934       FillRe ct(rect);                                                                    { clear th e rectangl e }
  17935       TextOu t(Rect.Lef t, Rect.To p, TempTex t);                                         { display  the text }
  17936       // Ins ert flag i mages if s pecial cod es are fou nd
  17937       If len gth(tempte xt) > 0 Th en
  17938         For  x := 1 To  length(tem ptext) Do
  17939         Begi n
  17940           If  temptext[ x] = #128  Then
  17941           Be gin
  17942              tempx := T extWidth(' Z') * (x -  1);
  17943              //TextOut( Rect.Left+ tempx,Rect .Top,'>');
  17944              BitmapFlag Rect.Left  := Rect.Le ft + tempx ;
  17945              BitmapFlag Rect.Top : = Rect.Top ;
  17946              BitmapFlag Rect.Right  := Bitmap FlagRect.L eft + Text Width('Z') ;
  17947              BitmapFlag Rect.Botto m := Bitma pFlagRect. Top + Text Height('Z' );
  17948              StretchDra w(BitmapFl agRect, Im ageFlagNew .Picture.G raphic);
  17949              //TextOut( BitmapFlag Rect.Left,  BitmapFla gRect.Top,  '#');
  17950           En d;
  17951           If  temptext[ x] = #129  Then
  17952           Be gin
  17953              tempx := T extWidth(' Z') * (x -  1);
  17954              //TextOut( Rect.Left+ tempx,Rect .Top,'>');
  17955              BitmapFlag Rect.Left  := Rect.Le ft + tempx ;
  17956              BitmapFlag Rect.Top : = Rect.Top ;
  17957              BitmapFlag Rect.Right  := Bitmap FlagRect.L eft + Text Width('Z') ;
  17958              BitmapFlag Rect.Botto m := Bitma pFlagRect. Top + Text Height('Z' );
  17959              StretchDra w(BitmapFl agRect, Im ageFlagFla g.Picture. Graphic);
  17960           En d;
  17961           If  temptext[ x] = #130  Then
  17962           Be gin
  17963              tempx := T extWidth(' Z') * (x -  1);
  17964              //TextOut( Rect.Left+ tempx,Rect .Top,'>');
  17965              BitmapFlag Rect.Left  := Rect.Le ft + tempx ;
  17966              BitmapFlag Rect.Top : = Rect.Top ;
  17967              BitmapFlag Rect.Right  := Bitmap FlagRect.L eft + Text Width('Z') ;
  17968              BitmapFlag Rect.Botto m := Bitma pFlagRect. Top + Text Height('Z' );
  17969              StretchDra w(BitmapFl agRect, Im ageFlagExc lamation.P icture.Gra phic);
  17970           En d;
  17971         End;
  17972  
  17973       // Dra w the indi vidual ite ms under t he merge f orm
  17974       If Mer geMode = T rue Then
  17975       Begin
  17976         Pen. Color := c lYellow;
  17977         Fram eRect(Rect );
  17978         For  x := index  + 1 To la stindex Do
  17979         Begi n
  17980           Fo nt.Color : = clOlive;                                                        {Change co lor to sho w unsigned }
  17981           Fo nt.Style : = [fsItali c];
  17982           te mptext :=  '  ' + Pie ce((Contro l As TList Box).Items [x], '!',  2);
  17983           Re ct.Top :=  Rect.Top +  RectHeigh t;
  17984           Te xtOut(Rect .Left, Rec t.Top, Tem pText);                                     { display  the text }
  17985         End;
  17986       End;
  17987     End;
  17988   End;
  17989  
  17990   Procedure  TfrmMain.F ormatIPRLi st1;
  17991   Var
  17992     x: Integ er;
  17993     Line: St ring;
  17994     patientN ame, examN ame, exami nerName, s tatus, F1,  F2, F3: S tring;
  17995     examName Len, exami nerNameLen , statusLe n, F1Len,  F2Len: int eger;
  17996   Begin
  17997     For x :=  1 To 100  Do
  17998       applic ation.proc essmessage s;                                                     // to solv e xmemocod e has no p arent wind ow issue;
  17999  
  18000     FMListBo xIPR1.Visi ble := Fal se;
  18001  
  18002     If FMLis tBoxIPR1.I tems.Count  > 0 Then
  18003     Begin
  18004       For x  := 0 To FM ListBoxIPR 1.Items.Co unt - 1 Do
  18005       Begin
  18006  
  18007         Line  := FMList BoxIPR1.It ems[x];
  18008         pati entName :=  Copy(Line , 1, pos('   ', Line) );
  18009         Line  := Copy(L ine, lengt h(patientn ame) + 1,  Length(Lin e));
  18010  
  18011         (*
  18012         If C opy(line,1 ,1)<>'!' t hen begin
  18013           //  Get 1st l etter last  name + la st 4 digit s of SSN
  18014           FM ListBoxIPR 1.ItemInde x:=x;
  18015           FM GetsIPRFil e.IENS:=FM ListBoxIPR 1.GetSelec tedRecord. IEN;
  18016           FM GetsIPRFil e.GetData;
  18017           FM GetsPatien tFile.IENS :=FMGetsIP RFile.GetF ield('.01' ).FMDBInte rnal;
  18018           FM GetsPatien tFile.GetD ata;
  18019           pa tientName: =patientNa me+'('+FMG etsPatient File.GetFi eld('.0905 ').FMDBExt ernal+')';
  18020         end;
  18021         *)
  18022  
  18023         Line  := TrimLe ft(Line);
  18024  
  18025         // A ctually, t his is dat e
  18026         exam Name := Co py(Line, 1 , pos('  ' , Line));
  18027         exam NameLen :=  Length(ex amName);
  18028         Line  := Copy(L ine, examN ameLen + 1 , Length(L ine));
  18029         Line  := TrimLe ft(Line);
  18030         If e xamName =  'JAN 01, 1 980 ' Then
  18031           ex amName :=  '             ';
  18032  
  18033         exam inerName : = Copy(Lin e, 1, pos( '  ', Line ));
  18034         exam inerNameLe n := Lengt h(examiner Name);
  18035         Line  := Copy(L ine, exami nerNameLen  + 1, Leng th(Line));
  18036         Line  := TrimLe ft(Line);
  18037  
  18038         Stat us := Copy (Line, 1,  pos('  ',  Line));
  18039         Stat usLen := L ength(Stat us);
  18040         Line  := Copy(L ine, Statu sLen + 1,  Length(Lin e));
  18041         Line  := TrimLe ft(Line);
  18042  
  18043         F1 : = Copy(Lin e, 1, pos( '  ', Line ));
  18044         F1Le n := Lengt h(F1);
  18045         Line  := Copy(L ine, F1Len  + 1, Leng th(Line));
  18046         Line  := TrimLe ft(Line);
  18047         F1 : = Trim(F1) ;
  18048         If F 1 = '' The n
  18049           F1  := ' ';
  18050  
  18051         F2 : = Copy(Lin e, 1, pos( '  ', Line ));
  18052         F2Le n := Lengt h(F2);
  18053         Line  := Copy(L ine, F2Len  + 1, Leng th(Line));
  18054         Line  := TrimLe ft(Line);
  18055         F2 : = Trim(F2) ;
  18056         If F 2 = '' The n
  18057           F2  := ' ';
  18058  
  18059         F3 : = trim(lin e);
  18060         If F 3 = '' The n
  18061           F3  := ' ';
  18062  
  18063         // ! =Individua l item in  a merged e xam
  18064         If C opy(Line,  1, 1) <> ' !' Then
  18065  
  18066           // %-33s %-4s %-19s  %-1 9s  %-6s
  18067           If  Length(Pa tientName)  > 32 Then
  18068              PatientNam e := Copy( PatientNam e, 1, 32);
  18069         If L ength(Exam Name) > 19  Then
  18070           Ex amName :=  Copy(ExamN ame, 1, 19 );
  18071         If L ength(Exam inerName)  > 19 Then
  18072           Ex aminerName  := Copy(E xaminerNam e, 1, 19);
  18073         If C opy(FMList BoxIPR1.It ems[x], 1,  1) = '!'  Then
  18074         Begi n
  18075           FM ListBoxIPR 1.Items[x]  := FMList BoxIPR1.It ems[x];
  18076         End
  18077         Else
  18078         Begi n
  18079           //  Insert 2  spaces
  18080           If  F1 = '' T hen
  18081              F1 := 'Y';
  18082           If  F2 = '' T hen
  18083              F2 := ' ';
  18084           If  F3 = '' T hen
  18085              F3 := ' ';
  18086           FM ListBoxIPR 1.Items[x]  := Format ('%-33s %- 4s%-19s  % -19s  %-6s ', [Patien tName, F1  + F2 + F3,  examname,  examinern ame, statu s]);
  18087           If  examName  = '             ' The n
  18088              FMListBoxI PR1.Items[ x] := '*'  + FMListBo xIPR1.Item s[x];
  18089         End;
  18090       End;
  18091  
  18092     End;
  18093     //self.B orderIcons :=[biSyste mMenu];
  18094     FMListBo xIPR1.Enab led := Tru e;
  18095     FMListBo xIPR1.Item Index := - 1;
  18096     If FMLis tBoxIPR1.I tems.Count  > 0 Then
  18097     Begin
  18098       FMList BoxIPR1.It emIndex :=  0;
  18099       FMList BoxIPR1.It emIndex :=  -1;
  18100     End;
  18101  
  18102     If FMLis tBoxIPR1.I tems.Count  > 0 Then
  18103     Begin
  18104       // Bri ngs list t o the top
  18105       FMList BoxIPR1.It emIndex :=  0;
  18106       FMList BoxIPR1.It emIndex :=  -1;
  18107     End;
  18108   End;
  18109  
  18110   Procedure  TfrmMain.S plitter7Ca nResize(Se nder: TObj ect;
  18111     Var NewS ize: Integ er; Var Ac cept: Bool ean);
  18112   Begin
  18113     Accept : = False;
  18114   End;
  18115  
  18116   Procedure  TfrmMain.F MMemoFormD efinitionC hange(Send er: TObjec t);
  18117   Var
  18118     x: integ er;
  18119     tempfmme mo: triche dit;
  18120     foundfla g: boolean ;
  18121   Begin
  18122     tempfmme mo := send er As tric hedit;
  18123     //ShowMe ssageCAPRI (sender.Cl assName);
  18124       // mer ge lines s plit by ~
  18125     Repeat
  18126       Begin
  18127         foun dflag := f alse;
  18128         If t empFMMemo. Lines.Coun t > 0 Then
  18129           Fo r x := tem pFMMemo.Li nes.Count  - 1 Downto  0 Do
  18130              If Copy(te mpFMMemo.L ines[x], 1 , 1) = '~'  Then
  18131              Begin
  18132                tempFMMe mo.Lines[x  - 1] := t empFMMemo. Lines[x -  1] + Copy( tempFMMemo .Lines[x],  2, length (tempFMMem o.lines[x] ));
  18133                tempFMMe mo.Lines.D elete(x);
  18134              End;
  18135         If t empFMMemo. Lines.Coun t > 0 Then
  18136           Fo r x := tem pFMMemo.Li nes.Count  - 1 Downto  0 Do
  18137              If Copy(te mpFMMemo.L ines[x], 1 , 1) = '~'  Then
  18138                foundfla g := true;
  18139     End Unti l FoundFla g = False;
  18140   End;
  18141  
  18142   Procedure  TfrmMain.F ormPaint(S ender: TOb ject);
  18143   Begin
  18144     FormResi ze(Applica tion);
  18145   End;
  18146  
  18147   Procedure  TfrmMain.F ormCloseQu ery(Sender : TObject;  Var CanCl ose: Boole an);
  18148   Begin
  18149     CanClose  := False;
  18150  
  18151     If ANURe moteProced ureCallInP rogress =  True Then
  18152     Begin
  18153       messag ebeep(0);
  18154       exit;
  18155     End;
  18156     //check  if a templ ate is cur rently ope n - kcl 1/ 3/2008
  18157     If Assig ned(PNCSFo rm) Then
  18158     Begin
  18159       ShowMe ssage('Ple ase close  the open T emplate.') ;
  18160       //Code CR367 - rp m 8/21/12  - prevent  potential  AVs
  18161       try
  18162         //re -check bec ause state  may have  changed du ring ShowM essage
  18163         if A ssigned(PN CSForm) th en
  18164           PN CSForm.Sho w;
  18165       except
  18166         {Do  nothing as  form may  be in the  process of  closing o r
  18167          clo sed before  dialog ac knowledged }
  18168       end;
  18169       Exit;
  18170     End;
  18171     frmMain. Tag := 126 13;
  18172     RPCBroke r1.Connect ed := Fals e;
  18173     CanClose  := True;
  18174   End;
  18175  
  18176   // DoD tab  function  - DoD tab  is no long er display ed so this  function  will 
  18177   // never e xecute.  P atch 193 J RL 7/21/16
  18178   Procedure  TfrmMain.H eaderContr olDODConsu ltsSection Resize(
  18179     HeaderCo ntrol: THe aderContro l; Section : THeaderS ection);
  18180   Begin
  18181     VAWrapGr idDOD.ColC ount := 6;
  18182     VAWrapGr idDOD.ColW idths[0] : = HeaderCo ntrolDODCo nsults.Sec tions[0].W idth - 2;
  18183     VAWrapGr idDOD.ColW idths[1] : = HeaderCo ntrolDODCo nsults.Sec tions[1].W idth - 2;
  18184     VAWrapGr idDOD.ColW idths[2] : = HeaderCo ntrolDODCo nsults.Sec tions[2].W idth - 1;
  18185     VAWrapGr idDOD.ColW idths[3] : = HeaderCo ntrolDODCo nsults.Sec tions[3].W idth - 1;
  18186     VAWrapGr idDOD.ColW idths[4] : = HeaderCo ntrolDODCo nsults.Sec tions[4].W idth - 1;
  18187     VAWrapGr idDOD.ColW idths[5] : = HeaderCo ntrolDODCo nsults.Sec tions[5].W idth - 1;
  18188   End;
  18189  
  18190   // DoD tab  function  - DoD tab  is no long er display ed so this  function  will 
  18191   // never e xecute.  P atch 193 J RL 7/21/16
  18192   Procedure  TfrmMain.H eaderContr olDoDAller giesSectio nResize(
  18193     HeaderCo ntrol: THe aderContro l; Section : THeaderS ection);
  18194   Begin
  18195     VAWrapGr idDOD.ColC ount := 3;
  18196     VAWrapGr idDOD.ColW idths[0] : = HeaderCo ntrolDODAl lergies.Se ctions[0]. Width - 2;
  18197     VAWrapGr idDOD.ColW idths[1] : = HeaderCo ntrolDODAl lergies.Se ctions[1]. Width - 2;
  18198     VAWrapGr idDOD.ColW idths[2] : = HeaderCo ntrolDODAl lergies.Se ctions[2]. Width - 1;
  18199   End;
  18200  
  18201   Procedure  TfrmMain.C ontextorCo ntrolCance led(Sender : TObject) ;
  18202   Begin
  18203     If RPCBr oker1.Conn ected = Fa lse Then
  18204       exit;
  18205     // We do n't care a bout cance llations r ight now
  18206   End;
  18207  
  18208   Procedure  TfrmMain.C ontextorCo ntrolCommi tted(Sende r: TObject );
  18209   Begin
  18210     // Only  force chan ge if CAPR I has fini shed start ing up
  18211     If AppSt arted = Fa lse Then
  18212       exit;
  18213  
  18214     // Need  to check a ll open di alogs, can cel them o ut, and ma ke the cha nge anyway
  18215     //If Con textorChan geMessage= '' then be gin
  18216     If CCOWF orceCloseO fAllDialog s = false  Then
  18217     Begin
  18218       ANURem oteProcedu reCallInPr ogress :=  False;                                      // Allow u ser to cli ck the "OK " button
  18219       Showme ssageCAPRI ('WARNING:   The clin ical patie nt context  has chang ed but CAP RI was una ble to com ply.' + ch ar(13) +
  18220         'CAP RI has dro pped out o f the clin ical conte xt.  You m ay re-join  by clicki ng the CCO W' + char( 13) + 'but ton on the  main CAPR I form.');
  18221       CCOWSu spended :=  True;
  18222       BitBtn CCOWLinkBr oken.Visib le := True ;
  18223       BitBtn CCOWLink.V isible :=  False;
  18224       BitBtn CCOWLinkCh anging.Vis ible := Fa lse;
  18225       Contex torControl .Suspend;
  18226       exit;
  18227     End;
  18228     //end;
  18229     // ----- ---------- --------
  18230  
  18231     // Check  for user  subject nu ll
  18232     // If nu ll, need t o force sh utdown
  18233     (*
  18234     If RPCBr oker1.WasU serDefined =True then
  18235       If RPC Broker1.Is UserCleare d then beg in
  18236         frmM ain.Quit2C lick(Appli cation);
  18237       end;
  18238     *)
  18239     CCOWInit ialized :=  False;
  18240     BitBtnCC OWLinkBrok en.Visible  := False;
  18241     BitBtnCC OWLink.Vis ible := Fa lse;
  18242     BitBtnCC OWLinkChan ging.Visib le := True ;
  18243     Shutdown CAPRIModal Dialogs :=  True;                                                 // Just to  be sure
  18244     actFileS electPatie ntExecute( ContextorC ontrol)
  18245   End;
  18246  
  18247   Procedure  TfrmMain.C ontextorCo ntrolPendi ng(Sender:  TObject;
  18248     Const aC ontextItem Collection : IDispatc h);
  18249   Begin
  18250     //ShowMe ssageCAPRI ('Contexto r Pending' );
  18251     // Need  to check i f logged i n with RPC  broker ye t
  18252     // Check  if it's o k to chang e context
  18253  
  18254     If RPCBr oker1.Conn ected = Fa lse Then
  18255       exit;
  18256  
  18257     // Check  for dialo gs on scre en and sen d message  to close t hem
  18258  
  18259     // This  forces all  modal dia logs to sh ut down
  18260  
  18261     If Conte xtorChange Message <>  '' Then
  18262     Begin
  18263       Contex torControl .SetSurvey Response(C ontextorCh angeMessag e);
  18264     End;
  18265  
  18266   End;
  18267  
  18268   Procedure  TfrmMain.B itBtnCCOWL inkClick(S ender: TOb ject);
  18269   Begin
  18270     If Appli cation.Mes sageBox('A re you sur e you want  to suspen d the clin ical link? ', 'CAPRI  CCOW Link' , 4) = 6 T hen
  18271     Begin
  18272       CCOWSu spended :=  True;
  18273       BitBtn CCOWLinkBr oken.Visib le := True ;
  18274       BitBtn CCOWLink.V isible :=  False;
  18275       Contex torControl .Suspend;
  18276     End;
  18277   End;
  18278  
  18279   Function T frmMain.CC OWForceClo seOfAllDia logs: bool ean;
  18280   Var
  18281     x: integ er;
  18282   Begin
  18283     Shutdown CAPRIModal Dialogs :=  True;
  18284     For x :=  1 To 1000 0 Do
  18285       applic ation.proc essmessage s;
  18286  
  18287     If CCOWB reakLink =  True Then
  18288       result  := False
  18289     Else
  18290       result  := true;
  18291  
  18292     CCOWBrea kLink := F alse;
  18293  
  18294   End;
  18295  
  18296   Procedure  TfrmMain.B itBtnCCOWL inkBrokenC lick(Sende r: TObject );
  18297   Begin
  18298     // Check  if ok to  switch to  new patien t
  18299     // Will  lose any w ork?
  18300     dvbatime rinfobox : = 0;
  18301     frmInfoB ox := Tfrm InfoBox.Cr eate(frmMa in);
  18302     frmInfoB ox.Label1. Caption :=  'Your pat ient is be ing change d to match  the clini cal contex t.';
  18303     frmInfoB ox.Show;
  18304     frmInfoB ox.BringTo Front;
  18305     frmInfoB ox.Left :=  (frmMain. Left + (fr mMain.widt h Div 2))  - (frmInfo Box.width  Div 2);
  18306     frmInfoB ox.Top :=  (frmMain.t op + (frmM ain.height  Div 2)) -  (frmInfoB ox.height  Div 2);
  18307     frmInfoB ox.BringTo Front;
  18308     frmInfoB ox.Repaint ;
  18309     frmMain. Repaint;
  18310     timerInf oBox.Inter val := 100 0;
  18311     timerInf oBox.Enabl ed := True ;
  18312  
  18313     Contexto rControl.R esume;
  18314     CCOWInit ialized :=  False;                                                           // Force r e-load of  patient
  18315     BitBtnCC OWLinkBrok en.Visible  := False;
  18316     BitBtnCC OWLink.Vis ible := Tr ue;
  18317     BitBtnCC OWLinkChan ging.Visib le := Fals e;
  18318     CCOWPati entName :=  '';
  18319     CCOWPati entIEN :=  '';
  18320     CCOWSusp ended := F alse;
  18321     actFileS electPatie nt.Execute ;
  18322   End;
  18323  
  18324   Procedure  TfrmMain.B uttonOther SitesClick (Sender: T Object);
  18325   Var
  18326     a, b: St ring;
  18327     x: integ er;
  18328  
  18329     Procedur e RemoveHD RFromList;
  18330     Var
  18331       x: int eger;
  18332     Begin
  18333       // Rem ove HDR en try, if fo und
  18334       If frm Main.Piece (frmMain.R PCBroker1. Results[0] , '^', 1)  <> '-1' Th en
  18335         For  x := frmMa in.RPCBrok er1.Result s.Count -  1 Downto 0  Do
  18336           If  frmMain.P iece(frmMa in.RPCBrok er1.Result s[x], '^',  1) = '200 HD' Then
  18337              frmMain.RP CBroker1.R esults.Del ete(x);
  18338       // If  the list i s empty, m ake sure t his is ref lected.
  18339       If frm Main.RPCBr oker1.Resu lts.Count  = 0 Then
  18340         frmM ain.RPCBro ker1.Resul ts.Add('-1 ^No Sites  Found');
  18341     End;
  18342   Begin
  18343     frmRemot eSitePick  := TfrmRem oteSitePic k.Create(f rmPatientL ist);
  18344     frmMain. AnimateLog o(True);
  18345     frmMain. StatusBarL oadPt.Capt ion := 'Ge nerating r eport.';
  18346     frmMain. StatusBarL oadPt.Repa int;
  18347     Applicat ion.Proces smessages;
  18348     frmMain. RPCBroker1 .RemotePro cedure :=  'ORWCIRN F ACLIST';
  18349     frmMain. RPCBroker1 .Param[0]. Value := f rmMain.Pie ce(Patient IEN, ',',  1);
  18350     frmMain. RPCBroker1 .Param[0]. PType := l iteral;
  18351     frmMain. RPCBrokerC all;
  18352     Try
  18353       frmMai n.RPCBroke r1.Call;
  18354     Except
  18355       On EBr okerError  Do
  18356       Begin
  18357         ANUR emoteProce dureCallIn Progress : = False;
  18358         frmM ain.Animat eLogo(Fals e);
  18359         frmM ain.Status BarLoadPt. Caption :=  'RPC ORWC IRN FACLIS T could no t be acces sed!';
  18360         frmM ain.Status BarLoadPt. Repaint;
  18361         Appl ication.Pr ocessmessa ges;
  18362         Show MessageCAP RI('ORWCIR N FACLIST  could not  be accesse d!');
  18363       End
  18364     End;
  18365     RemoveHD RFromList;
  18366     If frmMa in.Piece(f rmMain.RPC Broker1.Re sults[0],  '^', 1) =  '-1' Then
  18367     Begin
  18368       // Onl y local da ta or othe r problem
  18369       frmRem oteSitePic k.ORListBo xSites.Ite ms.Add('Si tes could  not be loa ded.');
  18370     End
  18371     Else
  18372     Begin
  18373       For x  := 0 To fr mMain.RPCB roker1.Res ults.Count  - 1 Do
  18374       Begin
  18375         a :=  Copy(frmM ain.Piece( frmMain.RP CBroker1.R esults[x],  '^', 1) +  '         ', 1, 8);
  18376         b :=  Copy(frmM ain.Piece( frmMain.RP CBroker1.R esults[x],  '^', 2) +  '                           ',  1, 25);
  18377         site num := frm Main.Piece (frmMain.R PCBroker1. Results[x] , '^', 1);
  18378         frmR emoteSiteP ick.ORList BoxSites.I tems.Add(a  + b + '   ' + FMDate TimeConver t(frmMain. Piece(frmM ain.RPCBro ker1.Resul ts[x], '^' , 3)) + '^ ' + sitenu m);
  18379       End;
  18380     End;
  18381     frmMain. AnimateLog o(False);
  18382     frmMain. StatusBarL oadPt.Capt ion := 'Re ady.';
  18383     frmMain. StatusBarL oadPt.Repa int;
  18384     Applicat ion.Proces smessages;
  18385     If frmRe moteSitePi ck.ShowMod al = mrok  Then
  18386     Begin
  18387       If Sit eNum = '20 0' Then
  18388       Begin
  18389         Try
  18390           fr mRemoteSit ePick.Rele ase;
  18391         Exce pt
  18392         End;
  18393         frmR emoteSiteP ick := Nil ;
  18394         swit chtosite : = '';
  18395         Show MessageCAP RI('Switch ing to DoD  is not al lowed.');
  18396         exit ;
  18397       End;
  18398  
  18399       If swi tchtosite  <> '' Then
  18400       Begin
  18401         For  x := 0 To  formEssoSe lect.slUse rSites.Cou nt - 1 Do                        //CodeCR77
  18402         Begi n
  18403           If  (Pos(Swit chToSite,  frmMain.Pi ece(formES SOSelect.s lUserSites [x], '^',  8)) > 0) O r // CodeC R191 -MER  05/2011
  18404              (Pos(Switc hToSite, f rmMain.Pie ce(formESS OSelect.sl UserSites[ x], '^', 4 )) > 0) Th en
  18405           Be gin
  18406              switchtosi te := intt ostr(x);
  18407              SwitchToPa tientSSN : = PatientS SN;
  18408              Try
  18409                frmRemot eSitePick. Release;
  18410                frmRemot eSitePick. Release;
  18411              Except
  18412              End;
  18413              frmRemoteS itePick :=  Nil;
  18414              actFileSel ectPatient Execute(co ntextorcon trol);
  18415              exit;
  18416           En d;
  18417           //  User does n't have a uthorized  access, so  look for  site an al ternate wa y
  18418         End;
  18419  
  18420         For  x := 0 To  formEssoSe lect.ORLis tBox2.Item s.Count -  1 Do
  18421           If  (Pos(Swit chToSite,  frmMain.Pi ece(formES SOSelect.O RListBox2. Items[x],  '^', 1)) >  0) Or
  18422              (Pos(Switc hToSite, f rmMain.Pie ce(formESS OSelect.OR ListBox2.I tems[x], ' ^', 4)) >  0) Then
  18423           Be gin
  18424              switchtosi te := '*'  + inttostr (x);
  18425              SwitchToPa tientSSN : = PatientS SN;
  18426              Try
  18427                frmRemot eSitePick. Release;
  18428                frmRemot eSitePick. Release;
  18429              Except
  18430              End;
  18431              frmRemoteS itePick :=  Nil;
  18432              actFileSel ectPatient Execute(co ntextorcon trol);
  18433              exit;
  18434           En d;
  18435         swit chtosite : = '';
  18436         Show MessageCAP RI('+You e ither do n ot have ac cess to th e remote s ite or som e other pr oblem prev ented conn ection.  T ry connect ing manual ly instead  using FIL E | SWITCH  SITES.');
  18437       End
  18438       Else
  18439       Begin
  18440         Swit chToSite : = '';
  18441         Show MessageCAP RI('*You e ither do n ot have ac cess to th e remote s ite or som e other pr oblem prev ented conn ection.  T ry connect ing manual ly instead  using FIL E | SWITCH  SITES.');
  18442       End;
  18443     End;
  18444     If assig ned(frmRem oteSitePic k) Then
  18445     Try
  18446       frmRem oteSitePic k.Release;
  18447     Except
  18448     End;
  18449     frmRemot eSitePick  := Nil;
  18450   End;
  18451  
  18452   Procedure  TfrmMain.O RListBoxSu rgeryRepor tsClick(Se nder: TObj ect);
  18453   Begin
  18454     ButtonOK SurgeryRep orts.Enabl ed := True ;
  18455   End;
  18456  
  18457   Procedure  TfrmMain.S tateFakeCh ange(Sende r: TObject );
  18458   Begin
  18459     If (Stat eFake.Text  = 'CANADA ') Or (Sta teFake.Tex t = 'PHILI PPINES') O r
  18460       (State Fake.Text  = 'QUEBEC' ) Or
  18461       (Upper case(Trim( StateFake. Text)) = ' NEWFOUNDLA ND') Or (U ppercase(T rim(StateF ake.text))  = 'LABRAD OR') Or (U ppercase(T rim(StateF ake.text))  = 'NOVA S COTIA') Or
  18462       (Upper case(Trim( StateFake. Text)) = ' PRINCE EDW ARD ISLAND ') Or (Upp ercase(Tri m(StateFak e.text)) =  'NEW BRUN SWICK') Or  (Uppercas e(Trim(Sta teFake.tex t)) = 'ONT ARIO') Or
  18463       (Upper case(Trim( StateFake. Text)) = ' MANITOBA')  Or (Upper case(Trim( StateFake. text)) = ' SASKATCHEW AN') Or (U ppercase(T rim(StateF ake.text))  = 'ALBERT A') Or
  18464       (Upper case(Trim( StateFake. text)) = ' BRITISH CO LUMBIA') O r (Upperca se(Trim(St ateFake.te xt)) = 'YU KON TERRIT ORY') Or ( Uppercase( Trim(State Fake.text) ) = 'NORTH WEST TERRI TORIES') O r
  18465       (Upper case(Trim( StateFake. text)) = ' NUNAVUT')  Then
  18466     Begin
  18467       lblCou nty.Visibl e := False ;
  18468       County Fake.Text  := '';
  18469       County Fake.Visib le := Fals e;
  18470       If FME ditCounty. Text <> ''  Then
  18471         FMEd itCounty.T ext := '@' ;
  18472       FMEdit County.Vis ible := Fa lse;
  18473       FMCoun tiesList.V isible :=  False;
  18474       Button CountyAcce pt.Visible  := False;
  18475       lblZip .Visible : = False;
  18476       If FME ditZip.Tex t <> '' Th en
  18477         FMEd itZip.Text  := '@';
  18478       FMEdit Zip.Visibl e := False ;
  18479       FMStat esList.Vis ible := Fa lse;
  18480       Button StateAccep t.Visible  := False;
  18481     End
  18482     Else
  18483     Begin
  18484       lblCou nty.Visibl e := True;
  18485       County Fake.Visib le := True ;
  18486       lblZip .Visible : = True;
  18487       FMEdit Zip.Visibl e := True;
  18488     End;
  18489   End;
  18490  
  18491   Procedure  TfrmMain.B uttonIPRCo pyClick(Se nder: TObj ect);
  18492   Var
  18493     tempIEN:  String;
  18494     x: integ er;
  18495   Begin
  18496     If Messa geDlgCAPRI ('Would yo u like to  make a NEW  copy of t he selecte d template  and assig n it to yo urself?',
  18497       mtConf irmation,  [mbYes, mb No], 0) =  mrYes Then
  18498     Begin
  18499       FMList boxIPR1.It emIndex :=  FMListBox IPR1.Items .Count - 1  - ListBox IPR1.ItemI ndex;
  18500       If FML istboxIPR1 .ItemIndex  < 0 Then
  18501       Begin
  18502         Mess ageDlgCAPR I('You mus t select a  record fi rst!', mtI nformation , [mbOk],  0);
  18503         Exit ;
  18504       End;
  18505       RPCBro ker1.Remot eProcedure  := 'DVBAB  FORM COPY ';
  18506       RPCBro ker1.Param [1].Value  := FMListB oxIPR1.Get SelectedRe cord.IEN;
  18507       RPCBro ker1.Param [1].PType  := literal ;
  18508       frmMai n.RPCBroke rCall;
  18509       Try
  18510         RPCB roker1.Cal l;
  18511       Except
  18512         On E BrokerErro r Do
  18513         Begi n
  18514           AN URemotePro cedureCall InProgress  := False;
  18515           An imateLogo( False);
  18516           St atusBarLoa dPt.Captio n := 'RPC  DVBAB FORM  COPY coul d not be a ccessed!';
  18517           St atusBarLoa dPt.Repain t;
  18518           Ap plication. Processmes sages;
  18519           Sh owMessageC APRI('ORWU  DT could  not be acc essed!');
  18520         End;
  18521       End;
  18522       tempIE N := RPCBr oker1.Resu lts[0];
  18523       If pie ce(tempIEN , '^', 1)  = '-1' The n
  18524       Begin
  18525         // e rror happe ned
  18526         Show MessageCAP RI(piece(t empIEN, '^ ', 2));
  18527         exit ;
  18528       End;
  18529       Button IPRRefresh Click(Appl ication);
  18530       x := 0 ;
  18531       If Lis tBoxIPR1.I tems.Count  > 0 Then
  18532         Repe at
  18533           Li stBoxIPR1. ItemIndex  := x;
  18534           Li stBoxIPR1C lick(Appli cation);
  18535           FM ListboxIPR 1.ItemInde x := FMLis tBoxIPR1.I tems.Count  - 1 - Lis tBoxIPR1.I temIndex;
  18536           If  FMListBox IPR1.GetSe lectedReco rd.IEN = t empIEN The n
  18537           Be gin
  18538              x := -1;
  18539              buttonIPRD isplayClic k(applicat ion);
  18540           En d;
  18541         Unti l (x > Lis tBoxIPR1.I tems.Count  - 1) Or ( x = -1);
  18542       // For m should'v e been loa ded at thi s point or  it couldn 't
  18543       // be  found for  some reaso n
  18544     End;
  18545  
  18546   End;
  18547  
  18548   {========= ========== ========== ========== ========== ========== ========== =========
  18549     ListBoxI PR1KeyDown
  18550       ListBo xIPR1KeyDo wn is a me thod that  will proce ss key pre sses to ch eck for a
  18551         part icular con dition.  T he problem  this meth od correct s is an in ability to
  18552         use  the cursor  keys to s elect the  item focus  in the li stbox List BoxIPR1.
  18553         The  reason the re is a pr oblem is t hat the On Click even t handler  prevents
  18554         'sub -items' fr om being s elected.   It does th is by forc ing focus  to the sub -items
  18555         pare nt item.   As a resul t using th e down arr ow appears  to have n o effect.
  18556         Note : Sub-item s start wi th '!'.  T he '!' is  a flag to  format dif ferently
  18557         and  prevent se lection.   The '!' ch aracter is  stripped  out on dis play.
  18558         In o rder to co rrect the  problem, t his detect s if a con dition exi sts where
  18559         a do wn arrow k ey event w ould fail  to act cor rectly, it  then hand les the
  18560         item  selection  and sets  the key to  0 to prev ent it fro m being ha ndled twic e.
  18561  
  18562     Modifica tion Histo ry:
  18563       CodeCR 117 - 8/20 10 Method  created -M ER
  18564    ========= ========== ========== ========== ========== ========== ========== =========}
  18565  
  18566   procedure  TfrmMain.L istBoxIPR1 KeyDown(Se nder: TObj ect; var K ey: Word;
  18567     Shift: T ShiftState );                                                                // -MER Co deCR117 8/ 2010
  18568   var
  18569     lNdx: in teger;
  18570   begin
  18571     if (Key  = 40) and                                                                    // down cu rsor key
  18572       (ListB oxIPR1.Ite mIndex < ( ListBoxIPR 1.Items.Co unt - 1))  and                   // not las t item
  18573       (Copy( ListBoxIPR 1.Items[Li stBoxIPR1. ItemIndex  + 1], 1, 1 ) = '!')              // next it em is a su b-item
  18574       then b egin
  18575       lNdx : = ListBoxI PR1.ItemIn dex + 1;
  18576       while  (lNdx < (L istBoxIPR1 .Items.Cou nt - 1)) a nd
  18577         (Cop y(ListBoxI PR1.Items[ lNdx], 1,  1) = '!')
  18578         do
  18579         Inc( lNdx);
  18580       if (lN dx < (List BoxIPR1.It ems.Count) ) and
  18581         (Cop y(ListBoxI PR1.Items[ lNdx], 1,  1) <> '!')
  18582         then  begin
  18583         List BoxIPR1.It emIndex :=  lNdx;
  18584         Key  := 0;                                                                        // prevent  the key p ress from  being acte d on furth er
  18585       end;
  18586     end;
  18587   end;
  18588  
  18589   Procedure  TfrmMain.L istBoxIPR1 KeyUp(Send er: TObjec t; Var Key : Word;
  18590     Shift: T ShiftState );
  18591   Begin
  18592     // Delet e key
  18593     If key =  46 Then
  18594       If but tonIPRDele te.visible  = true Th en
  18595         butt onIPRDelet eclick(app lication);
  18596     // Enter  key
  18597     If key =  13 Then
  18598       button IPRDisplay click(appl ication);
  18599   End;
  18600  
  18601   Procedure  TfrmMain.b uttonNewsC lick(Sende r: TObject );
  18602   Begin
  18603     If formN ews = nil  Then formN ews := Tfo rmNews.Cre ate(frmMai n);
  18604     formNews .BringToFr ont;
  18605     TimerNew s.Enabled  := False;
  18606     formNews .Edit1.Set focus;
  18607     formNews .ShowModal ;
  18608     Try
  18609       formNe ws.Hide;
  18610     Except E nd;
  18611     Try
  18612       TimerN ews.Enable d := True;
  18613     Except E nd;
  18614     Try
  18615       TimerN ewsTimer(b uttonNews) ;
  18616     Except E nd;
  18617     Try
  18618       If RPC Broker1.Co nnected =  True Then
  18619         butt onNews.Set Focus;
  18620     Except E nd;
  18621   End;
  18622  
  18623   Procedure  TfrmMain.T imerNewsTi mer(Sender : TObject) ;
  18624   Var
  18625     temptext : String;
  18626     x: integ er;
  18627     priority found: boo lean;
  18628     regularf ound: bool ean;
  18629     aStream:  TMemorySt ream;
  18630   Begin
  18631     // Check  news ever y 30 minut es
  18632     // 1000m s * 60 sec onds * 30  mins = 600 000ms
  18633     Cursor : = crHourgl ass;
  18634     temptext  := Status BarLoadPt. Caption;
  18635     StatusBa rLoadPt.Ca ption := ' Checkin\x001Ag  news...';
  18636     formNews .RichEditN ews.Lines. Clear;
  18637     formNews .RichEditN ewsViewed. Lines.Clea r;
  18638     If frmMa in.Visible  = False T hen
  18639     Begin
  18640       frmEst ablishingN etworkConn ection :=  tfrmEstabl ishingNetw orkConnect ion.Create (applicati on);
  18641       frmEst ablishingN etworkConn ection.Sho w;
  18642       frmEst ablishingN etworkConn ection.Rep aint;
  18643     End
  18644     Else
  18645     Begin
  18646       button News.Enabl ed := Fals e;
  18647     End;
  18648  
  18649     formNews .RichEditN ews.Lines. Clear;
  18650  
  18651     aStream  := TMemory Stream.Cre ate;
  18652     formNews .GetURL('h ttp://' +  newsURL +  'NewsHeade rs.txt', a Stream);
  18653     formNews .RichEditN ews.Lines. LoadFromSt ream(aStre am);
  18654     aStream  := nil;
  18655  
  18656     If (form News.RichE ditNews.Li nes.Count  > 0) And ( formNews.R ichEditNew s.Lines[0]  <> ';CAPR I NEWS') T hen
  18657       formNe ws.RichEdi tNews.Line s.Clear
  18658     Else
  18659       formNe ws.RichEdi tNews.Line s.Delete(0 );                                          // Get rid  of header  line
  18660     //Try fo rmNews.Ric hEditNews. Lines.Load FromFile(n ewsfolder+ 'NewsHeade rs.txt') e xcept end;
  18661     Try
  18662     formNews .RichEditN ewsViewed. Lines.Load FromFile(t empDir + ' CAPRINewsR eadInfo.tx t')Except
  18663     End;
  18664     If frmMa in.Visible  = False T hen
  18665     Begin
  18666       frmEst ablishingN etworkConn ection.Rel ease;
  18667       frmEst ablishingN etworkConn ection :=  Nil;
  18668     End
  18669     Else
  18670     Begin
  18671       button News.Enabl ed := True ;
  18672     End;
  18673     StatusBa rLoadPt.Ca ption := t emptext;
  18674     If formN ews.RichEd itNews.Lin es.Count =  0 Then
  18675     Begin
  18676       button News.Bring ToFront;
  18677       button News.Enabl ed := Fals e;
  18678       button NewsFlash. Enabled :=  False;
  18679       exit;
  18680     End
  18681     Else
  18682     Begin
  18683     End;
  18684     // Check  for unrea d priority  news
  18685     // 0=Low  Priority
  18686     // 1=Reg ular Prior ity
  18687     // 2=Hig h Priority
  18688     priority found := f alse;
  18689     regularf ound := fa lse;
  18690     If formN ews.RichEd itNews.Lin es.Count >  0 Then
  18691       For x  := 0 To fo rmNews.Ric hEditNews. Lines.Coun t - 1 Do
  18692       Begin
  18693         If ( Piece(form News.RichE ditNews.Li nes[x], '^ ', 1) = '2 ') Then
  18694         Try
  18695           If  formNews. RichEditNe wsViewed.L ines[strto int(piece( formNews.R ichEditNew s.Lines[x] , '^', 2)) ] <> 'Y' T hen
  18696              priorityfo und := tru e;
  18697         Exce pt
  18698           pr iorityfoun d := true;
  18699         End;
  18700         If ( Piece(form News.RichE ditNews.Li nes[x], '^ ', 1) = '1 ') Then
  18701         Try
  18702           If  formNews. RichEditNe wsViewed.L ines[strto int(piece( formNews.R ichEditNew s.Lines[x] , '^', 2)) ] <> 'Y' T hen
  18703              regularfou nd := true ;
  18704         Exce pt
  18705           re gularfound  := true;
  18706         End;
  18707       End;
  18708  
  18709     cursor : = crDefaul t;
  18710  
  18711     // First  make icon  for low p riority or  all news  read
  18712     buttonNe ws.BringTo Front;
  18713     buttonNe ws.Enabled  := True;
  18714     buttonNe wsFlash.En abled := F alse;
  18715  
  18716     // Set i cons for n ews if new  regular m ail is fou nd
  18717     If Regul arFound =  True Then
  18718     Begin
  18719       button News.Enabl ed := Fals e;
  18720       button NewsFlash. BringToFro nt;
  18721       button NewsFlash. Enabled :=  True;
  18722       // Don 't call re ader for r egular mai l at start up
  18723     End;
  18724  
  18725     // Set I cons and c all newsre ader if pr iority is  found
  18726     If Prior ityFound =  True Then
  18727     Begin
  18728       button News.Enabl ed := Fals e;
  18729       button NewsFlash. BringToFro nt;
  18730       button NewsFlash. Enabled :=  True;
  18731       If sen der = RPCB roker1 The n
  18732         butt onNewsClic k(Applicat ion);                                                  // call re ader for p riority ma il at star tup
  18733     End;
  18734  
  18735   End;
  18736  
  18737   Procedure  TfrmMain.D eleteText( Sender: TO bject);
  18738   Begin
  18739     Sender : = screen.A ctiveContr ol;
  18740  
  18741     If Sende r.ClassTyp e = TMemo  Then
  18742     Begin
  18743       (Sende r As TMemo ).SelText  := '';
  18744     End
  18745     Else
  18746       If Sen der.ClassT ype = TEdi t Then
  18747       Begin
  18748         (Sen der As TEd it).SelTex t := '';
  18749       End
  18750       Else
  18751         If S ender.Clas sType = TR ichEdit Th en
  18752         Begi n
  18753           (S ender As T RichEdit). SelText :=  '';
  18754         End
  18755         Else
  18756           Sl eep(1);                                                                      //Showmess age('Unkno wn class t ype: '+Sen der.ClassN ame);
  18757   End;
  18758  
  18759   Procedure  TfrmMain.D eleteTempl ateClick(S ender: TOb ject);
  18760   Begin
  18761     ButtonIP RDeleteCli ck(Applica tion);
  18762   End;
  18763  
  18764   Procedure  TfrmMain.B itBtn1Clic k(Sender:  TObject);
  18765   Begin
  18766     WebBrows er1.GoBack ;
  18767   End;
  18768  
  18769   Procedure  TfrmMain.B itBtn2Clic k(Sender:  TObject);
  18770   Begin
  18771     Try
  18772     WebBrows er1.GoForw ard Except
  18773     End;
  18774   End;
  18775  
  18776   Procedure  TfrmMain.B itBtnLaunc hVistaWebC lick(Sende r: TObject );
  18777   Begin
  18778     btnVistA WebHomeCli ck(bitbtnL aunchVistA Web);
  18779   End;
  18780  
  18781   Procedure  TfrmMain.W ebBrowser1 DocumentCo mplete(Sen der: TObje ct;
  18782     Const pD isp: IDisp atch; Var  URL: OleVa riant);
  18783   Begin
  18784     cursor : = crDefaul t;
  18785     progress BarLoadPt. visible :=  False;
  18786   End;
  18787  
  18788   Procedure  TfrmMain.W ebBrowser1 ProgressCh ange(Sende r: TObject ; Progress ,
  18789     Progress Max: Integ er);
  18790   Begin
  18791     If Page9 5Control1. ActivePage  <> TabVis tAWeb Then
  18792       progre ssBarLoadP t.Visible  := False
  18793     Else
  18794       progre ssBarLoadP t.Visible  := True;
  18795     progress BarLoadPt. Position : = Progress ;
  18796     progress BarLoadPt. Max := Pro gressMax;
  18797     If progr essBarLoad Pt.Max < P rogressMax  Then
  18798       cursor  := crHour glass;
  18799     If progr essBarLoad Pt.Max = P rogressMax  Then
  18800       progre ssBarLoadP t.Visible  := False;
  18801   End;
  18802  
  18803   //CodeCR18 7 - rpm 5/ 25/11 Prev ent browse r from bei ng closed,  which gen erates OLE  errors
  18804  
  18805   procedure  TfrmMain.W ebBrowser1 WindowClos ing(ASende r: TObject ;
  18806     IsChildW indow: Wor dBool; var  Cancel: W ordBool);
  18807   begin
  18808     Cancel : = True;
  18809   end;
  18810  
  18811   Procedure  TfrmMain.W ebBrowser1 NavigateCo mplete2(Se nder: TObj ect;
  18812     Const pD isp: IDisp atch; Var  URL: OleVa riant);
  18813   Begin
  18814     cursor : = crDefaul t;
  18815     Progress BarLoadPt. Visible :=  False;
  18816   End;
  18817  
  18818   Procedure  TfrmMain.W ebBrowser1 BeforeNavi gate2(Send er: TObjec t;
  18819     Const pD isp: IDisp atch; Var  URL, Flags , TargetFr ameName, P ostData,
  18820     Headers:  OleVarian t; Var Can cel: WordB ool);
  18821   Begin
  18822     cursor : = crHourgl ass;
  18823   End;
  18824  
  18825   Procedure  TfrmMain.B itBtn4Clic k(Sender:  TObject);
  18826   Begin
  18827     actFileP rint.Execu te;
  18828   End;
  18829  
  18830   Procedure  TfrmMain.T imerInitia lConnectio nTimer(Sen der: TObje ct);
  18831   Begin
  18832     Applicat ion.Termin ate;
  18833   End;
  18834  
  18835   // DoD tab  function  - DoD tab  is no long er display ed so this  function  will 
  18836   // never e xecute.  P atch 193 J RL 7/21/16
  18837   Procedure  TfrmMain.H eaderContr olDoDPNsSe ctionResiz e(
  18838     HeaderCo ntrol: THe aderContro l; Section : THeaderS ection);
  18839   Begin
  18840     VAWrapGr idDOD.ColC ount := 5;
  18841     VAWrapGr idDOD.ColW idths[0] : = HeaderCo ntrolDODPN s.Sections [0].Width  - 2;
  18842     VAWrapGr idDOD.ColW idths[1] : = HeaderCo ntrolDODPN s.Sections [1].Width  - 2;
  18843     VAWrapGr idDOD.ColW idths[2] : = HeaderCo ntrolDODPN s.Sections [2].Width  - 1;
  18844     VAWrapGr idDOD.ColW idths[3] : = HeaderCo ntrolDODPN s.Sections [3].Width  - 1;
  18845     VAWrapGr idDOD.ColW idths[4] : = HeaderCo ntrolDODPN s.Sections [4].Width  - 1;
  18846   End;
  18847  
  18848   Procedure  TfrmMain.R PCBroker1A fterCall(S ender: TOb ject);
  18849   Var
  18850     tempstri ng: String ;
  18851     x: integ er;
  18852   Begin
  18853     tempstri ng := 'RES ULTS:' + c har(13) +  char(10);
  18854     If (Send er As TRPC Broker).Re sults.Coun t > 0 Then
  18855       For x  := 0 To (S ender As T RPCBroker) .Results.C ount - 1 D o
  18856       Begin
  18857         temp string :=  tempstring  + inttost r(x) + ':  ' + (Sende r As TRPCB roker).Res ults[x] +  char(13) +  char(10);
  18858       End
  18859     Else
  18860       tempst ring := te mpstring +  'No resul ts were re turned.' +  char(13)  + char(10) ;
  18861  
  18862     If assig ned(frmBro kerHistory Buffer) Th en
  18863     Begin
  18864       frmBro kerHistory Buffer.Ric hEditBroke rCalls.Lin es.Add(tem pstring);
  18865       frmBro kerHistory Buffer.Sav eNewCall;
  18866     End;
  18867  
  18868   End;
  18869  
  18870   Procedure  TfrmMain.R PCBroker1B eforeCall( Sender: TO bject);
  18871   Var
  18872     tempstri ng: String ;
  18873     x, y: in teger;
  18874   Begin
  18875     tempstri ng := 'COM PONENT: '  + (Sender  As TRPCBro ker).name  + char(13)  + char(10 ) + char(1 3) + char( 10);
  18876     tempstri ng := temp string + ' REMOTE PRO CEDURE:' +  (Sender A s TRPCBrok er).Remote Procedure  + char(13)  + char(10 ) + char(1 3) + char( 10);
  18877     tempstri ng := temp string + ' PARAMETERS :' + char( 13) + char (10);
  18878     If (Send er As TRPC Broker).Pa ram.Count  > 0 Then
  18879     Begin
  18880       For x  := 0 To (S ender As T RPCBroker) .Param.Cou nt - 1 Do
  18881       Begin
  18882         temp string :=  tempstring  + inttost r(x) + ':  ' + (Sende r As TRPCB roker).Par am.ParamAr ray[x].Val ue + char( 13) + char (10);
  18883         If ( Sender As  TRPCBroker ).Param.Pa ramArray[x ].Mult.Cou nt > 0 The n
  18884           Fo r y := 0 T o (Sender  As TRPCBro ker).Param .ParamArra y[x].Mult. Count - 1  Do
  18885           Be gin
  18886              tempstring  := tempst ring + '   MULT ' + i nttostr(y)  + ': ' +  (Sender As  TRPCBroke r).Param.P aramArray[ x].Mult.Su bscript(y)  + char(13 ) + char(1 0);
  18887           En d;
  18888       End;
  18889       tempst ring := te mpstring +  char(13)  + char(10) ;
  18890     End
  18891     Else
  18892       tempst ring := te mpstring +  'No param eters spec ified.' +  char(13) +  char(10)  + char(13)  + char(10 );
  18893  
  18894     tempstri ng := temp string + ' ---------- ---------- ---------- ---------- ' + char(1 3) + char( 10);
  18895  
  18896     If assig ned(frmBro kerHistory Buffer) Th en
  18897     Begin
  18898       frmBro kerHistory Buffer.Ric hEditBroke rCalls.Lin es.Add(tem pstring);
  18899     End;
  18900  
  18901   End;
  18902  
  18903   Procedure  TfrmMain.F MListBoxAd missionEnt er(Sender:  TObject);
  18904   Begin
  18905     FMListBo xAdmission .color :=  clYellow;
  18906   End;
  18907  
  18908   Procedure  TfrmMain.F MListBoxAd missionExi t(Sender:  TObject);
  18909   Begin
  18910     FMListBo xAdmission .color :=  clWindow;
  18911   End;
  18912  
  18913   Procedure  TfrmMain.B uttonIPRRe freshEnter (Sender: T Object);
  18914   Begin
  18915     If Page9 5Control1. ActivePage  <> TabCPW orksheets  Then
  18916     Try
  18917       Page95 Control1.S etFocus;
  18918     Except
  18919     End;
  18920  
  18921   End;
  18922  
  18923   Procedure  TfrmMain.P age95Contr ol1Changin g(Sender:  TObject;
  18924     Var Allo wChange: B oolean);
  18925   Begin
  18926     If ANURe moteProced ureCallInP rogress =  True Then
  18927       AllowC hange := F alse
  18928     Else
  18929       AllowC hange := T rue;
  18930   End;
  18931  
  18932   Procedure  TfrmMain.T ab95Contro l1Changing (Sender: T Object;
  18933     Var Allo wChange: B oolean);
  18934   Begin
  18935     If ANURe moteProced ureCallInP rogress =  True Then
  18936       AllowC hange := F alse
  18937     Else
  18938       AllowC hange := T rue;
  18939   End;
  18940  
  18941   Function T frmMain.Pi ece(Const  S: String;  Delim: ch ar;
  18942     PieceNum : Integer) : String;
  18943   Begin
  18944   //  Result  := CapriS upport.Pie ce(S, Deli m, PieceNu m);
  18945     Result : = MFunStr. Piece(S, D elim, Piec eNum);                                      // rpk 5/2 6/2015
  18946   End;
  18947  
  18948   Function T frmMain.Is UserKey(Ke yName: Str ing): Bool ean;
  18949   Var
  18950     i: Integ er;
  18951   Begin
  18952     (*
  18953     CAPRI KE YS
  18954     DVBA CAP RI GUI - T his is the  option co ntext to t he main CA PRI applic ation. All  CAPRI use rs will ne ed this me nu option  assigned
  18955     DVBA CAP RI WORKSHE ET TAB - T his securi ty key mak es the C&P  Worksheet s tab visi ble inside  CAPRI. Al l Veterans  Health Ad ministrati on (VHA) C APRI users  should ha ve this se curity key
  18956     DVBAB CP WM DISALLO W REVIEW -  User does  not need  their docu ments revi ewed prior  to releas e
  18957     DVBAB CP WM OPTIONA L REVIEW -  User can  choose to  send some  documents  for review  and not o ther docum ents
  18958     DVBAB CP WM REQUIRE  REVIEW -  User must  have all d ocuments r eviewed by  a reviewe r prior to  upload
  18959     OPTIONAL  Key - If  the site c hooses to  use the re view proce ss, users  designated  as a revi ewer must  be assigne d the DVBA B CPWM REV IEWER secu rity key
  18960     DVBA CAP RI VRE_COU NSELOR -   Make the v ocational  rehab tab  visible on ly if the  user has t his key as signed (Co deCR347 -  JRL 6/21/1 2)
  18961     DVBA CAP RI VHA_COO RDINATOR -  Above key  must be a ssigned, t oo, to hav e this acc ess - used  for assig ning consu lts in Voc Rehab (Cod eCR347 - J RL 6/21/12 )
  18962     DVBA CAP RI DENY_GE TVBADOCS -  This opti on keeps a ssigned VB A users fr om accessi ng VVA --  obsoleted  in patch 1 87 JRL 5/2 2/14
  18963     DVBA CAP RI GETVBAD OCS - This  option is  required  for any us er to "Get  Docs from  VVA".  Th is replace d the Deny  key above  using opp osite logi c.  JRL 5/ 22/14
  18964     DVBA CAP RI GETDOCS FROMVLER -  This opti on is requ ired for a ny user to  "Get Docs  from VLER ".  Patch  187 JRL 5/ 22/14
  18965  
  18966     -To acti vate a CPW M for a pa rticular u ser, a men u option a nd several  security  keys must  be assigne d:
  18967     -- IRM's  will need  to coordi nate with  the C&P cl inic to de termine wh at keys a  user shoul d receive.
  18968        The m ajority of  users wil l need 2 n ew keys. T he reviewe r type use r will nee d 3 keys
  18969     --Some s ites requi re the exa m to be se nt to a re viewer whe n complete .
  18970     --It is  imperative  that a us er not be  given ever y DVBA* ke y. The key s have con flicting u ses
  18971       and un expected e rrors will  happen.
  18972     *)
  18973     Result : = False;
  18974     Try
  18975       KeyNam e := Upper Case(Trim( KeyName));
  18976       If Key Name = ''  Then
  18977         Exit ;
  18978       For i  := 0 To Us erKeys.Cou nt - 1 Do
  18979       Begin
  18980         If U serKeys[i]  = KeyName  Then
  18981         Begi n
  18982           Re sult := Tr ue;
  18983           Br eak;
  18984         End;
  18985       End;
  18986     Except
  18987     End;
  18988   End;
  18989  
  18990   Function T frmMain.Is UserKeyInL ist(KeyLis t: String) : Boolean;
  18991   Var
  18992     i: Integ er;
  18993     lst: TSt ringList;
  18994   Begin
  18995     (*
  18996     CAPRI KE YS
  18997     DVBA CAP RI GUI - T his is the  option co ntext to t he main CA PRI applic ation. All  CAPRI use rs will ne ed this me nu option  assigned
  18998     DVBA CAP RI WORKSHE ET TAB - T his securi ty key mak es the C&P  Worksheet s tab visi ble inside  CAPRI. Al l Veterans  Health Ad ministrati on (VHA) C APRI users  should ha ve this se curity key
  18999     DVBAB CP WM DISALLO W REVIEW -  User does  not need  their docu ments revi ewed prior  to releas e
  19000     DVBAB CP WM OPTIONA L REVIEW -  User can  choose to  send some  documents  for review  and not o ther docum ents
  19001     DVBAB CP WM REQUIRE  REVIEW -  User must  have all d ocuments r eviewed by  a reviewe r prior to  upload
  19002     OPTIONAL  Key - If  the site c hooses to  use the re view proce ss, users  designated  as a revi ewer must  be assigne d the DVBA B CPWM REV IEWER secu rity key
  19003     DVBA CAP RI VRE_COU NSELOR -   Make the v ocational  rehab tab  visible on ly if the  user has t his key as signed (Co deCR347 -  JRL 6/21/1 2)
  19004     DVBA CAP RI VHA_COO RDINATOR -  Above key  must be a ssigned, t oo, to hav e this acc ess - used  for assig ning consu lts in Voc Rehab (Cod eCR347 - J RL 6/21/12 )
  19005     DVBA CAP RI DENY_GE TVBADOCS -  This opti on keeps a ssigned VB A users fr om accessi ng VVA --  obsoleted  in patch 1 87 JRL 5/2 2/14
  19006     DVBA CAP RI GETVBAD OCS - This  option is  required  for any us er to "Get  Docs from  VVA".  Th is replace d the Deny  key above  using opp osite logi c.  JRL 5/ 22/14
  19007     DVBA CAP RI GETDOCS FROMVLER -  This opti on is requ ired for a ny user to  "Get Docs  from VLER ".  Patch  187 JRL 5/ 22/14
  19008  
  19009  
  19010     -To acti vate a CPW M for a pa rticular u ser, a men u option a nd several  security  keys must  be assigne d:
  19011     -- IRM's  will need  to coordi nate with  the C&P cl inic to de termine wh at keys a  user shoul d receive.
  19012        The m ajority of  users wil l need 2 n ew keys. T he reviewe r type use r will nee d 3 keys
  19013     --Some s ites requi re the exa m to be se nt to a re viewer whe n complete .
  19014     --It is  imperative  that a us er not be  given ever y DVBA* ke y. The key s have con flicting u ses
  19015       and un expected e rrors will  happen.
  19016     *)
  19017     Result : = False;
  19018     Try
  19019       lst :=  TStringLi st.Create( );
  19020       Try
  19021         KeyL ist := Str ingReplace (KeyList,  ',', #13 +  #10, [rfR eplaceAll] );
  19022         lst. SetText(PA nsiChar(Ke yList));
  19023         For  i := 0 To  (lst.Count  - 1) Do
  19024         Begi n
  19025           If  IsUserKey (lst[i]) T hen
  19026           Be gin
  19027              Result :=  True;
  19028              Exit;
  19029           En d;
  19030         End;
  19031       Finall y
  19032         Free AndNil(lst );
  19033       End;
  19034     Except
  19035     End;
  19036   End;
  19037  
  19038  
  19039  
  19040   Procedure  TfrmMain.U serKeysDia log;
  19041   Var
  19042     sgKeys:  String;
  19043     i: Integ er;
  19044   Begin
  19045     sgKeys : = '';
  19046     For i :=  0 To User Keys.Count  - 1 Do
  19047     Begin
  19048       sgKeys  := sgKeys  + UserKey s[i] + #13  + #10;
  19049     End;
  19050     ShowMess age('Your  CAPRI User  Keys are: ' + #13 +  #10 + sgKe ys);
  19051   End;
  19052  
  19053   Procedure  TfrmMain.U serKeys1Cl ick(Sender : TObject) ;
  19054   Begin
  19055     UserKeys Dialog;
  19056   End;
  19057  
  19058   Procedure  TfrmMain.U serKeysEdi tDialog;
  19059   Var
  19060     frm: Tfr mUserKeyEd itor;
  19061     inMR: In teger;
  19062   Begin
  19063     frm := T frmUserKey Editor.Cre ate(Nil);
  19064     Try
  19065       frm.mm o.Lines.Se tText(PAns iChar(User Keys.Text) );
  19066       inMR : = frm.Show Modal();
  19067       If inM R = mrCanc el Then
  19068       Begin
  19069         Exit ;
  19070       End;
  19071       If inM R = mrOK T hen
  19072       Begin
  19073         User Keys.SetTe xt(PAnsiCh ar(frm.mmo .Lines.Tex t));
  19074       End;
  19075       If inM R = mrRetr y Then
  19076       Begin
  19077         User Keys.SetTe xt(PAnsiCh ar(UserKey sStr));
  19078       End;
  19079     Finally
  19080       FreeAn dNil(frm);
  19081     End;
  19082   End;
  19083  
  19084   function T frmMain.Is PNCSOpen:  Boolean;
  19085   begin
  19086     Result : = False;
  19087     Try
  19088       If PNC SForm <> N il Then
  19089       Begin
  19090         Resu lt := True ;
  19091         PNCS Form.Show;
  19092         PNCS Form.Bring ToFront;
  19093         Show MessageCAP RI('You ha ve a templ ate open.   Close it  first.');
  19094       End;
  19095     Except
  19096     End;
  19097   end;
  19098  
  19099   function T frmMain.Is RPCBrokerC onnected(R PCBroker:  TCCOWRPCBr okerCAPRI;  ShowMsg:  Boolean; S tatus: TLa bel): Bool ean;
  19100   Var
  19101     Msg: Str ing;
  19102   begin
  19103     Result : = True;
  19104     Try
  19105       If Not  RPCBroker .Connected  Then
  19106       Begin
  19107         Msg  := 'Connec tion to Vi stA has be en lost. C APRI will  try to re- Connect.';
  19108         If S tatus <> n il Then
  19109         Begi n
  19110           St atus.Capti on := 'Try ing to re- connect to  VistA';
  19111           St atus.Updat e;
  19112         End;
  19113         If S howMsg The n Applicat ion.Messag eBox(PChar (Msg), 'No  network c onnection' , MB_OK);
  19114         //RP CBroker.Co nnected :=  True;  BS E mod - rp m 4/9/09
  19115         RPCB roker.BSER econnect(' DVBA CAPRI  GUI');
  19116         Resu lt := RPCB roker.Conn ected;
  19117         If N ot RPCBrok er.Connect ed Then
  19118         Begi n
  19119           If  Status <>  nil Then
  19120           Be gin
  19121              Status.Cap tion := 'C annot re-c onnect to  VistA';
  19122              Status.Upd ate;
  19123           En d;
  19124           Ms g := 'Conn ection to  VistA has  been lost.  You may n eed to shu tdown CAPR I.';
  19125           If  ShowMsg T hen Applic ation.Mess ageBox(PCh ar(Msg), ' No network  connectio n', MB_OK) ;
  19126         End;
  19127       End;
  19128     Except
  19129       Raise;
  19130     End;
  19131   end;
  19132  
  19133   function T frmMain.Is RPCBrokerC onnected(S howMsg: Bo olean;
  19134     Status:  TLabel): B oolean;
  19135   begin
  19136     Result : = IsRPCBro kerConnect ed(RPCBrok er1, ShowM sg, Status );
  19137   end;
  19138  
  19139   function T frmMain.Is RPCBrokerC onnected:  Boolean;
  19140   begin
  19141     Result : = IsRPCBro kerConnect ed(RPCBrok er1, True,  StatusBar LoadPt);
  19142   end;
  19143  
  19144   //QC #2016  - Functio nality no  longer nee ded
  19145   {*
  19146   function T frmMain.Ca nAccessRev iew: Boole an;
  19147   begin
  19148     Result:= True;
  19149     // Check  key for a ccess to p ending rev iew docume nts
  19150     If FMLis tBoxIPR1.I temIndex >  -1 Then
  19151     Begin
  19152       If Pos ('    REVI EW PENDING ', FMListB oxIPR1.Ite ms[FMListB oxIPR1.Ite mIndex]) >  0 Then
  19153       Begin
  19154         // C heck for @  sign, man ager key
  19155         // I f not, clo se out for m, otherwi se show it .
  19156         If P os('@', us erfilemanc ode) > 0 T hen Result  := True;
  19157         If U serKeys.Co unt>0 Then
  19158         Begi n
  19159           Re sult:=IsUs erKeyInLis t('DVBAB C PWM REVIEW ER,DVBAB C PWM REVIE' );
  19160         End;
  19161         If R esult = fa lse Then
  19162         Begi n
  19163           Sh owMessageC APRI('You  do not hav e access t o document s waiting  for review .  Securit y key DVBA B CPWM REV IEWER is r equired fo r this fun ction.');
  19164         End;
  19165       End;
  19166     End;
  19167   end;
  19168   *}
  19169  
  19170   function T frmMain.Is PNCSRecord Selected(F MListBox:  TFMListBox ): Boolean ;
  19171   begin
  19172     Result : = False;
  19173     Try
  19174       If FML istBox = n il Then Ex it;
  19175       If FML istbox.Ite mIndex < 0  Then
  19176       Begin
  19177         Mess ageDlgCAPR I('You mus t select a  record fi rst!', mtI nformation , [mbOk],  0);
  19178         Exit ;
  19179       End;
  19180       Result  := True;
  19181     Except
  19182     End;
  19183   end;
  19184  
  19185   {========= ========== ========== ========== ========== ========== ========== ======
  19186    IsPrimary MenuAssign able
  19187    Input:  U serPrimary Menu - Pri mary Menu  Option ass igned to u ser
  19188    Output:   Return tru e when opt ion exists  in file # 396.8; oth erwise ret urn
  19189              false
  19190  
  19191    CodeCR109  - rpm 8/4 /10
  19192    ========= ========== ========== ========== ========== ========== ========== ======}
  19193  
  19194   function T frmMain.Is PrimaryMen uAssignabl e(
  19195     const Us erPrimaryM enu: Strin g): Boolea n;
  19196   var
  19197     FMFind1P rimaryMenu : TFMFindO ne;
  19198     IEN: Str ing;
  19199   begin
  19200     Result : = False;
  19201     if (User PrimaryMen u <> '') t hen                                                    //CodeCR16 3 - rpm 4/ 4/11
  19202     begin
  19203       FMFind 1PrimaryMe nu := TFMF indOne.Cre ate(nil);
  19204       try
  19205         with  FMFind1Pr imaryMenu  do
  19206         begi n
  19207           RP CBroker :=  RPCBroker 1;
  19208           Fi leNumber : = '396.8';
  19209           Va lue := Use rPrimaryMe nu;
  19210           Fi nderFlags  := [fnfXac tMatch];
  19211           IE N := GetIE N;
  19212           if  (IEN <> ' ') and (IE N <> '0')  then
  19213              Result :=  True;
  19214         end;
  19215       finall y
  19216         Free AndNil(FMF ind1Primar yMenu);
  19217       end;
  19218     end;
  19219   end;
  19220  
  19221   function T frmMain.Fi leDeleteOl dSaveHisto ry(Existin gFile, Exi stingDateC reated, Cu rrentFile:  String):  Boolean;
  19222   begin
  19223     Result : = False;
  19224     Try
  19225       Existi ngFile :=  UpperCase( ExistingFi le);
  19226       Curren tFile := U pperCase(C urrentFile );
  19227       If Exi stingFile  = CurrentF ile Then
  19228       Begin
  19229         If ( StrToFloat (ExistingD ateCreated ) < (date( ) - 14)) T hen
  19230         Begi n
  19231           De leteFile(t empdir + E xistingFil e);
  19232           Re sult := Tr ue;
  19233         End;
  19234       End;
  19235     Except
  19236     End;
  19237   end;
  19238  
  19239   procedure  TfrmMain.F ileCreateN ameForAppl icationExc eptionLog( var Filena me: String ; DayCount er: intege r);
  19240   Var
  19241     DatePart : String;
  19242     VersionP art: Strin g;
  19243     d: TDate Time;
  19244   begin
  19245     d := 0.0 ;
  19246     Try Vers ionPart :=  VersionUs er; Except  End;
  19247     Try d :=  now(); Ex cept End;
  19248     Try d :=  d - DayCo unter; Exc ept End;
  19249     Try Date Part := Fo rmatDateTi me('dd_mm_ yy', d); E xcept Date Part := 'd d_mm_yy';  End;
  19250     //String Replace ha s been thr owing erro rs, so I d id the fol lowing cra zy stuff
  19251     Try Vers ionPart :=  StringRep lace(Versi onPart, '* ', '_', [] ); Except  End;
  19252     Try Vers ionPart :=  StringRep lace(Versi onPart, '* ', '_', [] ); Except  End;
  19253     Try Vers ionPart :=  StringRep lace(Versi onPart, '* ', '_', [] ); Except  End;
  19254     Try Vers ionPart :=  StringRep lace(Versi onPart, '* ', '_', [] ); Except  End;
  19255     Try Vers ionPart :=  StringRep lace(Versi onPart, '* ', '_', [r fReplaceAl l]); Excep t End;
  19256     Filename  := Versio nPart + '_ ' + DatePa rt + '.Txt ';
  19257   end;
  19258  
  19259  
  19260  
  19261   function T frmMain.TI UShowModal (SenderNam e: String;  FMListBox : TFMListB ox): Boole an;
  19262   Var
  19263     TempFMLi stbox: TFM Listbox;
  19264   begin
  19265     Result : = False;
  19266     Try
  19267       Sender Name := Lo werCase(Se nderName);
  19268       If Sen derName <>  'frmmain. buttoniprd isplay' Th en Exit;
  19269       If FME ditIPR10.T ext = '' T hen Exit;
  19270       If Sen derName =  'formtiudi splay' The n Exit;
  19271       {FormT IUDisplay  declared i n main.pas  implement ation var  section to
  19272        re-us e GetRepor tHeader an d FormatRe portBody e nabling Vi rtualVA
  19273        outpu t support  for TIUDis playUnit.p as  //Code CR353 - rp m 5/7/12}
  19274       FormTI UDisplay : = TFormTIU Display.Cr eate(nil);
  19275       Try
  19276         Temp FMListbox  := FMListB ox As TFML istBox;
  19277         Form TIUDisplay .editTIUDo cumentNumb er.Text :=  frmMain.F MEditIPR10 .Text;
  19278         Form TIUDisplay .EditTempl ateIEN.Tex t := TempF MListBox.G etSelected Record.IEN ;
  19279         Form TIUDisplay .SpeedButt onCAPRI.Do wn := True ;
  19280         Form TIUDisplay .SpeedButt onCAPRICli ck(Applica tion);
  19281         Form TIUDisplay .ShowModal ;
  19282         Resu lt := True ;
  19283       Finall y
  19284         Free AndNil(For mTIUDispla y);
  19285       End;
  19286     Except
  19287     End;
  19288   end;
  19289  
  19290   procedure  TfrmMain.F ileCreateN ameForSave HistoryLog (var Filen ame: Strin g; DayCoun ter: integ er);
  19291   Var
  19292     DatePart : String;
  19293     VersionP art: Strin g;
  19294     d: TDate Time;
  19295   begin
  19296     VersionP art := Ver sionUser;
  19297     d := now ();
  19298     d := d -  DayCounte r;
  19299     Try Date Part := Fo rmatDateTi me('dd_mm_ yy', d); E xcept Date Part := 'd d_mm_yy';  End;
  19300     //String Replace ha s been thr owing erro rs, so I d id the fol lowing cra zy stuff
  19301     Try Vers ionPart :=  StringRep lace(Versi onPart, '* ', '_', [] ); Except  End;
  19302     Try Vers ionPart :=  StringRep lace(Versi onPart, '* ', '_', [] ); Except  End;
  19303     Try Vers ionPart :=  StringRep lace(Versi onPart, '* ', '_', [] ); Except  End;
  19304     Try Vers ionPart :=  StringRep lace(Versi onPart, '* ', '_', [] ); Except  End;
  19305     Try Vers ionPart :=  StringRep lace(Versi onPart, '* ', '_', [r fReplaceAl l]); Excep t End;
  19306     Filename  := 'SaveH istory' +  VersionPar t + '_' +  DatePart +  '.Txt';
  19307   end;
  19308  
  19309   function T frmMain.Is CCRUser():  Boolean;
  19310   begin
  19311     Result : = IsUserKe yInList(CC RADMINKEY  + ',' + CC RUSERKEY);                       // DVBA CO NTRACTED E XM SPRVSR, DVBA CONTR ACTED EXM  CCRUSR');
  19312   end;
  19313  
  19314   function T frmMain.Is CCRSuperVi sor(): Boo lean;
  19315   begin
  19316     Result : = IsUserKe yInList(CC RADMINKEY) ;
  19317   end;
  19318  
  19319   {--------- -------- T frmMain.Is Allowed2Op enExam --- ---------- ----
  19320    This func tion verif ies that t he person  attempting  to open
  19321    and edit  a C&P Exam  Template  is authori zed to do  so.
  19322    User must  match the  AUTHOR (# 2) field,  match the  TRANSCRIBE R (#10)
  19323    field of  the CAPRI  TEMPLATES  (#396.17)  file, poss ess the
  19324    'DVBA CPW M REVIEWER ' security  key or ha ve FileMan  programme r
  19325    access (' @').
  19326    Returns T rue when u ser is aut horized; o therwise r eturns Fal se.
  19327    rpm 1/20/ 09
  19328  
  19329    QC 2016 -  jcs - Thi s method i s now also  called to  ensure a  user
  19330    is author ized to de lete a tem plate.
  19331    --------- ---------- ---------- ---------- ---------- ---------- --}
  19332  
  19333   function T frmMain.Is Allowed2Op enExam(anI ENS: Strin g): Boolea n;
  19334   var
  19335     FMGetExa m: TFMGets ;
  19336   begin
  19337     Result : = False;
  19338     FMGetExa m := TFMGe ts.Create( nil);
  19339     FMGetExa m.FileNumb er := '396 .17';
  19340     FMGetExa m.AddField ('2');
  19341     FMGetExa m.AddField ('10');
  19342     FMGetExa m.RPCBroke r := RPCBr oker1;
  19343     FMGetExa m.IENS :=  anIENS;
  19344     try
  19345       try
  19346         FMGe tExam.GetD ata;
  19347         if ( Pos('@', u serfileman code) > 0)  or
  19348           (A uthorIEN =  FMGetExam .GetField( '2').FMDBI nternal) o r
  19349           (A uthorIEN =  FMGetExam .GetField( '10').FMDB Internal)  or
  19350           Is UserKeyInL ist('DVBAB  CPWM REVI EWER,DVBAB  CPWM REVI E') then
  19351           Re sult := Tr ue;
  19352       except
  19353         Show MessageCAP RI('Failed  to retrie ve Author  and Transc riber');
  19354       end;
  19355     finally
  19356       FreeAn dNil(FMGet Exam);
  19357     end;
  19358   end;
  19359  
  19360   {--------- ---------- -- TfrmMai n.IsLocked Date ----- ---------- --
  19361    This func tion check s the DATE /TIME LOCK ED (#5) fi eld of the
  19362    CAPRI TEM PLATES (#3 96.17) fil e for a va lid lock d ate value.
  19363    Returns T rue when v alid; othe rwise retu rns False.
  19364    rpm 1/20/ 09
  19365    --------- ---------- ---------- ---------- ---------- ---------- ---}
  19366  
  19367   function T frmMain.Is LockedDate (anIENS: S tring): Bo olean;
  19368   var
  19369     FMGetExa m: TFMGets ;
  19370     DateTime Locked: St ring;
  19371   begin
  19372     Result : = False;
  19373     FMGetExa m := TFMGe ts.Create( nil);
  19374     FMGetExa m.FileNumb er := '396 .17';
  19375     FMGetExa m.AddField ('5');
  19376     FMGetExa m.RPCBroke r := RPCBr oker1;
  19377     FMGetExa m.IENS :=  anIENS;
  19378     try
  19379       try
  19380         FMGe tExam.GetD ata;
  19381         Date TimeLocked  := FMGetE xam.GetFie ld('5').FM DBExternal ;
  19382         if D ateTimeLoc ked <> ''  then
  19383           if  DateTimeL ocked <> ' JAN 01, 19 80' then
  19384              if DateTim eLocked <>  'JAN 1, 1 980' then
  19385                if DateT imeLocked  <> 'JAN 1, 1980' then
  19386                  Result  := True;
  19387       except
  19388         Show MessageCAP RI('Failed  to retrie ve DATE/TI ME LOCKED' );
  19389       end;
  19390     finally
  19391       FreeAn dNil(FMGet Exam);
  19392     end;
  19393   end;
  19394  
  19395   {========= ========== ========== ========== ========== ========== ========== =========
  19396    GetDivisi on
  19397    This func tion retri eves the d ivision of  the curre ntly conne cted site.   When
  19398    connectin g through  CLAIMS, re trieve the  value sto red in the  User.Divi sion
  19399    property  of RPCBrok er; otherw ise, use r esults of  DVBAB CCOW  RPC ($$SI TE^VASITE) .
  19400  
  19401    Input:
  19402      aRemote Login: Boo lean - TRU E when con nected thr ough CLAIM S; otherwi se FALSE
  19403      aRPCBro ker: TCCOW RPCBrokerC APRI - Bro ker that m akes the R PC call
  19404  
  19405    Output:
  19406      Site di vision str ing IEN^si tename^sta tion# (ex.  '521^BIRM INGHAM VAM C^521') on
  19407      success ; otherwis e return e mpty strin g ('');
  19408  
  19409    rpm 5/12/ 09
  19410    rpm 8/19/ 09 modifie d to add a RPCBroker  param to s upport FHI E BSE conn ection
  19411    ========= ========== ========== ========== ========== ========== ========== =========}
  19412  
  19413   function T frmMain.Ge tDivision( aRemoteLog in: Boolea n;
  19414     aRPCBrok er: TCCOWR PCBrokerCA PRI): Stri ng;
  19415   begin
  19416     Result : = '';
  19417  
  19418     if aRemo teLogin th en                                                                //Remote l ogin (CLAI MS)
  19419       Result  := aRPCBr oker.User. Division
  19420     else                                                                                  //Local lo gin
  19421     begin
  19422       aRPCBr oker.Remot eProcedure  := 'DVBAB  CCOW';
  19423       aRPCBr oker.Param [0].Value  := '1';                                                //get $$SI TE^VASITE  value
  19424       aRPCBr oker.Param [0].PType  := literal ;
  19425       RPCBro kerCall;
  19426       try
  19427         aRPC Broker.Cal l;
  19428       except
  19429         on E BrokerErro r do
  19430         begi n
  19431           AN URemotePro cedureCall InProgress  := False;
  19432           An imateLogo( False);
  19433           St atusBarLoa dPt.Captio n := 'DVBA B CCOW cou ld not be  accessed!' ;
  19434           St atusBarLoa dPt.Repain t;
  19435           Ap plication. Processmes sages;
  19436           Sh owMessageC APRI('DVBA B CCOW cou ld not be  accessed!' );
  19437           Ex it;
  19438         end;
  19439       end;
  19440       if aRP CBroker.Re sults.Coun t > 0 Then
  19441         Resu lt := aRPC Broker.Res ults[0];
  19442     end;
  19443   end;
  19444  
  19445   {========= ========== ========== ========== ========== ========== ========== =========
  19446    GetCountr yName
  19447    Input: aC ountryIEN:  String -  Required p ointer to  COUNTRY CO DE (#779.0 04) file.
  19448    Output: R eturns POS TAL NAME ( #1.3) fiel d or DESCR IPTION (#2 ) field
  19449            i f Postal N ame is '<N ULL>' on s uccess; ot herwise re turns
  19450            e mpty strin g ('').
  19451    rpm 9/21/ 09
  19452    ========= ========== ========== ========== ========== ========== ========== =========}
  19453  
  19454   function T frmMain.Ge tCountryNa me(aCountr yIEN: Stri ng): Strin g;
  19455   var
  19456     aFieldVa l: String;
  19457   begin
  19458     Result : = '';
  19459     if aCoun tryIEN <>  '' then
  19460     begin
  19461       FMGets Country.IE NS := aCou ntryIEN;
  19462       try
  19463         FMGe tsCountry. GetData;
  19464         if F MGetsCount ry.Results .Count > 0  then
  19465         begi n
  19466           aF ieldVal :=  FMGetsCou ntry.GetFi eld('1.3') .FMDBExter nal;
  19467           if  aFieldVal  = '<NULL> ' then
  19468              aFieldVal  := FMGetsC ountry.Get Field('2') .FMDBExter nal;
  19469           Re sult := aF ieldVal;
  19470         end;
  19471       except  on E: Exc eption do
  19472           Sh owMessageC apri('CAPR I failed t o get Coun try name:  ' + E.Mess age);
  19473       end;
  19474     end;
  19475   end;
  19476  
  19477  
  19478   function T frmMain.Ge tCurrentPa tientInfo:  TPatientI nfoBucket;
  19479   var
  19480     tbool: B oolean;
  19481   begin
  19482     if FPati entInfoBuc ket = nil  then
  19483       if Pat ientSSN >  '' then                                                           // CodeCR7 01 rpk 2/3 /2015
  19484       try
  19485   //         FPatientIn foBucket : = TPatient InfoBucket .Create(Pa tientSSN)               // rpk 7 /15/2014
  19486         tboo l := TPati entInfoBuc ket.Create PatientInf oBucket(Pa tientSSN,  FPatientIn foBucket);  // CodeCR 701 rpk 2/ 9/2015
  19487       except                                                                              // CodeCR7 01 rpk 2/9 /2015
  19488         FPat ientInfoBu cket := ni l;                                                     // CodeCR7 01 rpk 2/9 /2015
  19489       end;                                                                                // CodeCR7 01 rpk 2/9 /2015
  19490  
  19491     Result : = FPatient InfoBucket ;
  19492   end;
  19493  
  19494   {========= ========== ========== ========== ========== ========== ========== =========
  19495    GetVersio nUser
  19496    This func tion build s the Vers ionUser va riable fro m the File VersionInf o defined
  19497    using the  Project O ptions Fil eVersion p roperty.
  19498      Input:   None
  19499     Output:   Returns v ersion inf ormation a s string ( ex. 'DVBA* 2.7*149.01 ') on
  19500               success;  otherwise  returns 'D VBA*2.7*xx x.xx'
  19501    rpm 2/4/1 0
  19502    ========= ========== ========== ========== ========== ========== ========== =========}
  19503  
  19504   function T frmMain.Ge tVersionUs er: String ;
  19505   var
  19506     Build, V ersion: St ring;
  19507   begin
  19508     Version  := GetVers ionInfo(Fi leVersion) ;
  19509     if Versi on <> '' t hen
  19510     begin
  19511       Result  := 'DVBA* ';
  19512       Result  := Result  + piece(V ersion, '. ', 1);                                      //Major ve rsion
  19513       Result  := Result  + '.' + p iece(Versi on, '.', 2 );                               //Minor ve rsion
  19514       Result  := Result  + '*' + p iece(Versi on, '.', 3 );                               //Release
  19515       Build  := piece(V ersion, '. ', 4);                                                 //Build
  19516       if Len gth(Build)  < 2 then
  19517         Buil d := '0' +  Build;
  19518       Result  := Result  + '.' + B uild;
  19519     end
  19520     else
  19521       Result  := 'DVBA* 2.7*xxx.xx ';
  19522   end;
  19523  
  19524   {========= ========== ========== ========== ========== ========== ========== =========
  19525     CCOWIcon Setup
  19526       CCOWIc onSetup is  a method  that sets  some butto n visibili ty
  19527  
  19528     Modifica tion Histo ry:
  19529       CodeCR 124 7/2010  Method re factored o ut of actF ileSelectP atientExec ute -MER
  19530    ========= ========== ========== ========== ========== ========== ========== =========}
  19531  
  19532   procedure  TfrmMain.C COWIconSet up;
  19533   begin
  19534     if (CCOW Mode = Tru e) and (bi tbtnCCOWLi nkBroken.V isible = F alse) then  begin
  19535       if CCO WSuspended  <> true t hen
  19536       begin
  19537         bitb tnCCOWLink .Visible : = True;
  19538         BitB tnCCOWLink Broken.Vis ible := Fa lse;
  19539         BitB tnCCOWLink Changing.V isible :=  false;
  19540       end el se begin
  19541         bitb tnCCOWLink .Visible : = False;
  19542         BitB tnCCOWLink Broken.Vis ible := Tr ue;
  19543         BitB tnCCOWLink Changing.V isible :=  False;
  19544       end;
  19545     end;
  19546   end;
  19547  
  19548   {========= ========== ========== ========== ========== ========== ========== =========
  19549     UpdateAu ditOnHomeS erver
  19550       Update AuditOnHom eServer is  a method  that updat es the aud it trail.   It then
  19551       reconn ects to th e original  server.
  19552  
  19553     Modifica tion Histo ry:
  19554       CodeCR 124 7/2010  Method re factored o ut of actF ileSelectP atientExec ute -MER
  19555    ========= ========== ========== ========== ========== ========== ========== =========}
  19556  
  19557   procedure  TfrmMain.U pdateAudit OnHomeServ er;
  19558   var
  19559     tempstrs erver, tem pstrport:  string;
  19560     dttm: st ring;
  19561     zUserDiv ision: str ing;
  19562   begin
  19563     if (ESSO Version =  true) then  begin
  19564       TempSt rServer :=  Uppercase (RPCBroker 1.ANUStrSe rver);
  19565       TempSt rPort := R PCBroker1. ANUStrPort ;
  19566       AuditI nProgress  := True;
  19567       RPCBro ker1.Conne cted := Fa lse;
  19568       RPCBro ker1.Serve r := RPCBr oker1.ANUS trServerHo me;
  19569       RPCBro ker1.Liste nerPort :=  StrtoInt( RPCBroker1 .ANUStrPor tHome);
  19570       if not  ConnectTo Server('DV BA CAPRI G UI') then  begin
  19571         Show MessageCAP RI('Could  not use op tion "DVBA  CAPRI GUI !"');
  19572         appl ication.te rminate;
  19573       end;
  19574       //Do u pdate here ...
  19575       FMVali dator1.Set up('395.98 ', '+1,',  '5', 'NOW' );
  19576       if Not  frmMain.F MValidator 1.Validate  then begi n
  19577         FMVa lidator1.D isplayErro rs;
  19578         Show MessageCAP RI('There  was an err or creatin g an audit  trail.  C APRI will  now close. ');
  19579         appl ication.te rminate;
  19580       end;                                                                                {file}
  19581       dttm : = fmvalida tor1.Resul ts[0];
  19582  
  19583       zUserD ivision :=  Copy(User Division,  1, 30);                                     // Limit t o 30 chars
  19584  
  19585       if Pat ientname =  '' then
  19586         pati entName :=  'UNKNOWN' ;
  19587  
  19588       FMVali dator1.Set up('395.98 ', '+1,',  '4', Remot eSiteName) ;
  19589       //FMVa lidatr1.Se tup('395.9 8','+1,',' 4.5',Remot eSiteNameP ointer);
  19590       FMVali dator1.Set up('395.98 ', '+1,',  '.01', '`'  + UserDUZ HomeServer );
  19591       FMVali dator1.Set up('395.98 ', '+1,',  '1', Patie ntName);
  19592       FMVali dator1.Set up('395.98 ', '+1,',  '3', Patie ntSSN);
  19593       FMVali dator1.Set up('395.98 ', '+1,',  '2', Patie ntICN);
  19594       FMVali dator1.Set up('395.98 ', '+1,',  '6', Patie ntSensitiv e);
  19595       FMVali dator1.Set up('395.98 ', '+1,',  '7', Patie ntClaimNum ber);
  19596       FMVali dator1.Set up('395.98 ', '+1,',  '8', zUser Division);
  19597       if not  frmMain.F MValidator 1.Validate  then begi n
  19598         FMVa lidator1.D isplayErro rs;
  19599         Show MessageCAP RI('There  was an err or creatin g an audit  trail.  C APRI will  now close. ');
  19600         appl ication.te rminate;
  19601       end;
  19602  
  19603       fmfile r2.AddFDA( '395.98',  '+1,', '.0 1', UserDU ZHomeServe r);
  19604       fmfile r2.AddFDA( '395.98',  '+1,', '4' , RemoteSi teName);
  19605       //fmfi ler2.AddFD A('395.98' ,'+1,','4. 5',RemoteS iteNamePoi nter);
  19606       fmfile r2.AddFDA( '395.98',  '+1,', '5' , dttm);
  19607       fmfile r2.AddFDA( '395.98',  '+1,', '1' , PatientN ame);
  19608       fmfile r2.AddFDA( '395.98',  '+1,', '3' , PatientS SN);
  19609       fmfile r2.AddFDA( '395.98',  '+1,', '2' , PatientI CN);
  19610       fmfile r2.AddFDA( '395.98',  '+1,', '6' , PatientS ensitive);
  19611       fmfile r2.AddFDA( '395.98',  '+1,', '7' , PatientC laimNumber );
  19612       fmfile r2.AddFDA( '395.98',  '+1,', '8' , zUserDiv ision);
  19613       if Not  fmfiler2. Update the n begin
  19614         fmfi ler2.Displ ayErrors;
  19615         Show MessageCAP RI('There  was an err or creatin g an audit  trail.  C APRI will  now close. ');
  19616         appl ication.te rminate;
  19617       end;
  19618  
  19619       //Conn ect back t o remote h ere
  19620       RPCBro ker1.Conne cted := Fa lse;
  19621       RPCBro ker1.Serve r := TempS trServer;
  19622       RPCBro ker1.Liste nerPort :=  StrToInt( TempStrPor t);
  19623       //RPCB roker1.Con nected :=  True;   BS E mod - rp m 1/8/09
  19624       AuditI nProgress  := False;
  19625       //if n ot Authori zedOption( 'DVBA CAPR I GUI') th en   BSE m od - rpm 1 /8/09
  19626       if not  ConnectTo Server('DV BA CAPRI G UI') then  begin
  19627         Show MessageCAP RI('Could  not use op tion "DVBA  CAPRI GUI !"');
  19628         appl ication.te rminate;
  19629       end;
  19630     end;
  19631   end;                                                                                    // UpdateA uditOnHome Server
  19632  
  19633   {========= ========== ========== ========== ========== ========== ========== =========
  19634     ShowPati entList
  19635       ShowPa tientList  is a metho d that wil l show a p atient loo kup form.   This
  19636       method  was refac tored out  of actFile SelectPati entExecute  to add th e
  19637       capabi lity to fi lter on th e patient  lookup for m.
  19638  
  19639     Paramete rs:
  19640       Sender :
  19641         Send er is a TO bject used  to help i dentify fr om where t his method  was calle d
  19642       Patien tFilterTyp e:
  19643         TPat ientFilter Type is an  enumerate d type tha t represen ts Normal  (no filter ing),
  19644         Fee  Basis or D OD only.   It is used  to specif y what typ e of filte ring shoul d
  19645         be e mployed by  frmPatien tList
  19646  
  19647     Modifica tion Histo ry:
  19648       7/2010  Method cr eated -MER
  19649    ========= ========== ========== ========== ========== ========== ========== =========}
  19650  
  19651   procedure  TfrmMain.S howPatient List(Sende r: TObject ; PatientF ilterType:  TPatientF ilterType) ;
  19652   var
  19653     lastIEN:  String;
  19654     data: IC ontextItem Collection ;
  19655     dataItem 1, dataIte m2, datait em3: ICont extItem;
  19656     response : UserResp onse;
  19657     inWidth,  inHeight:  integer;
  19658     minwidth , minheigh t: integer ;
  19659     isshowin g: boolean ;
  19660     x, y: in teger;
  19661     foundfla g: boolean ;
  19662     tempstrs erver: Str ing;
  19663     tempstrp ort: Strin g;
  19664     tempstri ng: String ;
  19665   Begin
  19666     inHeight  := 50;
  19667     inWidth  := 50;
  19668     isshowin g := False ;
  19669     minheigh t := 50;
  19670     minwidth  := 50;
  19671     If Assig ned(formTI UDisplay)  Then
  19672     Begin
  19673       formTI UDisplay.V isible :=  False;
  19674       formTI UDisplay.R elease;
  19675       formTI UDisplay : = Nil;
  19676     End;
  19677  
  19678     If Assig ned(frmSpl ashScreen)  Then
  19679     Begin
  19680       frmSpl ashScreen. Hide;
  19681       frmSpl ashScreen. release;
  19682       frmSpl ashScreen  := Nil;
  19683     End;
  19684  
  19685     If ANURe moteProced ureCallInP rogress =  True Then
  19686       exit;
  19687  
  19688     DimMenuO ptions;                                                                      // everyth ing is com mented out  in this m ethod
  19689     If essov ersion = t rue Then
  19690       If Swi tchToPatie ntSSN = ''  Then
  19691       Begin
  19692         // M ake sure u ser can be  on curren t site bef ore select ing a new
  19693         // p atient
  19694         // B ut don't e xecute thi s if somet hing is in  SwitchToP atientSSN
  19695         // b ecause the  patient w ill be for ced.
  19696         foun dflag := f alse;
  19697         If f ormESSOSel ect = Nil  Then
  19698         Begi n
  19699           fo rmESSOSele ct := Tfor mESSOSelec t.Create(f rmMain);
  19700           Ho meServer : = RPCBroke r1.Server;
  19701           Ho mePort :=  InttoStr(R PCBroker1. ListenerPo rt);
  19702         End;
  19703         If f ormESSOSel ect.slUser Sites.Coun t > 0 Then                                  //CodeCR77
  19704           Fo r x := 0 T o formESSO Select.slU serSites.C ount - 1 D o
  19705              If upperca se(piece(f ormESSOSel ect.slUser Sites[x],  '^', 2)) =  uppercase (RPCBroker 1.Server)  Then
  19706                foundfla g := true;
  19707         If f oundflag < > true The n
  19708         Begi n
  19709           Sh owmessageC APRI('You  do not hav e direct a ccess to t his site.   Please us e FILE | S WITCH SITE S and pick  a differe nt site pr ior to sel ecting a p atient.');
  19710           Re storeMenuO ptions;
  19711           ex it;
  19712         End;
  19713       End;
  19714     If frmMa in.RPCBrok er1.Connec ted = Fals e Then
  19715     Begin
  19716       //frmM ain.button 3click(app lication);
  19717       Restor eMenuOptio ns;
  19718       exit;
  19719     End;
  19720     lastIEN  := Patient IEN;
  19721     // Check  if user h as restric ted list,  if so, use r other wi ndow.
  19722     If EssoV ersion = T rue Then
  19723       If (Us erHasNewSt yleRestric tedList =  -1) Then
  19724       Begin
  19725         ////  connect t o claims s erver
  19726         time outtimer.e nabled :=  false;
  19727         ESSO Connecting  := True;
  19728         //St ore connec tion data
  19729         Temp StrServer  := RPCBrok er1.Server ;
  19730         Temp StrPort :=  IntToStr( RPCBroker1 .ListenerP ort);
  19731         RPCB roker1.Con nected :=  False;
  19732         RPCB roker1.Ser ver := hom eserver;
  19733         RPCB roker1.Lis tenerPort  := StrToIn t(homeport );
  19734         //RP CBroker1.C onnected : = True;  B SE mod - r pm 1/8/09
  19735         If N ot Connect ToServer(' DVBA CAPRI  GUI') The n
  19736         Begi n
  19737           Sh owMessageC APRI('Coul d not use  option "DV BA CAPRI G UI!"');
  19738           ap plication. terminate;
  19739         End;
  19740         If R PCBroker1. Connected  = False Th en
  19741         Begi n
  19742           Sh owMessageC APRI('Coul d not use  option "DV BA CAPRI G UI!"');
  19743           ap plication. terminate;
  19744         End;
  19745         ESSO Connecting  := False;
  19746         ///  end of con nect to cl aims serve r
  19747  
  19748         //re trieve lis t of restr icted pati ents for C APRI when  in remote  mode
  19749         List BoxRestric tedPatient s.Items.Cl ear;
  19750         frmM ain.RPCBro ker1.Resul ts.Clear;
  19751         RPCB roker1.Rem oteProcedu re := 'DVB AB RESTRIC TED LIST P ATIENTS';
  19752         RPCB roker1.Par am[0].Valu e := UserD UZHomeServ er;
  19753         RPCB roker1.Par am[0].PTyp e := liter al;
  19754         RPCB rokerCall;
  19755         Try
  19756           RP CBroker1.C all;
  19757         Exce pt
  19758           On  EBrokerEr ror Do
  19759           Be gin
  19760              //if user' s restrict ed patient  list can' t be acces sed on Cla ims system , instruct  user to c ontact HIA  office fo r
  19761              //assistan ce and shu t down app lication t o prevent  user from  accessing  unauthoriz ed patient  records -  kcl 2/5/0 9
  19762              ANURemoteP rocedureCa llInProgre ss := Fals e;
  19763              AnimateLog o(False);
  19764              StatusBarL oadPt.Capt ion := 'Re stricted p atient lis t could no t be acces sed!';
  19765              StatusBarL oadPt.Repa int;
  19766              Applicatio n.Processm essages;
  19767              ShowMessag eCAPRI('WA RNING: Una ble to acc ess the us er''s rest ricted pat ient list! '
  19768                + #13#10  + #13#10
  19769                + 'The C APRI appli cation wil l be shut  down to pr event acce ss of unau thorized r ecords.'
  19770                + #13#10
  19771                  + 'Please  contact th e VHA Heal th Informa tion Acces s Office f or assista nce (Email P I        ).');
  19772              Applicatio n.Terminat e;
  19773           En d;
  19774         End;
  19775  
  19776         If r pcbroker1. results.co unt = 0 Th en
  19777           Us erHasNewSt yleRestric tedList :=  0;
  19778         If r pcbroker1. results.co unt > 0 Th en
  19779           Us erHasNewSt yleRestric tedList :=  1;
  19780         If R PCBroker1. Results.Co unt > 0 Th en
  19781           Qu ickCopy(fr mMain.RPCB roker1.Res ults, list BoxRestric tedPatient s);
  19782  
  19783         // c onnect bac k to remot e server
  19784         Cont extorChang eMessage : = '';
  19785         CCOW BreakLink  := False;
  19786         ESSO Connecting  := True;
  19787         //Re connect to  original  host
  19788         RPCB roker1.Con nected :=  False;
  19789         RPCB roker1.Ser ver := Tem pStrServer ;
  19790         RPCB roker1.Lis tenerPort  := StrToIn t(TempStrP ort);
  19791         //RP CBroker1.C onnected : = True;  B SE mod - r pm 1/8/09
  19792         If N ot Connect ToServer(' DVBA CAPRI  GUI') The n
  19793         Begi n
  19794           Sh owMessageC APRI('Coul d not use  option "DV BA CAPRI G UI!"');
  19795           ap plication. terminate;
  19796         End;
  19797         If R PCBroker1. Connected  = False Th en
  19798         Begi n
  19799           Sh owMessageC APRI('Coul d not use  option "DV BA CAPRI G UI!"');
  19800           ap plication. terminate;
  19801         End;
  19802         ESSO Connecting  := False;
  19803         time outtimer.e nabled :=  true;
  19804         // d one with c onnect
  19805       End;
  19806     frmPatie ntList :=  TfrmPatien tList.Crea te(frmMain );
  19807     frmPatie ntList.Pat ientFilter Type := Pa tientFilte rType;                           //CodeCR12 4 -MER 07/ 2010
  19808     if (Pati entFilterT ype = pfDo d) then                                                //CodeCR13 1 rpm 12/8 /10
  19809       frmPat ientList.B HIEInstitu tionIEN :=  GetBHIEIn stitutionI EN;
  19810     frmPatie ntListRest ricted :=  TfrmPatien tListRestr icted.Crea te(frmMain );
  19811  
  19812     //frmPat ientList.S how;
  19813     // Set u p for font
  19814     frmPatie ntList.FMC vrNamePt.F ont := Pan el1.Font;
  19815     frmPatie ntList.Lab elCvrSSN.f ont := Pan el1.Font;
  19816     frmPatie ntList.FMC vrSSNPt.fo nt := Pane l1.Font;
  19817     frmPatie ntList.FMC vrSexPt.fo nt := Pane l1.Font;
  19818     frmPatie ntList.FMC vrAgePt.fo nt := Pane l1.Font;
  19819     frmPatie ntList.FMC vrRoomBedP t.font :=  Panel1.Fon t;
  19820     frmPatie ntList.FMC vrBirthdat ePt.font : = Panel1.F ont;
  19821     frmPatie ntList.FMC vrWardPt.f ont := Pan el1.Font;
  19822     frmPatie ntList.Lab elCvrCNumb erPt.font  := Panel1. Font;
  19823     frmPatie ntList.FMC vrCNumberP t.font :=  Panel1.Fon t;
  19824     frmPatie ntList.Lab elCvrICNPt .font := P anel1.Font ;
  19825     frmPatie ntList.Lab elCvrWard. font := Pa nel1.Font;
  19826     frmPatie ntList.FMC vrICNPt.fo nt := Pane l1.Font;
  19827  
  19828     frmPatie ntList.Gro upBoxCvr1P t.Font :=  Panel1.Fon t;
  19829     frmPatie ntList.Scr ollBox1.To p := Panel 1.Height;
  19830     //frmPat ientList.F MCvrNamePt .top:=Pane l1.Height  div 2;
  19831     frmPatie ntList.Lab elCvrSSN.t op := frmP atientList .FMCvrName Pt.top + f rmPatientL ist.FMCvrN amePt.heig ht;
  19832     frmPatie ntList.FMC vrSSNPt.to p := frmPa tientList. FMCvrNameP t.top + fr mPatientLi st.FMCvrNa mePt.heigh t;
  19833     frmPatie ntList.FMC vrSexPt.to p := frmPa tientList. LabelCvrSS N.top + fr mPatientLi st.LabelCv rSSN.heigh t;
  19834     frmPatie ntList.FMC vrAgePt.to p := frmPa tientList. FMCvrSexPt .top + frm PatientLis t.FMCvrSex Pt.height;
  19835     frmPatie ntList.FMC vrBirthdat ePt.top :=  frmPatien tList.FMCv rAgePt.top  + frmPati entList.FM CvrAgePt.h eight;
  19836     frmPatie ntList.Lab elCvrWard. top := frm PatientLis t.FMCvrBir thdatePt.t op + frmPa tientList. FMCvrBirth datePt.hei ght;
  19837     frmPatie ntList.FMC vrWardPt.t op := frmP atientList .FMCvrBirt hdatePt.to p + frmPat ientList.F MCvrBirthd atePt.heig ht;
  19838     frmPatie ntList.FMC vrRoomBedP t.top := f rmPatientL ist.FMCvrB irthdatePt .top + frm PatientLis t.FMCvrBir thdatePt.h eight;
  19839     frmPatie ntList.Lab elCvrCNumb erPt.top : = frmPatie ntList.FMC vrWardPt.t op + frmPa tientList. FMCvrWardP t.height;
  19840     frmPatie ntList.FMC vrCNumberP t.top := f rmPatientL ist.FMCvrW ardPt.top  + frmPatie ntList.FMC vrWardPt.h eight;
  19841     frmPatie ntList.Lab elCvrICNPt .top := fr mPatientLi st.FMCvrCN umberPt.to p + frmPat ientList.F MCvrCNumbe rPt.height ;
  19842     frmPatie ntList.FMC vrICNPt.to p := frmPa tientList. FMCvrCNumb erPt.top +  frmPatien tList.FMCv rCNumberPt .height;
  19843  
  19844     frmPatie ntList.fon t := Panel 1.Font;
  19845     frmPatie ntList.btn CvrMorePt. height :=  Panel1.Hei ght;
  19846     frmPatie ntList.btn CvrMorePt. top := frm PatientLis t.Height -  frmPatien tList.btnC vrMorePt.H eight - 33 ;
  19847     frmPatie ntList.btn CvrDemogra phicsPt.To p := frmPa tientList. btnCvrMore Pt.Top;
  19848     frmPatie ntList.btn CvrDemogra phicsPt.He ight := fr mPatientLi st.btnCvrM orePt.heig ht;
  19849     frmPatie ntList.btn CvrCancelP t.height : = Panel1.H eight;
  19850     frmPatie ntList.btn CvrCancelP t.Top := f rmPatientL ist.Height  - frmPati entList.bt nCvrCancel Pt.Height  - 33;
  19851  
  19852     frmPatie ntList.btn Search.hei ght := Pan el1.Height ;
  19853     frmPatie ntList.btn Search.Top  := frmPat ientList.H eight - fr mPatientLi st.btnCvrC ancelPt.He ight - 33;
  19854  
  19855     frmPatie ntList.btn CvrSelectP t.height : = Panel1.H eight;
  19856     frmPatie ntList.btn CvrSelectP t.top := f rmPatientL ist.Height  - frmPati entList.bt nCvrSelect Pt.Height  - 33;
  19857     frmPatie ntList.btn CvrEnterNe wPt.height  := Panel1 .Height;
  19858     frmPatie ntList.btn CvrEnterNe wPt.Top :=  frmPatien tList.btnC vrSelectPt .Top - frm PatientLis t.btnCvrEn terNewPt.H eight + 1;
  19859     frmPatie ntList.btn Search.hei ght := Pan el1.Height ;
  19860     frmPatie ntList.btn Search.Top  := frmPat ientList.H eight - fr mPatientLi st.btnCvrC ancelPt.He ight - 33;
  19861     frmPatie ntList.but tonedit.he ight := Pa nel1.Heigh t;
  19862     frmPatie ntList.but tonedit.To p := frmPa tientList. btnCvrSele ctPt.Top -  frmPatien tList.butt onedit.Hei ght + 1;
  19863     frmPatie ntList.FMC vrListBox1 Pt.top :=  frmPatient List.Patie nt_ID.Top  + frmPatie ntList.Pat ient_ID.He ight + 4;
  19864     frmPatie ntList.FMC vrListBox2 Pt.top :=  frmPatient List.Patie nt_ID.Top  + frmPatie ntList.Pat ient_ID.He ight + 4;
  19865     frmPatie ntList.FMC vrListBox3 Pt.top :=  frmPatient List.Patie nt_ID.Top  + frmPatie ntList.Pat ient_ID.He ight + 4;
  19866     frmPatie ntList.FMC vrListBox1 Pt.height  := frmPati entList.He ight - frm PatientLis t.btnCvrMo rePt.Heigh t - 33 - f rmPatientL ist.FMCvrL istBox1Pt. top;
  19867     frmPatie ntList.FMC vrListBox2 Pt.height  := frmPati entList.He ight - frm PatientLis t.btnCvrMo rePt.Heigh t - 33 - f rmPatientL ist.FMCvrL istBox2Pt. top;
  19868     frmPatie ntList.FMC vrListBox3 Pt.height  := frmPati entList.He ight - frm PatientLis t.btnCvrMo rePt.Heigh t - 33 - f rmPatientL ist.FMCvrL istBox3Pt. top;
  19869     frmPatie ntList.btn CvrTimerPt .Interval  := frmProp erties.Scr ollBarKeyb oardSensit ivity.Posi tion;
  19870     frmPatie ntList.but tonOtherSi tes.Top :=  frmPatien tList.grou pBoxCVR1Pt .Top + frm PatientLis t.groupBox CVR1Pt.Hei ght + 4;
  19871     // Set u p for font
  19872     frmPatie ntListRest ricted.FMC vrNamePt.F ont := Pan el1.Font;
  19873     frmPatie ntListRest ricted.Lab elCvrSSN.f ont := Pan el1.Font;
  19874     frmPatie ntListRest ricted.FMC vrSSNPt.fo nt := Pane l1.Font;
  19875     frmPatie ntListRest ricted.FMC vrSexPt.fo nt := Pane l1.Font;
  19876     frmPatie ntListRest ricted.FMC vrAgePt.fo nt := Pane l1.Font;
  19877     frmPatie ntListRest ricted.FMC vrRoomBedP t.font :=  Panel1.Fon t;
  19878     frmPatie ntListRest ricted.FMC vrBirthdat ePt.font : = Panel1.F ont;
  19879     frmPatie ntListRest ricted.FMC vrWardPt.f ont := Pan el1.Font;
  19880     frmPatie ntListRest ricted.Lab elCvrCNumb erPt.font  := Panel1. Font;
  19881     frmPatie ntListRest ricted.FMC vrCNumberP t.font :=  Panel1.Fon t;
  19882     frmPatie ntListRest ricted.Lab elCvrICNPt .font := P anel1.Font ;
  19883     frmPatie ntListRest ricted.Lab elCvrWard. font := Pa nel1.Font;
  19884     frmPatie ntListRest ricted.FMC vrICNPt.fo nt := Pane l1.Font;
  19885  
  19886     frmPatie ntListRest ricted.Gro upBoxCvr1P t.Font :=  Panel1.Fon t;
  19887     frmPatie ntListRest ricted.Scr ollBox1.To p := Panel 1.Height;
  19888     //frmPat ientListRe stricted.F MCvrNamePt .top:=Pane l1.Height  div 2;
  19889     frmPatie ntListRest ricted.Lab elCvrSSN.t op := frmP atientList Restricted .FMCvrName Pt.top + f rmPatientL istRestric ted.FMCvrN amePt.heig ht;
  19890     frmPatie ntListRest ricted.FMC vrSSNPt.to p := frmPa tientListR estricted. FMCvrNameP t.top + fr mPatientLi stRestrict ed.FMCvrNa mePt.heigh t;
  19891     frmPatie ntListRest ricted.FMC vrSexPt.to p := frmPa tientListR estricted. LabelCvrSS N.top + fr mPatientLi stRestrict ed.LabelCv rSSN.heigh t;
  19892     frmPatie ntListRest ricted.FMC vrAgePt.to p := frmPa tientListR estricted. FMCvrSexPt .top + frm PatientLis tRestricte d.FMCvrSex Pt.height;
  19893     frmPatie ntListRest ricted.FMC vrBirthdat ePt.top :=  frmPatien tListRestr icted.FMCv rAgePt.top  + frmPati entListRes tricted.FM CvrAgePt.h eight;
  19894     frmPatie ntListRest ricted.Lab elCvrWard. top := frm PatientLis tRestricte d.FMCvrBir thdatePt.t op + frmPa tientListR estricted. FMCvrBirth datePt.hei ght;
  19895     frmPatie ntListRest ricted.FMC vrWardPt.t op := frmP atientList Restricted .FMCvrBirt hdatePt.to p + frmPat ientListRe stricted.F MCvrBirthd atePt.heig ht;
  19896     frmPatie ntListRest ricted.FMC vrRoomBedP t.top := f rmPatientL istRestric ted.FMCvrB irthdatePt .top + frm PatientLis tRestricte d.FMCvrBir thdatePt.h eight;
  19897     frmPatie ntListRest ricted.Lab elCvrCNumb erPt.top : = frmPatie ntListRest ricted.FMC vrWardPt.t op + frmPa tientListR estricted. FMCvrWardP t.height;
  19898     frmPatie ntListRest ricted.FMC vrCNumberP t.top := f rmPatientL istRestric ted.FMCvrW ardPt.top  + frmPatie ntListRest ricted.FMC vrWardPt.h eight;
  19899     frmPatie ntListRest ricted.Lab elCvrICNPt .top := fr mPatientLi stRestrict ed.FMCvrCN umberPt.to p + frmPat ientListRe stricted.F MCvrCNumbe rPt.height ;
  19900     frmPatie ntListRest ricted.FMC vrICNPt.to p := frmPa tientListR estricted. FMCvrCNumb erPt.top +  frmPatien tListRestr icted.FMCv rCNumberPt .height;
  19901  
  19902     frmPatie ntListRest ricted.fon t := Panel 1.Font;
  19903     frmPatie ntListRest ricted.btn CvrCancelP t.height : = Panel1.H eight;
  19904     frmPatie ntListRest ricted.btn CvrCancelP t.Top := f rmPatientL istRestric ted.Height  - frmPati entListRes tricted.bt nCvrCancel Pt.Height  - 33 - 4;
  19905     frmPatie ntListRest ricted.btn CvrSelectP t.height : = Panel1.H eight;
  19906     frmPatie ntListRest ricted.btn CvrSelectP t.top := f rmPatientL istRestric ted.Height  - frmPati entListRes tricted.bt nCvrSelect Pt.Height  - 33 - 4;
  19907     frmPatie ntListRest ricted.ORL istBox1.to p := frmPa tientListR estricted. ComboBoxLi stNames.To p + frmPat ientListRe stricted.C omboBoxLis tNames.Hei ght + 4;
  19908     frmPatie ntListRest ricted.ORL istBox1.he ight := fr mPatientLi stRestrict ed.Height  - 33 - frm PatientLis tRestricte d.ORListBo x1.top - 4 ;
  19909     frmPatie ntListRest ricted.but tonOtherSi tes.Top :=  frmPatien tListRestr icted.grou pBoxCVR1Pt .Top + frm PatientLis tRestricte d.groupBox CVR1Pt.Hei ght + 4;
  19910     frmPatie ntListRest ricted.btn Search.hei ght := Pan el1.Height ;
  19911     frmPatie ntListRest ricted.btn Search.Top  := frmPat ientListRe stricted.H eight - fr mPatientLi stRestrict ed.btnCvrC ancelPt.He ight - 33  - 4;
  19912  
  19913     // ListR estrictedP atients.Co unt=0 then
  19914     //   frm PatientLis t.Height:= 288 else
  19915     //   frm PatientLis t.Height:= 386;
  19916  
  19917     // This  code deali ng with Fo rmReportBu ilder is h ere becaus e it has t o do with
  19918     // preve nting CAPR I from com ing to the  front whe n a patien t is chang ed using
  19919     // CCOW
  19920     If FormR eportBuild er <> Nil  Then
  19921     Try
  19922       inWidt h := formR eportBuild er.width;
  19923       inHeig ht := form ReportBuil der.height ;
  19924       minwid th := form ReportBuil der.constr aints.minw idth;
  19925       minhei ght := for mReportBui lder.const raints.min height;
  19926       formRe portBuilde r.constrai nts.minwid th := 0;
  19927       formRe portBuilde r.constrai nts.minhei ght := 0;
  19928       formRe portBuilde r.width :=  0;
  19929       formRe portBuilde r.height : = 0;
  19930       isshow ing := for mReportBui lder.visib le;
  19931       formre portbuilde r.borderSt yle := bsN one;
  19932       formre portbuilde r.visible  := true;
  19933     Except
  19934     End;
  19935     StatusBa rLoadPt.Ca ption := ' Ready.';
  19936  
  19937     If ((Use rHasNewSty leRestrict edList = 1 ) And (sen der <> con textorCont rol) And ( sender <>  frmPatient ListRestri cted.Butto nOtherSite s)) Then
  19938     Begin
  19939       frmPat ientListRe stricted.C omboBoxLis tNames.Cle ar;
  19940       frmPat ientListRe stricted.C omboBoxLis tNames.Ite ms.Add('Pe rsonal Lis t');
  19941       For x  := 0 To Li stBoxRestr ictedPatie nts.Items. Count - 1  Do
  19942       Begin
  19943         temp String :=  piece(List BoxRestric tedPatient s.Items[x] , '^', 1);
  19944         foun dflag := f alse;
  19945         If t empstring  <> '' Then
  19946         Begi n
  19947           Fo r y := 0 T o frmPatie ntListRest ricted.Com boBoxListN ames.Items .Count - 1  Do
  19948              If frmPati entListRes tricted.Co mboBoxList Names.Item s[y] = tem pstring Th en
  19949                foundfla g := true;
  19950           If  foundflag  = false T hen
  19951              frmPatient ListRestri cted.Combo BoxListNam es.Items.A dd(tempStr ing);
  19952         End;
  19953       End;
  19954       frmPat ientListRe stricted.C omboBoxLis tNames.Ite mIndex :=  0;
  19955       frmPat ientListRe stricted.C omboBoxLis tNamesChan ge(Applica tion);
  19956       frmPat ientListRe stricted.S how;
  19957       frmPat ientListRe stricted.B ringToFron t;
  19958       frmPat ientListRe stricted.H ide;
  19959     End
  19960     Else
  19961     Begin
  19962       If (se nder <> co ntextorCon trol) And  (sender <>  actFileSw itchSites)  Then
  19963       Begin
  19964         frmP atientList .Show;
  19965         frmP atientList .BringToFr ont;
  19966         frmP atientList .Hide;
  19967       End;
  19968     End;
  19969     //showme ssage(send er.classna me);
  19970     If (((Us erHasNewSt yleRestric tedList <  1) Or (sen der = cont extorContr ol) Or (se nder = act FileSwitch Sites)) An d (UserHas NewStyleRe strictedLi st < 1)) T hen
  19971     Begin
  19972       frmPat ientList.B ringToFron t;
  19973       frmPat ientList.V isible :=  True;
  19974       frmPat ientList.V isible :=  False;
  19975       frmPat ientList.S howModal
  19976     End
  19977     Else
  19978     Begin
  19979       frmPat ientListRe stricted.B ringToFron t;
  19980       frmPat ientListRe stricted.V isible :=  True;
  19981       frmPat ientListRe stricted.V isible :=  False;
  19982       frmPat ientListRe stricted.S howModal;
  19983     End;
  19984     frmMain. btnVistAWe bHomeClick (applicati on);
  19985  
  19986     CCOWIcon Setup;
  19987     Contexto rChangeMes sage := 'T he applica tion is ch anging pat ients.  If  you conti nue, CAPRI  may drop  out of the  clinical  context.';
  19988     CCOWBrea kLink := T rue;
  19989     If FormR eportBuild er <> Nil  Then
  19990     Try
  19991       formRe portBuilde r.visible  := isshowi ng;
  19992       formre portbuilde r.borderSt yle := bsS izeable;
  19993       formRe portBuilde r.constrai nts.minwid th := minh eight;
  19994       formRe portBuilde r.constrai nts.minhei ght := min width;
  19995       formRe portBuilde r.width :=  inWidth;
  19996       formRe portBuilde r.height : = inHeight ;
  19997     Except
  19998     End;
  19999     (*
  20000         If ( (CCOWMode= True) and  (ESSOVersi on=False))  then
  20001           If  CCOWIniti alized=Fal se then be gin
  20002              frmmain.ac tive:=fals e;
  20003           en d;
  20004     *)
  20005         // A nother sit e was sele cted
  20006  
  20007     If Switc hToSite <>  '' Then
  20008     Begin
  20009       animat elogo(fals e);
  20010       frmPat ientList.r elease;
  20011       frmPat ientList : = Nil;
  20012       frmPat ientListRe stricted.r elease;
  20013       frmPat ientListRe stricted : = Nil;
  20014  
  20015       actFil eConnectEx ecute(actF ileSwitchS ites);
  20016  
  20017       CCOWIc onSetup;
  20018       Contex torChangeM essage :=  '';
  20019       CCOWBr eakLink :=  False;
  20020       Restor eMenuOptio ns;
  20021       Exit;
  20022     End;
  20023     // Patie nt is chan ging.  Sen d CCOW mes sage here
  20024  
  20025     // Get r id of last  report bu ilder form
  20026     // for C COW compat ibility is sues with  frmMain co ming to fr ont during
  20027     // a pat ient conte xt change
  20028     If FormR eportBuild er <> Nil  Then
  20029     Try
  20030       formRe portBuilde r.release;
  20031       formRe portBuilde r := Nil;
  20032     Except
  20033     End;
  20034     If (Pati entIEN <>  '') And (P atientIEN  <> lastIEN ) And (Pat ientIEN <>  '-1') The n
  20035     Begin
  20036       If ESS OVersion =  True Then
  20037       Begin
  20038         If ( (UserHasNe wStyleRest rictedList  < 1) Or ( sender = c ontextorCo ntrol) Or  (sender =  actFileSwi tchSites))  Then
  20039         Begi n
  20040           If  frmPatien tList.Butt onOtherSit es.Enabled  = True Th en
  20041              ButtonOthe rSites.Ena bled := Tr ue
  20042         End
  20043         Else
  20044         Begi n
  20045           If  frmPatien tListRestr icted.Butt onOtherSit es.Enabled  = True Th en
  20046              ButtonOthe rSites.Ena bled := Tr ue
  20047         End;
  20048       End;
  20049  
  20050       If frm Main.bitbt nCCOWLinkB roken.Visi ble = Fals e Then
  20051         If C COWMode =  True Then
  20052           If  CCOWIniti alized = T rue Then
  20053           Tr y
  20054              Begin
  20055                Contexto rControl.S tartContex tChange;
  20056                data :=  CoContextI temCollect ion.Create ;
  20057                dataItem 1 := CoCon textItem.C reate;
  20058                dataItem 1.Name :=  'Patient.I D.MRN.DFN_ ' + LocalS tationNumb er;        // can als o use Set_ Name
  20059                dataItem 1.Value :=  PatientIE N;                                          // can als o use Set_ Value
  20060                data.Add (dataItem1 );
  20061                dataItem 2 := CoCon textItem.C reate;
  20062                dataItem 2.Set_Name ('Patient. co.Patient Name');
  20063                If ((Use rHasNewSty leRestrict edList < 1 ) Or (send er = conte xtorContro l) Or (sen der = actF ileSwitchS ites)) The n
  20064                  dataIt em2.Set_Va lue(frmPat ientList.F MCvrNamePt .Caption)
  20065                Else
  20066                  dataIt em2.Set_Va lue(frmPat ientListRe stricted.F MCvrNamePt .Caption);
  20067                data.Add (dataItem2 );
  20068                dataItem 3 := CoCon textItem.C reate;
  20069                dataItem 3.Set_Name ('Patient. ID.MRN.Nat ionalIDNum ber');
  20070                If ((Use rHasNewSty leRestrict edList < 1 ) Or (send er = conte xtorContro l) Or (sen der = actF ileSwitchS ites)) The n
  20071                  dataIt em3.Set_Va lue(frmPat ientList.F MCvrICNPt. Caption)
  20072                Else
  20073                  dataIt em3.Set_Va lue(frmPat ientListRe stricted.F MCvrICNPt. Caption);
  20074                data.Add (dataItem3 );
  20075                response  := Contex torControl .EndContex tChange(tr ue, data);
  20076                If (UrCo mmit = res ponse) The n
  20077                Begin
  20078                    // N ew context  has been  committed.  This app  should cha nge its st ate to
  20079                    // t he new con text it in itiated.
  20080                    // - >>>>>>Upda teContextD isplay;
  20081                    //Sh owMessageC APRI('Resp onse was C ommit');
  20082                End
  20083                Else
  20084                  If (Ur Cancel = r esponse) T hen
  20085                  Begin
  20086                      //  Proposed  context ch ange is ca nceled. Re turn to th e current  context.
  20087                      //  ->>>>>>Up dateContex tDisplay;
  20088                      // ShowMessag eCAPRI('Re sponse was  Cancel');
  20089                    Pati entIEN :=  LastIEN;
  20090                    CCOW IconSetup;
  20091                    Cont extorChang eMessage : = '';
  20092                    CCOW BreakLink  := False;
  20093                    Rest oreMenuOpt ions;
  20094                    Exit ;
  20095                  End
  20096                  Else
  20097                    If ( UrBreak =  response)  Then
  20098                    Begi n
  20099                         // update  the Clinic al Link ic on, enable  the Resum e menu ite m, and
  20100                         // disable  the Suspe nd menu it em.
  20101                         // It will  not be no tified of  any contex t changes  until it r esumes par ticipation .
  20102                         //ShowMess ageCAPRI(' Response w as Break') ;
  20103  
  20104                         // This ap p should s how the se lected sta te, which  will be di fferent th an
  20105                         // that di splayed by  other CCO W apps par ticipating  in the co mmon conte xt
  20106                         // (until  it resumes  participa tion).
  20107                         (*
  20108                         listView.I tems.Clear ;
  20109  
  20110                         listItem : = listView .Items.Add ;
  20111                         listItem.C aption :=  dataItem1. Name;
  20112                         listItem.S ubItems.Ad d(dataItem 1.Value);
  20113  
  20114                         listItem : = listView .Items.Add ;
  20115                         listItem.C aption :=  dataItem2. Name;
  20116                         listItem.S ubItems.Ad d(dataItem 2.Value);
  20117                         *)
  20118                    End
  20119                    Else
  20120                    Begi n
  20121                         // Unexpec ted respon se receive d
  20122                      Sh owMessageC APRI('Unex pected Res ponse for  EndContext Change: '  + IntToStr (response) );
  20123                    End;
  20124           En d Except
  20125              ShowMessag eCAPRI('Th ere was a  CCOW error  setting p atient con text.');
  20126           En d;
  20127  
  20128       If for mReportBui lder <> Ni l Then
  20129         If f ormReportB uilder.ORL istBoxItem s.Items.Co unt > 0 Th en
  20130           fo rmReportBu ilder.ORbt nClearClic k(Applicat ion);
  20131       If for mReportBui lder <> Ni l Then
  20132         form ReportBuil der.Visibl e := False ;
  20133  
  20134       Panel1 .Caption : = 'Setting  Up Patien t';
  20135       labelI CN.Caption  := '';
  20136       labelD OB.Caption  := '';
  20137       BitBtn VistA.enab led := Fal se;
  20138       //Chan geVerifyCo de1.enable d:=False;
  20139       //Show MessageCAP RI('2');
  20140       //Show MessageCAP RI('2');
  20141       //Show MessageCAP RI('2');
  20142   //    remo teconnecti onsx := Ch eckRemoteC onnections 1.Visible;
  20143   //    Chec kRemoteCon nections1. Visible :=  False;
  20144   //    actT oolsSearch .Visible : = False;
  20145   //    // R PCBrokerCa llHistoryB uffer1.Vis ible:=Fals e;
  20146   //    N8.V isible :=  False;
  20147   //    Edit RemoteUser SiteAccess 1.Visible  := False;
  20148   //    Edit PatientLis ts1.Visibl e := False ;
  20149   //    Cons olidatedRe ports1.Vis ible := Fa lse;
  20150   //    actH elpAuditUt il.Visible  := False;
  20151       Progre ssBarLoadP t.Visible  := True;
  20152       Progre ssBarLoadP t.Max := 8 ;
  20153       Progre ssBarLoadP t.Position  := 1;
  20154       Progre ssBarLoadP t.Repaint;
  20155       frmMai n.Repaint;
  20156       Animat eLogo(True );
  20157       Status BarLoadPt. Caption :=  'Set vari ables.';
  20158       Progre ssBarLoadP t.Repaint;
  20159       frmMai n.Repaint;
  20160       If ((U serHasNewS tyleRestri ctedList <  1) Or (se nder = con textorCont rol) Or (s ender = ac tFileSwitc hSites)) T hen
  20161         Remo teDataPtID  := frmPat ientList.F MCvrICNPt. Caption
  20162       Else
  20163         Remo teDataPtID  := frmPat ientListRe stricted.F MCvrICNPt. Caption;
  20164       Page95 Control1.E nabled :=  False;
  20165       frmLab Graph.memo Labcomment s.Lines.Cl ear;
  20166       frmLab Graph.Char tLab.Serie s[0].Clear ;
  20167       frmLab Graph.Char tLab.Serie s[1].Clear ;
  20168       frmLab Graph.Char tLab.Serie s[2].Clear ;
  20169       frmLab Graph.Char tLab.Title .Text.Clea r;
  20170       frmLab Graph.Char tLab.Serie sList[0].T itle := '  ';
  20171       MemoDo cs.Lines.C lear;
  20172       EditSe archPN.Tex t := '';
  20173       VistAW ebLoaded : = False;
  20174       (* //S tart Delet ion 200806 101107
  20175       if ((U serHasNewS tyleRestri ctedList <  1) or (se nder = con textorCont rol) or (s ender = Sw itchSites1 )) then be gin
  20176         pati entname :=  frmPatien tList.fmCv rNamePt.ca ption;
  20177         Pati entSSN :=  frmPatient List.fmCvr SSNPt.capt ion;
  20178         Pati entICN :=  frmPatient List.fmCvr ICNPt.capt ion;
  20179         Pati entClaimNu mber := fr mPatientLi st.fmCvrCn umberPt.ca ption;
  20180         Cnum ber.Captio n := frmPa tientList. fmCvrCnumb erPt.capti on;
  20181       end
  20182       else b egin
  20183         pati entname :=  frmPatien tListRestr icted.fmCv rNamePt.ca ption;
  20184         Pati entSSN :=  frmPatient ListRestri cted.fmCvr SSNPt.capt ion;
  20185         Pati entICN :=  frmPatient ListRestri cted.fmCvr ICNPt.capt ion;
  20186         Pati entClaimNu mber := fr mPatientLi stRestrict ed.fmCvrCn umberPt.ca ption;
  20187         Cnum ber.Captio n := frmPa tientListR estricted. fmCvrCnumb erPt.capti on;
  20188       end;
  20189       //End  Deletion 2 0080610110 7
  20190       *)
  20191  
  20192       //Star t Addition  200806101 108
  20193       If ((U serHasNewS tyleRestri ctedList <  1) Or (se nder = con textorCont rol) Or (s ender = ac tFileSwitc hSites)) T hen
  20194       Begin
  20195         If U serHasNewS tyleRestri ctedList =  1 Then
  20196         Begi n
  20197           pa tientname  := frmPati entListRes tricted.fm CvrNamePt. caption;
  20198           Pa tientSSN : = frmPatie ntListRest ricted.fmC vrSSNPt.ca ption;
  20199           Pa tientICN : = frmPatie ntListRest ricted.fmC vrICNPt.ca ption;
  20200           Pa tientClaim Number :=  frmPatient ListRestri cted.fmCvr CnumberPt. caption;
  20201           Cn umber.Capt ion := frm PatientLis tRestricte d.fmCvrCnu mberPt.cap tion;
  20202  
  20203   //         SelectedPa tient.IEN  := frmPati entListRes tricted.
  20204         End
  20205         Else
  20206         Begi n
  20207           pa tientname  := frmPati entList.fm CvrNamePt. caption;
  20208           Pa tientSSN : = frmPatie ntList.fmC vrSSNPt.ca ption;
  20209           Pa tientICN : = frmPatie ntList.fmC vrICNPt.ca ption;
  20210           Pa tientClaim Number :=  frmPatient List.fmCvr CnumberPt. caption;
  20211           Cn umber.Capt ion := frm PatientLis t.fmCvrCnu mberPt.cap tion;
  20212         End;
  20213       End
  20214       Else
  20215       Begin
  20216         pati entname :=  frmPatien tListRestr icted.fmCv rNamePt.ca ption;
  20217         Pati entSSN :=  frmPatient ListRestri cted.fmCvr SSNPt.capt ion;
  20218         Pati entICN :=  frmPatient ListRestri cted.fmCvr ICNPt.capt ion;
  20219         Pati entClaimNu mber := fr mPatientLi stRestrict ed.fmCvrCn umberPt.ca ption;
  20220         Cnum ber.Captio n := frmPa tientListR estricted. fmCvrCnumb erPt.capti on;
  20221       End;
  20222       //End  Addition 2 0080610110 8
  20223  
  20224       Page95 Control1.A ctivePage  := Tab7131 Request;
  20225       Page95 Control1.A ctivePage  := TabCPEx ams;
  20226       Page95 Control1.V isible :=  True;
  20227       Animat eLogo(True );
  20228       Status BarLoadPt. Caption :=  'Refresh  address.';
  20229       Progre ssBarLoadP t.Repaint;
  20230       frmMai n.Repaint;
  20231       btnRef reshAddres sClick(App lication);
  20232       Progre ssBarLoadP t.Position  := 2;
  20233       Progre ssBarLoadP t.Repaint;
  20234       frmMai n.Repaint;
  20235       Animat eLogo(True );
  20236       Status BarLoadPt. Caption :=  'Refresh  exams.';
  20237       Progre ssBarLoadP t.Repaint;
  20238       frmMai n.Repaint;
  20239       ExamRe questRefre shClick(Ap plication) ;
  20240       Progre ssBarLoadP t.Position  := 3;
  20241       Progre ssBarLoadP t.Repaint;
  20242       frmMai n.Repaint;
  20243       Animat eLogo(True );
  20244       Status BarLoadPt. Caption :=  'Refresh  7131''s.';
  20245       Progre ssBarLoadP t.Repaint;
  20246       frmMai n.Repaint;
  20247       Sevent yOne31Requ estRefresh Click(Appl ication);
  20248       RichEd itDODRepor t.Lines.Cl ear;
  20249       ORList BoxDODRepo rtTypes.It emIndex :=  -1;
  20250       Progre ssBarLoadP t.Position  := 4;
  20251       Progre ssBarLoadP t.Repaint;
  20252       frmMai n.Repaint;
  20253       Page95 Control1.R epaint;
  20254       Animat eLogo(True );
  20255       Status BarLoadPt. Caption :=  'Refresh  appointmen ts.';
  20256       Progre ssBarLoadP t.Repaint;
  20257       frmMai n.Repaint;
  20258       btnAll Click(Appl ication);
  20259       Progre ssBarLoadP t.Position  := 5;
  20260       Progre ssBarLoadP t.Repaint;
  20261       frmMai n.Repaint;
  20262       Animat eLogo(True );
  20263       Status BarLoadPt. Caption :=  'Refresh  demographi cs.';
  20264       Progre ssBarLoadP t.Repaint;
  20265       frmMai n.Repaint;
  20266       btnRef reshPtDemo graphicsCl ick(Applic ation);
  20267       Progre ssBarLoadP t.Position  := 6;
  20268       Progre ssBarLoadP t.Repaint;
  20269       frmMai n.Repaint;
  20270       btnDoc sRefreshCl ick(Applic ation);
  20271       PanelR eportChoic e.Visible  := False;
  20272       panelR eportChoic e2.Visible  := False;
  20273       LoadRe portsOptio ns;
  20274       Animat eLogo(True );
  20275       Status BarLoadPt. Caption :=  'Load HS  types.';
  20276       Progre ssBarLoadP t.Repaint;
  20277       frmMai n.Repaint;
  20278       btnLoa dHSNamesCl ick(Applic ation);
  20279       Progre ssBarLoadP t.Position  := 7;
  20280       Progre ssBarLoadP t.Repaint;
  20281       frmMai n.Repaint;
  20282       Tab95C ontrol2.Ta bs.Clear;
  20283       Tab95C ontrol2.Ta bs.Add('Lo cal');
  20284       HSMemo Local.Line s.Clear;
  20285       ComboB oxHSSectio ns.Items.C lear;
  20286       TimerR emoteData. Enabled :=  False;
  20287       ListBo xRemoteDat aPending.I tems.Clear ;                                           // Clear R emote Data  Requests;
  20288       Animat eLogo(True );
  20289       Status BarLoadPt. Caption :=  'Updating  audit tra il...';
  20290       Progre ssBarLoadP t.Repaint;
  20291       frmMai n.Repaint;
  20292       Progre ssBarLoadP t.Position  := 8;
  20293       Progre ssBarLoadP t.Repaint;
  20294       frmMai n.Repaint;
  20295       Update AuditOnHom eServer;
  20296       Page95 Control1.E nabled :=  True;
  20297       Progre ssBarLoadP t.Visible  := False;
  20298       Animat eLogo(Fals e);
  20299       If ((U serHasNewS tyleRestri ctedList <  1) Or (se nder = con textorCont rol) Or (s ender = ac tFileSwitc hSites)) T hen
  20300       Begin
  20301         Pane l1.Caption  := frmPat ientList.f mCvrNamePt .caption +  '  SSN#'  + frmPatie ntList.fmC vrSSNPt.ca ption;
  20302         If f rmPatientL ist.FMCvrI CNPt.capti on <> '' T hen
  20303           la belICN.Cap tion := 'I CN: ' + fr mPatientLi st.FMCvrIC NPt.captio n;
  20304         If f rmPatientL ist.FMCvrB irthdatePt .caption < > '' Then
  20305           la belDOB.Cap tion := 'D OB: ' + fr mPatientLi st.FMCvrBi rthdatePt. caption;
  20306       End
  20307       Else
  20308       Begin
  20309         Pane l1.Caption  := frmPat ientListRe stricted.f mCvrNamePt .caption +  '  SSN#'  + frmPatie ntListRest ricted.fmC vrSSNPt.ca ption;
  20310         If f rmPatientL istRestric ted.FMCvrI CNPt.capti on <> '' T hen
  20311           la belICN.Cap tion := 'I CN: ' + fr mPatientLi stRestrict ed.FMCvrIC NPt.captio n;
  20312         If f rmPatientL istRestric ted.FMCvrB irthdatePt .caption < > '' Then
  20313           la belDOB.Cap tion := 'D OB: ' + fr mPatientLi stRestrict ed.FMCvrBi rthdatePt. caption;
  20314       End;
  20315  
  20316       Status BarLoadPt. Caption :=  'Ready.';
  20317       Animat eLogo(Fals e);
  20318  
  20319       if Ess oVersion =  False The n
  20320       begin
  20321         BitB tnVistA.En abled := F alse;
  20322       end
  20323       else
  20324       begin
  20325         BitB tnVistA.En abled := T rue;                                                   //only rem ote connec tions - rp m 3/17/09
  20326       end;
  20327  
  20328       //Chan geVerifyCo de1.enable d:=True;
  20329   //    Chec kRemoteCon nections1. Visible :=  remotecon nectionsx;
  20330   //    //RP CBrokerCal lHistoryBu ffer1.Visi ble:=xxxxx xxx
  20331   //    N8.V isible :=  remoteconn ectionsx;
  20332   //    Edit RemoteUser SiteAccess 1.Visible  := remotec onnections x;
  20333   //    Edit PatientLis ts1.Visibl e := remot econnectio nsx;
  20334   //    Cons olidatedRe ports1.Vis ible := re moteconnec tionsx;
  20335   //    actH elpAuditUt il.Visible  := remote connection sx;
  20336       Scroll BoxAddress .VertScrol lBar.Posit ion := 0;
  20337       Scroll BoxAddress .HorzScrol lBar.Posit ion := 0;
  20338     End;
  20339     If (Pati entIEN = ' ') Or (pat ientname =  '') Or (p atientSSN  = '') Then
  20340     Begin
  20341       ClearF orm;                                                                         //CodeCR24 8 - rpm 3/ 8/12 - cle ar the hea der and ta b set
  20342       EditSe archPN.Tex t := '';
  20343       patien tname := ' ';
  20344       Animat eLogo(Fals e);
  20345       Status BarLoadPt. Caption :=  'Ready.';
  20346     End;
  20347  
  20348       If Use rHasNewSty leRestrict edList = 1  Then begi n
  20349       Patien tAge := fr mPatientLi stRestrict ed.FMCvrAg ePt.Captio n;
  20350       Patien tSex := fr mPatientLi stRestrict ed.fmCvrSe xPt.captio n;
  20351     End Else  begin
  20352       Patien tAge := fr mPatientLi st.fmCvrAg ePt.captio n;
  20353       Patien tSex := fr mPatientLi st.fmCvrSe xPt.captio n;
  20354           // PatientNam e := frmPa tientList. FMCvrNameP t.caption;
  20355     end;
  20356  
  20357     frmPatie ntList.rel ease;
  20358     frmPatie ntList :=  Nil;
  20359     frmPatie ntListRest ricted.rel ease;
  20360     frmPatie ntListRest ricted :=  Nil;
  20361     If ReadO nlyMode =  True Then
  20362     Begin
  20363       btnAdd Request.En abled := F alse;
  20364       btnEdi tAddress.e nabled :=  False;
  20365       btnAdd 7131.enabl ed := Fals e;
  20366       btnVie w7131.Capt ion := 'Vi ew Selecte d Request' ;
  20367       btnVie wExam.Capt ion := 'Vi ew Selecte d Request' ;
  20368       actToo lsChangeAd dress.Visi ble := fal se;
  20369       actToo lsSearch.V isible :=  False;
  20370       TabCPW orksheets. TabVisible  := False;
  20371       actToo lsUnsigned WorkSheets .Visible : = False;
  20372     End;
  20373  
  20374     actCCRLa unch.Visib le := IsCC RUser and  (PatientIE N <> '');                          actCCRLa unch.Enabl ed := actC CRLaunch.V isible;
  20375  
  20376     Restorem enuOptions ;                                                                 // everyth ing is com mented out  in this m ethod
  20377     CCOWIcon Setup;
  20378     CCOWInit ialized :=  True;
  20379     Contexto rChangeMes sage := '' ;
  20380     CCOWBrea kLink := F alse;
  20381   end;                                                                                    // ShowPat ientList
  20382  
  20383   {========= ========== ========== ========== ========== ========== ========== =====
  20384    GetActive CapriDivis ions
  20385    This proc edure scan s a given  list of di visions an d populate s the Targ et
  20386    list with  only divi sions that  do not ha ve the DIS ABLE ALL E XAMS? (#4)
  20387    field set  to YES in  the CAPRI  DIVISION  EXAM LIST  (#396.15)  file.
  20388  
  20389    Input:
  20390      aDivisi onList:TSt rings in t he format  'name  fac ility#^IEN ' (Ex. 'Al bany 500^1 ')
  20391      Target: TStrings -  output ta rget list
  20392    Output:
  20393      Target: TStrings -  filtered  divisionli st in the  format 'na me  facili ty#^IEN'
  20394                          on succes s; otherwi se returns  the input  list.
  20395  
  20396    CodeCR173  - rpm 4/1 8/11
  20397                 rpm 5/1 1/11 - add  $G to Scr een to pro tect again st missing  3 node
  20398    ========= ========== ========== ========== ========== ========== ========== ======}
  20399  
  20400   procedure  TfrmMain.G etActiveCa priDivisio ns(aDivisi onList, Ta rget: TStr ings);
  20401   var
  20402     I, Match Index: Int eger;
  20403     FMlstrCa priDivisio ns: TFMLis ter;
  20404     lstActiv eDivisions , lstResul ts: TStrin gList;
  20405   begin
  20406     lstActiv eDivisions  := TStrin gList.Crea te;
  20407     lstResul ts := TStr ingList.Cr eate;
  20408     lstActiv eDivisions .Sorted :=  True;
  20409  
  20410     //setup  FMLister t o retrieve  active CA PRI divisi on IEN's
  20411     FMlstrCa priDivisio ns := TFML ister.Crea te(nil);
  20412     FMlstrCa priDivisio ns.RPCBrok er := RPCB roker1;
  20413     FMlstrCa priDivisio ns.FileNum ber := '39 6.15';                                      //CAPRI DI VISION EXA M LIST
  20414     FMlstrCa priDivisio ns.FieldNu mbers.Add( '.01');                                     //DIVISION
  20415     FMlstrCa priDivisio ns.ListerF lags := [l fInternal] ;
  20416     FMlstrCa priDivisio ns.Number  := '*';                                                //scan all  records
  20417     FMlstrCa priDivisio ns.Screen  := 'I $P($ G(^(3)),U, 1)''="Y"';                       //return o nly active
  20418  
  20419     CAPRIQui ckCopy(aDi visionList , Target);                                             //at least  return th e passed i n list
  20420     try
  20421       FMlstr CapriDivis ions.GetLi st(lstActi veDivision s);
  20422       if lst ActiveDivi sions.Coun t > 0 Then
  20423       begin
  20424         for  I := 0 to  aDivisionL ist.Count  - 1 Do
  20425         begi n
  20426           Ma tchIndex : = lstActiv eDivisions .IndexOf(P iece(aDivi sionList.S trings[I],  '^', 2));
  20427           if  (MatchInd ex > -1) t hen
  20428              lstResults .Add(aDivi sionList.S trings[I]) ;
  20429         end;
  20430         CAPR IQuickCopy (lstResult s, Target) ;
  20431       end;
  20432     finally
  20433       FreeAn dNil(lstAc tiveDivisi ons);
  20434       FreeAn dNil(lstRe sults);
  20435       FreeAn dNil(FMlst rCapriDivi sions);
  20436     end;
  20437   end;                                                                                    //GetActiv eCapriDivi sions
  20438  
  20439   {========= ========== ========== ========== ========== ========== ========== =========
  20440    GetAllDiv isions
  20441    This proc edure retr ieves the  NAME and F ACILITY NU MBER field s from all
  20442    MEDICAL C ENTER DIVI SION recor ds and pop ulates eac h index in  the passe d list
  20443    with the  division N ame follow ed by 2 sp aces, the  facility n umber, car et
  20444    delimiter , and reco rd IEN.
  20445  
  20446    Input:  a DivisionLi st:TString s - output  target li st
  20447    Output: a DivisionLi st:TString s - format ted list o f division s
  20448                                        Format :  'NAME   FACILITY#^ IEN'
  20449  
  20450    CodeCR186  - rpm 4/1 8/11
  20451    ========= ========== ========== ========== ========== ========== ========== =========}
  20452  
  20453   procedure  TfrmMain.G etAllDivis ions(aDivi sionList:  TStrings);
  20454   var
  20455     I: integ er;
  20456     aName, a FacilityNu mber: Stri ng;
  20457     FMlstrDi visions: T FMLister;
  20458     lstDivis ions: TStr ingList;
  20459   begin
  20460     //setup  FMLister t o retrieve  active CA PRI divisi on IEN's
  20461     lstDivis ions := Ts tringList. Create;
  20462     FMlstrDi visions :=  TFMLister .Create(ni l);
  20463     FMlstrDi visions.RP CBroker :=  RPCBroker 1;
  20464     FMlstrDi visions.Fi leNumber : = '40.8';                                              //MEDICAL  CENTER DIV ISION
  20465     FMlstrDi visions.Fi eldNumbers .Add('.01' );                                          //NAME
  20466     FMlstrDi visions.Fi eldNumbers .Add('1');                                             //FACILITY  NUMBER
  20467     FMlstrDi visions.Li sterFlags  := [];
  20468     FMlstrDi visions.Nu mber := '* ';                                                     //get all  records
  20469  
  20470     try
  20471       aDivis ionList.Cl ear;
  20472       FMlstr Divisions. GetList(ni l);
  20473       if FMl strDivisio ns.Results .Count > 0  Then
  20474       begin
  20475         //mo ve IENs to  a sortabl e list
  20476         CAPR IQuickCopy (FMlstrDiv isions.Res ults, lstD ivisions);
  20477         //so rt in IEN  order
  20478         lstD ivisions.S orted := T rue;
  20479         //bu ild output  record: n ame + 2spa ces + faci lity# + '^ ' + IEN
  20480         for  I := 0 To  lstDivisio ns.Count -  1 Do
  20481         begi n
  20482           aN ame := FMl strDivisio ns.GetReco rd(lstDivi sions[I]). GetField(' .01').FMDB External;
  20483           aF acilityNum ber := FMl strDivisio ns.GetReco rd(lstDivi sions[I]). GetField(' 1').FMDBEx ternal;
  20484           aD ivisionLis t.Add(aNam e + '    '  + aFacili tyNumber +  '^' + lst Divisions[ I]);
  20485         end;
  20486       end;
  20487     finally
  20488       FreeAn dNil(FMlst rDivisions );
  20489       FreeAn dNil(lstDi visions);
  20490     end;
  20491   end;                                                                                    //GetAllDi visions
  20492  
  20493   {========= ========== ========== ========== ========== ========== ========== ======
  20494    GetDispla yGrpIEN
  20495    This func tion retri eves the I EN for a g iven NAME  from the D ISPLAY GRO UP
  20496    (#100.98)  file.
  20497    AMIE acce ss to file  #100.98 a llowed by  Controlled  Subscript ion IA# 87 3.
  20498  
  20499    Input: aD isplayGrou p:String -  Display g roup name  value
  20500    Output: f unction re sult:Strin g - return s IEN of m atching re cord on su ccess;
  20501                                        otherw ise return s '0' on n o match or  ''
  20502                                        on err or.
  20503    CodeCR178  - rpm 4/1 8/11
  20504    ========= ========== ========== ========== ========== ========== ========== ======}
  20505  
  20506   function T frmMain.Ge tDisplayGr pIEN(aDisp layGroup:  String): S tring;
  20507   var
  20508     FMDispla yGrp: TFMF indOne;
  20509     DGIEN: S tring;
  20510   begin
  20511     DGIEN :=  '';
  20512     FMDispla yGrp := TF MFindOne.C reate(nil) ;
  20513     FMDispla yGrp.RPCBr oker := RP CBroker1;
  20514     FMDispla yGrp.Value  := aDispl ayGroup;
  20515     FMDispla yGrp.FMInd ex := 'B';                                                        //lookup i ndex
  20516     FMDispla yGrp.FileN umber := ' 100.98';                                               //DISPLAY  GROUP
  20517     try
  20518       DGIEN  := FMDispl ayGrp.GetI EN;
  20519     finally
  20520       FreeAn dNil(FMDis playGrp);
  20521     end;
  20522     Result : = DGIEN;
  20523   end;                                                                                    //GetDispl ayGrpIEN
  20524  
  20525   //Merged m nj
  20526  
  20527   procedure  TfrmMain.a ctHIASearc hExecute(S ender: TOb ject);
  20528   begin
  20529     try
  20530       frmhia verifypati entlist :=  Tfrmhiave rifypatien tlist.Crea te(nil);
  20531       frmhia verifypati entlist.Sh owModal;
  20532     finally
  20533       FreeAn dNil(frmhi averifypat ientlist);
  20534     end;
  20535   end;
  20536  
  20537   {========= ========== ========== ========== ========== ========== ========== =====
  20538    ClearForm
  20539    This proc edure init ializes th e form hea der and th e tab set  in prepara tion
  20540    for an in itial pati ent select ion after  connecting  to a site .  It clea rs
  20541    the demog raphics fr om the mai n form hea der, hides  the tab s et, and se ts
  20542    the activ e tab to " C&P Exam".   The code  was refac tored out  of the
  20543    actFileCo nnectExecu te and Sho wPatientLi st procedu res.
  20544  
  20545    CodeCR248  - rpm 3/8 /12
  20546    ========= ========== ========== ========== ========== ========== ========== =====}
  20547  
  20548   procedure  TfrmMain.C learForm;
  20549   begin
  20550     Page95Co ntrol1.Act ivePage :=  TabCPExam s;
  20551     Page95Co ntrol1.Vis ible := Fa lse;
  20552     Panel1.C aption :=  '';
  20553     LabelDOB .Caption : = '';                                                             //CodeCR20 1 - rpm 11 /2/11
  20554     LabelICN .Caption : = '';                                                             //CodeCR20 1 - rpm 11 /2/11
  20555   end;                                                                                    //ClearFor m
  20556  
  20557  
  20558   //-------- ---------- ---------- ---------- ---------- ---------- ---------- ----------
  20559   // VocReha b - Reques t listbox  clicked
  20560   //-------- ---------- ---------- ---------- ---------- ---------- ---------- ----------
  20561   // This bu tton press  allows th e user to  edit a Voc ational Re hab Medica l Request
  20562   // for Ser vices
  20563   // CodeCR3 47 - jrl 6 /6/12
  20564   //-------- ---------- ---------- ---------- ---------- ---------- ---------- ----------
  20565  
  20566   procedure  TfrmMain.l bVocRehabC lick(Sende r: TObject );
  20567   begin
  20568     // don't  enable ed it button  if "No rec ords found " is displ ayed
  20569     if lbVoc Rehab.Coun t = 1 then
  20570       if lbV ocRehab.It ems[0] = ' No records  found' th en
  20571       begin
  20572         btnV REditReque st.Enabled  := FALSE;
  20573         exit ;
  20574       end;
  20575     // if no  medical r equests ex ist, disab le edit bu tton
  20576     if lbVoc Rehab.Item Index <> - 1 then
  20577       btnVRE ditRequest .Enabled : = TRUE
  20578     else
  20579       btnVRE ditRequest .Enabled : = FALSE;
  20580   end;
  20581  
  20582   //-------- ---------- ---------- ---------- ---------- ---------- ---------- ----------
  20583   // VocReha b - Add Ne w Request  button cli cked
  20584   //-------- ---------- ---------- ---------- ---------- ---------- ---------- ----------
  20585   // This bu tton press  allows th e user to  input a ne w Vocation al Rehab M edical
  20586   // Request  for Servi ces
  20587   // CodeCR3 47 - jrl 5 /22/12
  20588   //-------- ---------- ---------- ---------- ---------- ---------- ---------- ----------
  20589  
  20590   procedure  TfrmMain.b tnVRAddNew RequestCli ck(Sender:  TObject);
  20591   begin
  20592     VocRehab .AddExam : = TRUE;
  20593     try
  20594       frmVRM edicalRequ est := Tfr mVRMedical Request.Cr eate(Appli cation);
  20595       frmVRM edicalRequ est.Select edMedicalR equestIEN  := '+1,';                        // New IEN
  20596       frmVRM edicalRequ est.SetupN ewExam;
  20597       frmVRM edicalRequ est.ShowMo dal;
  20598     finally
  20599       FreeAn dNil(frmVR MedicalReq uest);
  20600     end;
  20601     VocRehab .SetupMedi calService sList;
  20602  
  20603   end;
  20604  
  20605   //-------- ---------- ---------- ---------- ---------- ---------- ---------- ----------
  20606   // VocReha b - Edit R equest but ton clicke d
  20607   //-------- ---------- ---------- ---------- ---------- ---------- ---------- ----------
  20608   // This bu tton press  allows th e user to  edit a Voc ational Re hab Medica l Request
  20609   // for Ser vices
  20610   // CodeCR3 47 - jrl 5 /22/12
  20611   //-------- ---------- ---------- ---------- ---------- ---------- ---------- ----------
  20612  
  20613   procedure  TfrmMain.b tnVREditRe questClick (Sender: T Object);
  20614   var
  20615     buffer:  string;
  20616     LenTotal , LenCol2,  LenCol3:  Integer;
  20617     RequestD ateStr : s tring;
  20618     Complete dDateStr:  string;
  20619     Cancelle dDateStr:  string;
  20620   begin
  20621     VocRehab .AddExam : = FALSE;
  20622     try
  20623       if lbV ocRehab.It emIndex =  -1 then                                                // don't a llow empty  selection
  20624         exit ;
  20625       frmVRM edicalRequ est := Tfr mVRMedical Request.Cr eate(Appli cation);
  20626       frmVRM edicalRequ est.Select edMedicalR equestIEN  := IntToSt r(Integer( lbVocRehab .Items.Obj ects[lbVoc Rehab.Item Index]));
  20627       buffer  := lbVocR ehab.Items [lbVocReha b.ItemInde x];
  20628        // if  the selec ted item h as either  a complete d or cance lled date,  set a
  20629        // fl ag so that  the medic al request  can be di splayed, b ut not edi ted
  20630       frmMai n.VocRehab .RequestCo mpleted :=  FALSE;                                     // default  to No Com pleted dat e
  20631       Reques tDateStr : = Piece(bu ffer,'|',1 );          // Rework ed - Patch 197 JRL 7/ 17/17
  20632       Comple tedDateStr  := Piece( buffer,'|' ,2);
  20633       Cancel ledDateStr  := Piece( buffer,'|' ,3);
  20634       if cop y(Complete dDateStr,1 ,3) = '    ' then
  20635          Com pletedDate Str := '';
  20636       if cop y(Cancelle dDateStr,1 ,3) = '    ' then
  20637          Can celledDate Str := '';
  20638       if Com pletedDate Str = '' t hen
  20639         frmM ain.VocReh ab.Request Completed  := FALSE
  20640       else i f (VAUtils .ScreenRea derActive  = TRUE) AN D (Complet edDateStr[ 1] = '[')  then // [N ot Complet ed] text d isplayed f or screen  reader
  20641   //  else i f (VAUtils .ScreenRea derActive  = TRUE) AN D (Complet edDateStr[ 3] = '[')  then // [N ot Complet ed] text d isplayed f or screen  reader
  20642         frmM ain.VocReh ab.Request Completed  := FALSE
  20643       else
  20644         frmM ain.VocReh ab.Request Completed  := TRUE;
  20645       if Can celledDate Str = '' t hen
  20646         frmM ain.VocReh ab.Request Cancelled  := FALSE
  20647       else
  20648         frmM ain.VocReh ab.Request Cancelled  := TRUE;
  20649  
  20650       frmVRM edicalRequ est.SetupE xistingExa m;
  20651       frmVRM edicalRequ est.ShowMo dal;
  20652     finally
  20653       FreeAn dNil(frmVR MedicalReq uest);
  20654     end;
  20655     VocRehab .SetupMedi calService sList;
  20656  
  20657   end;
  20658  
  20659   {========= ========== ========== ========== ========== ========== ========== =======
  20660    DoLegacyE nterpriseS earch
  20661    This proc edure cont ains refac tored code  from the  actToolsSe archExecut e that
  20662    supports  calling th e Legacy E nterprise  Search tha t uses the  RPCBroker
  20663    connectio n and pati ent lookup  at a list  of remote  sites.
  20664  
  20665    CodeCR267  - rpm 8/2 8/12
  20666    ========= ========== ========== ========== ========== ========== ========== =======}
  20667  
  20668   procedure  TfrmMain.D oLegacyEnt erpriseSea rch(Sender : TObject) ;
  20669   var
  20670     RemoteDa taTimer: B oolean;
  20671   begin
  20672     RemoteDa taTimer :=  TimerRemo teData.Ena bled;
  20673     TimerRem oteData.En abled := f alse;
  20674     timeoutt imer.enabl ed := fals e;
  20675  
  20676     frmFindP atientAnyw here := Tf rmFindPati entAnywher e.Create(f rmMain);
  20677     frmFindP atientAnyw here.Top : = frmMain. Top + ((fr mMain.heig ht - frmFi ndPatientA nywhere.he ight) Div  2);
  20678     frmFindP atientAnyw here.Left  := frmMain .Left + (( frmMain.wi dth - frmF indPatient Anywhere.w idth) Div  2);
  20679     Contexto rChangeMes sage := 'Y ou are be  searching  for patien ts on othe r VistA sy stems.  If  you conti nue, CAPRI  will drop  out of th e clinical  context.' ;
  20680     CCOWBrea kLink := T rue;
  20681     try
  20682       If frm PatientLis tRestricte d <> nil T hen
  20683       Begin
  20684         If s ender = fr mPatientLi stRestrict ed.btnSear ch Then
  20685         Begi n
  20686           fr mFindPatie ntAnywhere .edit1.ena bled := fa lse;
  20687           fr mFindPatie ntAnywhere .edit1.tex t := piece (frmPatien tListRestr icted.ORLi stBox1.ite ms[frmPati entListRes tricted.OR Listbox1.i temindex],  '^', 6);
  20688         End;
  20689       End;
  20690  
  20691       frmFin dPatientAn ywhere.Sho wmodal;                                                // Check f or cancel  button and  exit
  20692     finally
  20693       Contex torChangeM essage :=  '';
  20694       CCOWBr eakLink :=  False;
  20695       frmFin dPatientAn ywhere.rel ease;
  20696       frmFin dPatientAn ywhere :=  Nil;
  20697       timeou ttimer.ena bled := tr ue;
  20698       TimerR emoteData. Enabled :=  RemoteDat aTimer;
  20699     end;
  20700   end;
  20701  
  20702   {========= ========== ========== ========== ========== ========== ========== ==
  20703    DoMVISite Switch
  20704    This proc edure call s the appr opriate ev ent handle r method t o initiate  a
  20705    site swit ch.  Speci fic method s called a re based o n the site  switching
  20706    functiona lity used  by the Rem ote Sites  dialog and  are contr olled by t he
  20707    source of  the MVI E nterprise  Search cal l.  The si te switch  depends on  2
  20708    global va riables be ing set by  the MVI E nterprise  Search: Sw itchToSite
  20709    and Switc hToPatient SSN.
  20710  
  20711    CodeCR267  - rpm 8/3 0/12
  20712    ========= ========== ========== ========== ========== ========== ========== ==}
  20713  
  20714   procedure  TfrmMain.D oMVISiteSw itch(Sende r: TObject );
  20715   begin
  20716     if (Swit chToSite < > '') and  (SwitchToP atientSSN  <> '') the n
  20717     begin
  20718       if Ass igned(frmP atientList ) then                                                 //MVI sear ch called  from Patie nt Selecto r
  20719       begin
  20720         if ( frmPatient List.Visib le) then
  20721           fr mPatientLi st.btnCvrC ancelPtCli ck(Sender) ;
  20722       end
  20723       else i f Assigned (frmPatien tListRestr icted) the n                                //MVI sear ch called  from Patie nt Selecto r (Restric ted Lists)
  20724       begin
  20725         if ( frmPatient ListRestri cted.Visib le) then
  20726           fr mPatientLi stRestrict ed.btnCvrC ancelPtCli ck(Sender) ;
  20727       end
  20728       else                                                                                //MVI Sear ch called  from Tools /Enterpris e Search f or Patient  option
  20729       begin
  20730         actF ileSelectP atientExec ute(contex torControl );
  20731       end;
  20732     end;
  20733   end;
  20734  
  20735   {========= ========== ========== ========== ========== ========== ========== ======
  20736    IsButtonT agOne
  20737    This func tion retur ns TRUE wh en the Sen der is a T Button wit h the Tag
  20738    property  set to '1' .  Otherwi se, FALSE  is returne d.
  20739  
  20740    //CodeCR2 67 - rpm 8 /30/12
  20741    ========= ========== ========== ========== ========== ========== ========== ======}
  20742  
  20743   function T frmMain.Is ButtonTagO ne(Sender:  TObject):  Boolean;
  20744   begin
  20745     Result : = False;
  20746     if (Send er is TBut ton) then
  20747     begin
  20748       if ((S ender as T Button).Ta g = 1) the n
  20749         Resu lt := True ;
  20750     end;
  20751   end;
  20752  
  20753   {========= ========== ========== ========== ========== ========== ========== ======
  20754    LoadRestr ictedSearc hTraits
  20755    This proc edure popu lates the  public tra it propert ies on the  new Enter prise
  20756    Search fo rm from th e Patient  List Restr icted.  Th e properti es will be  used
  20757    to contro l access t he the sea rch trait  fields.
  20758  
  20759    //CodeCR2 67 - rpm 9 /13/12
  20760    ========= ========== ========== ========== ========== ========== ========== ======}
  20761  
  20762   procedure  TfrmMain.L oadRestric tedSearchT raits;
  20763   begin
  20764     if Assig ned(frmMVI Enterprise Search) an d
  20765       Assign ed(frmPati entListRes tricted) t hen
  20766     begin
  20767       if (fr mPatientLi stRestrict ed.ORListb ox1.itemin dex > -1)  then
  20768       begin
  20769         frmM VIEnterpri seSearch.F ullNameRes tricted :=  piece(frm PatientLis tRestricte d.ORListBo x1.items[f rmPatientL istRestric ted.ORList box1.itemi ndex], '^' , 3);
  20770         frmM VIEnterpri seSearch.S SNRestrict ed := piec e(frmPatie ntListRest ricted.ORL istBox1.it ems[frmPat ientListRe stricted.O RListbox1. itemindex] , '^', 6);
  20771         frmM VIEnterpri seSearch.D OBRestrict ed := piec e(frmPatie ntListRest ricted.ORL istBox1.it ems[frmPat ientListRe stricted.O RListbox1. itemindex] , '^', 7);
  20772         frmM VIEnterpri seSearch.I CNRestrict ed := piec e(frmPatie ntListRest ricted.ORL istBox1.it ems[frmPat ientListRe stricted.O RListbox1. itemindex] , '^', 8);
  20773       end;
  20774     end;
  20775   end;
  20776  
  20777   //-------- ---------- ---------- ---------- ---------- ---------- ---------- ----------
  20778   // Remove  Special Ch aracters                                 Co deCR522 JR L 11/15/13
  20779   //-------- ---------- ---------- ---------- ---------- ---------- ---------- ----------
  20780   // VVA can not handle  any speci al charact ers in the  exam name .  Remove/ replace.
  20781   // *  Remo ve exam st atus [Open ] from the  name.
  20782   // *  Repl ace "&" wi th "and".
  20783   // *  Repl ace the fo llowing sp ecial char acters wit h spaces:  ()-=*!@#$% ^*[]{}\|?/ <>
  20784   //    Curr ently, "&" , "(" and  ")" are th e only cha racters us ed but CAP RI doesn't
  20785   //    own  the exam n ames - cod e for futu re.
  20786   //-------- ---------- ---------- ---------- ---------- ---------- ---------- ----------
  20787  
  20788   function T frmMain.Re moveSpecia lCharacter s(InputExa mName: str ing): stri ng;
  20789   var
  20790     buffer:  string;
  20791   //   i : I nteger;  / / LMS Not  needed
  20792   begin
  20793     buffer : = TrimRigh t(InputExa mName);
  20794     buffer : = StringRe place(buff er, '[OPEN ]', '', [r fReplaceAl l, rfIgnor eCase]);
  20795     buffer : = StringRe place(buff er, '&', ' and', [rfR eplaceAll,  rfIgnoreC ase]);
  20796     buffer : = StringRe place(buff er, '~', '  ', [rfRep laceAll, r fIgnoreCas e]);
  20797     buffer : = StringRe place(buff er, '`', '  ', [rfRep laceAll, r fIgnoreCas e]);
  20798     buffer : = StringRe place(buff er, '!', '  ', [rfRep laceAll, r fIgnoreCas e]);
  20799     buffer : = StringRe place(buff er, '@', '  ', [rfRep laceAll, r fIgnoreCas e]);
  20800     buffer : = StringRe place(buff er, '#', '  ', [rfRep laceAll, r fIgnoreCas e]);
  20801     buffer : = StringRe place(buff er, '$', '  ', [rfRep laceAll, r fIgnoreCas e]);
  20802     buffer : = StringRe place(buff er, '%', '  ', [rfRep laceAll, r fIgnoreCas e]);
  20803     buffer : = StringRe place(buff er, '^', '  ', [rfRep laceAll, r fIgnoreCas e]);
  20804     buffer : = StringRe place(buff er, '*', '  ', [rfRep laceAll, r fIgnoreCas e]);
  20805     buffer : = StringRe place(buff er, '(', '  ', [rfRep laceAll, r fIgnoreCas e]);
  20806     buffer : = StringRe place(buff er, ')', '  ', [rfRep laceAll, r fIgnoreCas e]);
  20807     buffer : = StringRe place(buff er, '_', '  ', [rfRep laceAll, r fIgnoreCas e]);
  20808     buffer : = StringRe place(buff er, '-', '  ', [rfRep laceAll, r fIgnoreCas e]);
  20809     buffer : = StringRe place(buff er, '+', '  ', [rfRep laceAll, r fIgnoreCas e]);
  20810     buffer : = StringRe place(buff er, '=', '  ', [rfRep laceAll, r fIgnoreCas e]);
  20811     buffer : = StringRe place(buff er, '[', '  ', [rfRep laceAll, r fIgnoreCas e]);
  20812     buffer : = StringRe place(buff er, ']', '  ', [rfRep laceAll, r fIgnoreCas e]);
  20813     buffer : = StringRe place(buff er, '{', '  ', [rfRep laceAll, r fIgnoreCas e]);
  20814     buffer : = StringRe place(buff er, '}', '  ', [rfRep laceAll, r fIgnoreCas e]);
  20815     buffer : = StringRe place(buff er, '|', '  ', [rfRep laceAll, r fIgnoreCas e]);
  20816     buffer : = StringRe place(buff er, '\', '  ', [rfRep laceAll, r fIgnoreCas e]);
  20817     buffer : = StringRe place(buff er, ':', '  ', [rfRep laceAll, r fIgnoreCas e]);
  20818     buffer : = StringRe place(buff er, ';', '  ', [rfRep laceAll, r fIgnoreCas e]);
  20819     buffer : = StringRe place(buff er, '"', '  ', [rfRep laceAll, r fIgnoreCas e]);
  20820     buffer : = StringRe place(buff er, '''',  ' ', [rfRe placeAll,  rfIgnoreCa se]);
  20821     buffer : = StringRe place(buff er, '<', '  ', [rfRep laceAll, r fIgnoreCas e]);
  20822     buffer : = StringRe place(buff er, '>', '  ', [rfRep laceAll, r fIgnoreCas e]);
  20823     buffer : = StringRe place(buff er, '?', '  ', [rfRep laceAll, r fIgnoreCas e]);
  20824     buffer : = StringRe place(buff er, ',', '  ', [rfRep laceAll, r fIgnoreCas e]);
  20825     buffer : = StringRe place(buff er, '.', '  ', [rfRep laceAll, r fIgnoreCas e]);
  20826     buffer : = StringRe place(buff er, '/', '  ', [rfRep laceAll, r fIgnoreCas e]);
  20827     Result : = buffer;
  20828   end;
  20829  
  20830   //-------- ---------- ---------- ---------- ---------- ---------- ---------- ----------
  20831   // Search  Text on Cl inical Doc uments Ric h Text fie ld         CodeCR696  JRL 4/8/15
  20832   //-------- ---------- ---------- ---------- ---------- ---------- ---------- ----------
  20833   // Search  text routi ne for the  Clinical  Documents  tab -- all ows the us er to
  20834   // right-c lick and s earch for  text withi n the rich  text fiel d
  20835   //-------- ---------- ---------- ---------- ---------- ---------- ---------- ----------
  20836  
  20837   procedure  TfrmMain.R unSearch(S earchStrin g: String) ;
  20838   var
  20839     tempstri ng, tempst ring2: str ing;
  20840   begin
  20841     SearchTe xt.FoundAt  := memoDo cs.FindTex t(SearchSt ring, Sear chText.Las tSearchFou ndAt, leng th(memoDoc s.Text), S earchText. Options);
  20842     if Searc hText.Foun dAt = -1 t hen
  20843     begin
  20844       ShowMe ssageCAPRI ('Search r eached end  of text.' );
  20845       MemoDo cs.SelStar t := 0;
  20846       MemoDo cs.SelLeng th := 0;
  20847       Search Text.Found At := 0;
  20848       Search Text.LastS earchFound At := 0;
  20849       Exit;
  20850     end;
  20851     if memoD ocs.CanFoc us then
  20852       memoDo cs.SetFocu s;
  20853      //First  jump to b ottom.
  20854     memoDocs .SelStart  := length( memoDocs.T ext) - 2;
  20855     memoDocs .SelLength  := 2;
  20856     tempStri ng := memo Docs.SelTe xt;
  20857     memoDocs .SelText : = '';
  20858     memoDocs .seltext : = tempstri ng;
  20859      //Now f ind text
  20860     memoDocs .SelStart  := SearchT ext.FoundA t;
  20861     memoDocs .SelLength  := Length (SearchStr ing);
  20862     tempstri ng2 := mem oDocs.SelT ext;
  20863      // Forc e jump to  section
  20864     memoDocs .SelText : = tempStri ng2;
  20865      // Re-H ighlight
  20866     memoDocs .SelStart  := SearchT ext.FoundA t;
  20867     memoDocs .SelLength  := Length (SearchStr ing);
  20868      // Scro ll down a  few lines
  20869     SearchTe xt.LastSea rchFoundAt  := Search Text.Found At + lengt h(SearchSt ring);
  20870   end;
  20871  
  20872  
  20873   //-------- ---------- ---------- ---------- ---------- ---------- ---------- ----------
  20874   // Find Po pup Menu I tem Clicke d                                CodeCR696  JRL 4/8/15
  20875   //-------- ---------- ---------- ---------- ---------- ---------- ---------- ----------
  20876  
  20877   procedure  TfrmMain.F ind1Click( Sender: TO bject);
  20878   begin
  20879     if MemoD ocs.CanFoc us then
  20880       MemoDo cs.SetFocu s;
  20881     MemoDocs .SelStart  := 0;
  20882     MemoDocs .SelLength  := 0;
  20883     SearchTe xt.FoundAt  := 0;
  20884     SearchTe xt.LastSea rchFoundAt  := 0;
  20885      // Orig inally, th ere was a  Find Dialo g execute  here.  But  it caused  an error
  20886      // on e xecute "Ca nnot focus  a disable d or invis ible windo w".  Was u nable to
  20887      // get  past the e rror so a  separate f orm was cr eated to m imic the s earch
  20888      // dial og with no  issue.  F orm is fre ed in FrmM ain.FormCl ose routin e.
  20889      // Code CR696 JRL  4/8/15
  20890     frmSearc hText := T frmSearchT ext.Create (Applicati on);
  20891     frmSearc hText.Show ;
  20892   // FindTex tDlg.Execu te;
  20893   end;
  20894  
  20895   //-------- ---------- ---------- ---------- ---------- ---------- ---------- ----------
  20896   // Find Ne xt Popup M enu Item C licked                           CodeCR696  JRL 4/8/15
  20897   //-------- ---------- ---------- ---------- ---------- ---------- ---------- ----------
  20898  
  20899   procedure  TfrmMain.F indNext1Cl ick(Sender : TObject) ;
  20900   begin
  20901     RunSearc h(SearchTe xt.FindTex t);
  20902     if MemoD ocs.CanFoc us then
  20903       MemoDo cs.SetFocu s;
  20904   end;
  20905  
  20906   //-------- ---------- ---------- ---------- ---------- ---------- ---------- ----------
  20907   // FindTex tDlg Find  button cli cked                             CodeCR696  JRL 4/8/15
  20908   // Find Di alog box c ould not b e made to  work - del eted
  20909   //-------- ---------- ---------- ---------- ---------- ---------- ---------- ----------
  20910   //procedur e TfrmMain .FindTextD lgFind(Sen der: TObje ct);
  20911   //begin
  20912   //   Searc hText.Opti ons := [];
  20913   //   Searc hText.Find Text := Fi ndTextDlg. FindText;
  20914   //   if fr MatchCase  in FindTex tDlg.Optio ns then    // case-se nsitive se arch?
  20915   //      Se archText.O ptions :=  [stMatchCa se];
  20916   //   if fr WholeWord  in FindTex tDlg.Optio ns then    // whole w ord search ?
  20917   //      Se archText.O ptions :=  [stWholeWo rd];
  20918   //   RunSe arch(Searc hText.Find Text);
  20919   //   if Me moDocs.Can Focus then
  20920   //      Me moDocs.Set Focus;
  20921   //end;
  20922  
  20923   //-------- ---------- ---------- ---------- ---------- ---------- ---------- ----------
  20924   // FindTex tDlg Dialo g Show                                      CodeCR696  JRL 4/8/15
  20925   // Find Di alog box c ould not b e made to  work - del eted
  20926   //-------- ---------- ---------- ---------- ---------- ---------- ---------- ----------
  20927   // Show th e dialog o n the left  side of t he screen  so the sea rched fiel ds are
  20928   // clearly  visible o n the righ t.
  20929   //-------- ---------- ---------- ---------- ---------- ---------- ---------- ----------
  20930   //procedur e TfrmMain .FindTextD lgShow(Sen der: TObje ct);
  20931   //begin
  20932   //   FindT extDlg.Top  := 50;
  20933   //   FindT extDlg.Lef t := 50;
  20934   //end;
  20935  
  20936   {========= ========== ========== ========== ========== ========== ========== =========
  20937    The follo wing initi alization  and finali zation was  added to  tap into t he call
  20938    stack fun ctionality  of the JC LDebug uni t. The cal l stack wi ll be incl uded in
  20939    the CAPRI  log file.
  20940  
  20941    CAPRI_Cod eCR94 - jc s - 03/02/ 10
  20942    ========= ========== ========== ========== ========== ========== ========== =========}
  20943   initializa tion
  20944  
  20945     // Enabl e raw mode  (default  mode uses  stack fram es which a ren't alwa ys generat ed by the  compiler)
  20946     Include( JclStackTr ackingOpti ons, stRaw Mode);
  20947  
  20948     // Disab le stack t racking in  dynamical ly loaded  modules (i t makes st ack tracki ng code a  bit faster )
  20949     Include( JclStackTr ackingOpti ons, stSta ticModuleL ist);
  20950  
  20951     // Initi alize Exce ption trac king
  20952     JclStart ExceptionT racking;
  20953  
  20954   finalizati on
  20955  
  20956     // Unini tialize Ex ception tr acking
  20957     JclStopE xceptionTr acking;
  20958  
  20959   End.
  20960