23. EPMO Open Source Coordination Office Redaction File Detail Report

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

23.1 Files compared

# Location File Last Modified
1 build 3.zip\build 3\MHLTH_YS_137_Source\Delphi\MHA_AUX uMHA_AUX.pas Thu Sep 6 11:30:32 2018 UTC
2 build 3.zip\build 3\MHLTH_YS_137_Source\Delphi\MHA_AUX uMHA_AUX.pas Wed Sep 12 16:03:39 2018 UTC

23.2 Comparison summary

Description Between
Files 1 and 2
Text Blocks Lines
Unchanged 3 3118
Changed 2 4
Inserted 0 0
Removed 0 0

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

23.4 Active regular expressions

No regular expressions were active.

23.5 Comparison detail

  1   unit uMHA_ AUX;
  2   // Handles  unusual,  complicate d instrume nts.
  3  
  4   // llh the re are man y changes  that were  slated for  patch 108  which was  never rel eased. Ref erences to  patch 108  are
  5   //     lef t unless i ntended ch anges are  being rele ased with  patch 129.
  6  
  7   interface
  8  
  9   uses
  10     windows,
  11     Classes,
  12     //patch  108 remove d fIA_dial ogs,
  13     //fIA_di alogs,
  14     SysUtils ,
  15     ComCtrls ,
  16     Trpcb,
  17     //llh -  patch 108
  18     StrUtils ,
  19     dialogs;
  20  
  21   procedure  DefaultAns wers(
  22     Instrume ntName,
  23     UserName ,
  24     StationC ode,
  25     StationS uffix,
  26     PatientN ame,
  27     PatientS SN,
  28     PatientD OB,
  29     PatientS ex,
  30     AnswerSt ring: stri ng;
  31     var
  32     ResultSt ring: stri ng); stdca ll;
  33  
  34   // Ensure  the answer s are corr ect.
  35   // Output  is error m essage: Bl ank output  means oka y.
  36   procedure  VerifyAnsw ers(
  37     Instrume ntName,
  38     PatientN ame,
  39     PatientD OB,
  40     PatientS ex,
  41     AnswerSt ring: stri ng;
  42     var
  43     ResultSt ring: stri ng); stdca ll;
  44  
  45  
  46   // Modify  acceptable  anwsers t o a prefer red or leg acy format
  47   // Output  is new ans wer list.
  48   procedure  GroomAnswe rs(
  49     Instrume ntName,
  50     PatientN ame,
  51     PatientD OB,
  52     PatientS ex,
  53     AnswerSt ring: stri ng;
  54     var
  55     ResultSt ring: stri ng); stdca ll;
  56  
  57  
  58   // Score t he answers . ~ScaleNa me^ScaleIE N^ScaleSco re~
  59   procedure  ScoreAnswe rs(
  60     Instrume ntName,
  61     PatientN ame,
  62     PatientD OB,
  63     PatientS ex,
  64     AnswerSt ring: stri ng;
  65     var
  66     ResultSt ring: stri ng); stdca ll;
  67  
  68  
  69   // Hard co ded report
  70   procedure  ProgressNo te(
  71     Instrume ntName,
  72     PatientN ame,
  73     PatientD OB,
  74     PatientS ex,
  75     AnswerSt ring: stri ng;
  76     var
  77     ResultSt ring: stri ng); stdca ll;
  78  
  79   // Special  operation s, custom  coding
  80   // Output  is new ans wer list.
  81   procedure  Custom(
  82     Instrume ntName,
  83     PatientN ame,
  84     PatientD OB,
  85     PatientS ex,
  86     AnswerSt ring: stri ng;
  87     var
  88     ResultSt ring: stri ng); stdca ll;
  89  
  90   // Output  is string,  placed on  form when  built
  91   procedure  StaticLook up(
  92     Instrume ntName,
  93     PatientI EN,
  94     OrderedB yDUZ: stri ng;
  95     var
  96     ResultSt ring: stri ng); stdca ll;
  97  
  98   // Output  is string,  placed on  form when  built
  99   procedure  VistaLooku p(
  100     Broker:  TRPCBroker ;
  101     Instrume ntName,
  102     PatientI EN,
  103     OrderedB yDUZ: stri ng;
  104     var
  105     ResultSt ring: stri ng); stdca ll;
  106  
  107   procedure  SpecialRes ults(
  108     var
  109     ResultSt ring: stri ng); stdca ll;
  110  
  111  
  112   implementa tion
  113  
  114   uses
  115     uMHA_AUX _BAI,
  116     uMHA_AUX _BDI2,
  117     uMHA_AUX _BHS,
  118     uMHA_AUX _BSI,
  119     uMHA_AUX _CAM,
  120     uMHA_AUX _SPSI,
  121     uMHA_AUX _WHODAS,
  122     uMHA_AUX _WHOQOL_BR EF,
  123     uMHA_AUX _STMS,
  124     uMHA_AUX _VR12,
  125     uMHA_AUX _POQ,
  126     uMHA_AUX _BASIS,
  127     uMHA_AUX _ISMI,
  128     uMHA_AUX _MINICOG,
  129     uMHA_AUX _AUDC,
  130     uMHA_AUX _WHYMPI,
  131     uMHA_AUX _NEOPI3,
  132     uMHA_AUX _BAM,
  133     uMHA_AUX _CDR,
  134     uMHA_AUX _SBR,
  135     uMHA_AUX _SBR_II,
  136     uMHA_AUX _FAST,
  137     uMHA_AUX _MMPI2RF,
  138     uMHA_AUX _QOLI,
  139     uMHA_AUX _MDQ,
  140     uMHA_AUX _DBAS,
  141     uMHA_AUX _SpecialRe sults,
  142     //patch  105, added  positive  negative s tatement t o PC PTSD  and PHQ2 i nstrument  llh
  143     uMHA_AUX _PC_PTSD,
  144     uMHA_AUX _PHQ2,
  145     //patch  108, added  SST-VOI &  SST-VOF,  SOCRATES 8 A and 8D,  BSL-23, DE RS, FAD, Q OLIE-31  l lh
  146     uMHA_AUX _SSTVOI,
  147     uMHA_AUX _SSTVOF,
  148     uMHA_AUX _SOCRATES_ 8A,
  149     uMHA_AUX _SOCRATES_ 8D,
  150     uMHA_AUX _BSL23,
  151     uMHA_AUX _DERS,
  152     uMHA_AUX _FAD,
  153     uMHA_AUX _QOLIE31;
  154  
  155  
  156   procedure  DefaultAns wers(
  157     Instrume ntName,
  158     UserName ,
  159     StationC ode,
  160     StationS uffix,
  161     PatientN ame,
  162     PatientS SN,
  163     PatientD OB,
  164     PatientS ex,
  165     AnswerSt ring: stri ng;
  166     var
  167     ResultSt ring: stri ng); stdca ll;
  168   begin
  169     ResultSt ring := '' ;
  170   (*
  171     if Pos(' PTSD STATU S FORM', U pperCase(I nstrumentN ame)) > 0  then
  172       begin
  173         Resu ltString : = DefaultA nswers_PTS D_Status_F orm(Instru mentName,
  174           Us erName,
  175           St ationCode,
  176           St ationSuffi x,
  177           Pa tientName,
  178           Pa tientSSN,
  179           Pa tientDOB,
  180           Pa tientSex,
  181           An swerString );
  182         Exit ;
  183       end;
  184       *)
  185   end;
  186  
  187  
  188   procedure  VerifyAnsw ers(
  189     Instrume ntName,
  190     PatientN ame,
  191     PatientD OB,
  192     PatientS ex,
  193     AnswerSt ring: stri ng;
  194     var
  195     ResultSt ring: stri ng); stdca ll;
  196   begin
  197     // Error  message
  198  
  199     ResultSt ring := '' ;
  200     (*
  201     if Pos(' PTSD STATU S FORM', U pperCase(I nstrumentN ame)) > 0  then
  202       begin
  203         Resu ltString : = Verify_P TSD_Status _Form(Inst rumentName ,
  204           Pa tientName,
  205           Pa tientDOB,
  206           Pa tientSex,
  207           An swerString );
  208         Exit ;
  209       end; * )
  210     (*
  211       if Pos(' DN S     A-A', Uppe rCase(Inst rumentName )) > 0 the n
  212       begin
  213           ResultStri ng := Veri fy_ DN S     A_A_Form(I nstrumentN ame,
  214           Pa tientName,
  215           Pa tientDOB,
  216           Pa tientSex,
  217           An swerString );
  218         Exit ;
  219       end; * )
  220  
  221     if Pos(' BAM', Uppe rCase(Inst rumentName )) > 0 the n
  222       begin
  223         if ( UpperCase( Instrument Name) = 'B AM') or
  224           (U pperCase(I nstrumentN ame) = 'BA M-R') or
  225           (U pperCase(I nstrumentN ame) = 'BA M-IOP') th en
  226           Re sultString  := Verify _BAM(Instr umentName,
  227              PatientNam e,
  228              PatientDOB ,
  229              PatientSex ,
  230              AnswerStri ng);
  231         if U pperCase(I nstrumentN ame) = 'BA M-C' then
  232           Re sultString  := Verify _BAMC(Inst rumentName ,
  233              PatientNam e,
  234              PatientDOB ,
  235              PatientSex ,
  236              AnswerStri ng);
  237         Exit ;
  238       end;
  239   end;
  240  
  241  
  242   procedure  GroomAnswe rs(Instrum entName,
  243     PatientN ame,
  244     PatientD OB,
  245     PatientS ex,
  246     AnswerSt ring: stri ng;
  247     var
  248     ResultSt ring: stri ng); stdca ll;
  249   begin
  250     ResultSt ring := '' ;
  251    (*
  252     if Pos(' PTSD STATU S FORM', U pperCase(I nstrumentN ame)) > 0  then
  253       begin
  254         Resu ltString : = GroomAns wers_PTSD_ Status_For m(Instrume ntName,
  255           Pa tientName,
  256           Pa tientDOB,
  257           Pa tientSex,
  258           An swerString );
  259         Exit ;
  260       end; * )
  261   end;
  262  
  263   procedure  ScoreAnswe rs(
  264     Instrume ntName,
  265     PatientN ame,
  266     PatientD OB,
  267     PatientS ex,
  268     AnswerSt ring: stri ng;
  269     var
  270     ResultSt ring: stri ng); stdca ll;
  271   // Output:  ~ScaleNam e^ScaleIEN ^ScaleScor e~
  272  
  273   // added l lh
  274   var
  275     TempStr                        : AnsiStri ng;
  276  
  277   begin
  278     ResultSt ring := '' ;
  279  
  280     // patch  108 added  QOLIE llh
  281     if Pos(' QOLIE-31',  UpperCase (Instrumen tName)) >  0 then
  282       begin
  283         Resu ltString : = ScoreAns wers_QOLIE 31(
  284           Pa tientName,
  285           Pa tientDOB,
  286           Pa tientSex,
  287           An swerString );
  288         Exit ;
  289       end;
  290  
  291     // patch  108 added  FAD llh
  292     if Pos(' FAD', Uppe rCase(Inst rumentName )) > 0 the n
  293       begin
  294         Resu ltString : = ScoreAns wers_FAD(
  295           Pa tientName,
  296           Pa tientDOB,
  297           Pa tientSex,
  298           An swerString );
  299         Exit ;
  300       end;
  301  
  302     // patch  108 added  DERS llh
  303     if Pos(' DERS', Upp erCase(Ins trumentNam e)) > 0 th en
  304       begin
  305         Resu ltString : = ScoreAns wers_DERS(
  306           Pa tientName,
  307           Pa tientDOB,
  308           Pa tientSex,
  309           An swerString );
  310         Exit ;
  311       end;
  312  
  313     // patch  108 added  BSL-23 ll h
  314     if Pos(' BSL-23', U pperCase(I nstrumentN ame)) > 0  then
  315       begin
  316         Resu ltString : = ScoreAns wers_BSL23 (
  317           Pa tientName,
  318           Pa tientDOB,
  319           Pa tientSex,
  320           An swerString );
  321         Exit ;
  322       end;
  323  
  324     // patch  108 added  SOCRATES_ 8D llh
  325     if Pos(' SOCRATES 8 D', UpperC ase(Instru mentName))  > 0 then
  326       begin
  327         Resu ltString : = ScoreAns wers_SOCRA TES_8D(
  328           Pa tientName,
  329           Pa tientDOB,
  330           Pa tientSex,
  331           An swerString );
  332         Exit ;
  333       end;
  334  
  335     // patch  108 added  SOCRATES_ 8A llh
  336     if Pos(' SOCRATES 8 A', UpperC ase(Instru mentName))  > 0 then
  337       begin
  338         Resu ltString : = ScoreAns wers_SOCRA TES_8A(
  339           Pa tientName,
  340           Pa tientDOB,
  341           Pa tientSex,
  342           An swerString );
  343         Exit ;
  344       end;
  345  
  346     // patch  108 added  SST-VOI l lh
  347     if Pos(' SST-VOI',  UpperCase( Instrument Name)) > 0  then
  348       begin
  349         Resu ltString : = ScoreAns wers_SSTVO I(
  350           Pa tientName,
  351           Pa tientDOB,
  352           Pa tientSex,
  353           An swerString );
  354         Exit ;
  355       end;
  356  
  357     // patch  108 added  SST-VOF l lh
  358     if Pos(' SST-VOF',  UpperCase( Instrument Name)) > 0  then
  359       begin
  360         Resu ltString : = ScoreAns wers_SSTVO F(
  361           Pa tientName,
  362           Pa tientDOB,
  363           Pa tientSex,
  364           An swerString );
  365         Exit ;
  366       end;
  367  
  368     if Pos(' BHS', Uppe rCase(Inst rumentName )) > 0 the n
  369       begin
  370         Resu ltString : = ScoreAns wers_BHS(
  371           An swerString );
  372         Exit ;
  373       end;
  374  
  375     if Pos(' BSI', Uppe rCase(Inst rumentName )) > 0 the n
  376       begin
  377         if I nstrumentN ame = 'BSI 18' then
  378           ex it;
  379         Resu ltString : = ScoreAns wers_BSI(
  380           An swerString );
  381         Exit ;
  382       end;
  383  
  384     if Pos(' SPSI', Upp erCase(Ins trumentNam e)) > 0 th en
  385       begin
  386         Resu ltString : = ScoreAns wers_SPSI(
  387           Pa tientName,
  388           Pa tientDOB,
  389           Pa tientSex,
  390           An swerString );
  391         Exit ;
  392       end;
  393  
  394     if Pos(' CAM', Uppe rCase(Inst rumentName )) > 0 the n
  395       begin
  396         Resu ltString : = ScoreAns wers_CAM(
  397           Pa tientName,
  398           Pa tientDOB,
  399           Pa tientSex,
  400           An swerString );
  401         Exit ;
  402       end;
  403  
  404     if Pos(' DBAS', Upp erCase(Ins trumentNam e)) > 0 th en
  405       begin
  406         Resu ltString : = ScoreAns wers_DBAS(
  407           Pa tientName,
  408           Pa tientDOB,
  409           Pa tientSex,
  410           An swerString );
  411         Exit ;
  412       end;
  413  
  414     if Pos(' MDQ', Uppe rCase(Inst rumentName )) > 0 the n
  415       begin
  416         Resu ltString : = ScoreAns wers_MDQ(
  417           Pa tientName,
  418           Pa tientDOB,
  419           Pa tientSex,
  420           An swerString );
  421         Exit ;
  422       end;
  423  
  424     // llh -  patch 108 , there ar e now 3 QO LIE instru ments, onl y 2 use th e AUX
  425     //        BUT the P os functio n returned  true for  the QOLIE- 10, change d to use C ompareStr
  426     //if Pos ('QOLI', U pperCase(I nstrumentN ame)) > 0  then
  427     if Compa reStr('QOL I', UpperC ase(Instru mentName))  = 0  then
  428       begin
  429         Resu ltString : = ScoreAns wers_QOLI(
  430           Pa tientName,
  431           Pa tientDOB,
  432           Pa tientSex,
  433           An swerString );
  434         Exit ;
  435       end;
  436  
  437     if Pos(' MMPI-2-RF' , UpperCas e(Instrume ntName)) >  0 then
  438       begin
  439         Resu ltString : = ScoreAns wers_MMPI2 RF(
  440           Pa tientName,
  441           Pa tientDOB,
  442           Pa tientSex,
  443           An swerString );
  444         Exit ;
  445       end;
  446  
  447     if Pos(' WHODAS 2',  UpperCase (Instrumen tName)) >  0 then
  448       begin
  449         Resu ltString : = ScoreAns wers_WHODA S(
  450           Pa tientName,
  451           Pa tientDOB,
  452           Pa tientSex,
  453           An swerString );
  454         Exit ;
  455       end;
  456  
  457     if Pos(' WHOQOL-BRE F', UpperC ase(Instru mentName))  > 0 then
  458       begin
  459         Resu ltString : = ScoreAns wers_WHOQO L_BREF(
  460           Pa tientName,
  461           Pa tientDOB,
  462           Pa tientSex,
  463           An swerString );
  464         Exit ;
  465       end;
  466  
  467     if Pos(' NEO-PI-3',  UpperCase (Instrumen tName)) >  0 then
  468       begin
  469       // Out put: ~Scal eName^RawS core^T-Sco re~
  470         Resu ltString : = ScoreAns wers_NEOPI 3(
  471           Pa tientName,
  472           Pa tientDOB,
  473           Pa tientSex,
  474           An swerString );
  475         Exit ;
  476       end;
  477  
  478  
  479     if Pos(' VR-12', Up perCase(In strumentNa me)) > 0 t hen
  480       begin
  481         Resu ltString : = ScoreAns wers_VR12(
  482           Pa tientName,
  483           Pa tientDOB,
  484           Pa tientSex,
  485           An swerString );
  486         Exit ;
  487       end;
  488  
  489     if Pos(' BAM-C', Up perCase(In strumentNa me)) > 0 t hen
  490       begin
  491         Resu ltString : = ScoreAns wers_BAMC(
  492           Pa tientName,
  493           Pa tientDOB,
  494           Pa tientSex,
  495           An swerString );
  496         Exit ;
  497       end;
  498  
  499     if Pos(' BAM-R', Up perCase(In strumentNa me)) > 0 t hen
  500       begin
  501         Resu ltString : = ScoreAns wers_BAMR(
  502           Pa tientName,
  503           Pa tientDOB,
  504           Pa tientSex,
  505           An swerString );
  506         Exit ;
  507       end;
  508  
  509     if Pos(' WHYMPI', U pperCase(I nstrumentN ame)) > 0  then
  510       begin
  511         Resu ltString : = ScoreAns wers_WHYMP I(
  512           Pa tientName,
  513           Pa tientDOB,
  514           Pa tientSex,
  515           An swerString );
  516         Exit ;
  517       end;
  518  
  519     if Pos(' MINICOG',  UpperCase( Instrument Name)) > 0  then
  520       begin
  521         Resu ltString : = ScoreAns wers_MINIC OG(
  522           Pa tientName,
  523           Pa tientDOB,
  524           Pa tientSex,
  525           An swerString );
  526         Exit ;
  527       end;
  528  
  529     if Pos(' STMS', Upp erCase(Ins trumentNam e)) > 0 th en
  530       begin
  531         Resu ltString : = ScoreAns wers_STMS(
  532           Pa tientName,
  533           Pa tientDOB,
  534           Pa tientSex,
  535           An swerString );
  536         Exit ;
  537       end;
  538  
  539     if Pos(' BASIS-24',  UpperCase (Instrumen tName)) >  0 then
  540       begin
  541         Resu ltString : = ScoreAns wers_BASIS (
  542           Pa tientName,
  543           Pa tientDOB,
  544           Pa tientSex,
  545           An swerString );
  546         Exit ;
  547       end;
  548  
  549     if Pos(' ISMI', Upp erCase(Ins trumentNam e)) > 0 th en
  550       begin
  551         Resu ltString : = ScoreAns wers_ISMI(
  552           Pa tientName,
  553           Pa tientDOB,
  554           Pa tientSex,
  555           An swerString );
  556         Exit ;
  557       end;
  558  
  559     if Pos(' POQ', Uppe rCase(Inst rumentName )) > 0 the n
  560       begin
  561         Resu ltString : = ScoreAns wers_POQ(
  562           Pa tientName,
  563           Pa tientDOB,
  564           Pa tientSex,
  565           An swerString );
  566         Exit ;
  567       end;
  568  
  569     if Pos(' FAST', Upp erCase(Ins trumentNam e)) > 0 th en
  570       begin
  571         Resu ltString : = ScoreAns wers_FAST(
  572           Pa tientName,
  573           Pa tientDOB,
  574           Pa tientSex,
  575           An swerString );
  576         Exit ;
  577       end;
  578  
  579     if Pos(' CDR', Uppe rCase(Inst rumentName )) > 0 the n
  580       begin
  581         Resu ltString : = ScoreAns wers_CDR(
  582           Pa tientName,
  583           Pa tientDOB,
  584           Pa tientSex,
  585           An swerString );
  586         Exit ;
  587       end;
  588  
  589     if Pos(' SBR II', U pperCase(I nstrumentN ame)) > 0  then
  590       begin
  591         Resu ltString : = ScoreAns wers_SBR_I I(
  592           Pa tientName,
  593           Pa tientDOB,
  594           Pa tientSex,
  595           An swerString );
  596         Exit ;
  597       end;
  598  
  599   //  if Pos ('AUDC', U pperCase(I nstrumentN ame)) > 0  then
  600   //    begi n
  601   //      Re sultString  := ScoreA nswers_AUD C(
  602   //         AnswerStri ng);
  603   //      Ex it;
  604   //    end;
  605  
  606   {
  607     if Pos(' BAI', Uppe rCase(Inst rumentName )) > 0 the n
  608       begin
  609         Resu ltString : = ScoreAns wers_BAI(
  610           An swerString );
  611         Exit ;
  612       end;
  613   }
  614  
  615   {
  616     if Pos(' BDI2', Upp erCase(Ins trumentNam e)) > 0 th en
  617       begin
  618         Resu ltString : = ScoreAns wers_BDI2(
  619           An swerString );
  620         Exit ;
  621       end;
  622   }
  623   end;
  624  
  625  
  626   procedure  ProgressNo te(
  627     Instrume ntName,
  628     PatientN ame,
  629     PatientD OB,
  630     PatientS ex,
  631     AnswerSt ring: stri ng;
  632     var
  633     ResultSt ring: stri ng); stdca ll;
  634   // NOTE:   <.DLL_Stri ng.> provi des locati on for thi s string i n the
  635   // report.
  636  
  637   var
  638     TempStr                        : string;
  639   begin
  640     ResultSt ring := '' ;
  641  
  642     //patch  108, added  QOLIE 31  llh
  643     if Pos(' QOLIE-31',  UpperCase (Instrumen tName)) >  0 then
  644       begin
  645         Temp Str := Sco reAnswers_ QOLIE31(
  646           Pa tientName,
  647           Pa tientDOB,
  648           Pa tientSex,
  649           An swerString );
  650  
  651         if T empStr = ' ' then
  652           Ex it;
  653  
  654         Resu ltString : = Progress Note_QOLIE 31(
  655           Pa tientName,
  656           Pa tientDOB,
  657           Pa tientSex,
  658           Te mpStr,
  659           An swerString );
  660         Exit ;
  661       end;
  662  
  663     //patch  108, added  FAD llh
  664     if Pos(' FAD', Uppe rCase(Inst rumentName )) > 0 the n
  665       begin
  666         Temp Str := Sco reAnswers_ FAD(
  667           Pa tientName,
  668           Pa tientDOB,
  669           Pa tientSex,
  670           An swerString );
  671  
  672         if T empStr = ' ' then
  673           Ex it;
  674  
  675         Resu ltString : = Progress Note_FAD(
  676           Pa tientName,
  677           Pa tientDOB,
  678           Pa tientSex,
  679           Te mpStr,
  680           An swerString );
  681         Exit ;
  682       end;
  683  
  684     //patch  108, added  DERS llh
  685     if Pos(' DERS', Upp erCase(Ins trumentNam e)) > 0 th en
  686       begin
  687         Temp Str := Sco reAnswers_ DERS(
  688           Pa tientName,
  689           Pa tientDOB,
  690           Pa tientSex,
  691           An swerString );
  692  
  693         if T empStr = ' ' then
  694           Ex it;
  695  
  696         Resu ltString : = Progress Note_DERS(
  697           Pa tientName,
  698           Pa tientDOB,
  699           Pa tientSex,
  700           Te mpStr,
  701           An swerString );
  702         Exit ;
  703       end;
  704  
  705     //patch  108, added  BSL-23 ll h
  706     if Pos(' BSL-23', U pperCase(I nstrumentN ame)) > 0  then
  707       begin
  708         Temp Str := Sco reAnswers_ BSL23(
  709           Pa tientName,
  710           Pa tientDOB,
  711           Pa tientSex,
  712           An swerString );
  713  
  714         if T empStr = ' ' then
  715           Ex it;
  716  
  717         Resu ltString : = Progress Note_BSL23 (
  718           Pa tientName,
  719           Pa tientDOB,
  720           Pa tientSex,
  721           Te mpStr,
  722           An swerString );
  723         Exit ;
  724       end;
  725  
  726     //patch  108, added  SOCRATES  8D llh
  727     if Pos(' SOCRATES 8 D', UpperC ase(Instru mentName))  > 0 then
  728       begin
  729         Temp Str := Sco reAnswers_ SOCRATES_8 D(
  730           Pa tientName,
  731           Pa tientDOB,
  732           Pa tientSex,
  733           An swerString );
  734  
  735         if T empStr = ' ' then
  736           Ex it;
  737  
  738         Resu ltString : = Progress Note_SOCRA TES_8D(
  739           Pa tientName,
  740           Pa tientDOB,
  741           Pa tientSex,
  742           Te mpStr,
  743           An swerString );
  744         Exit ;
  745       end;
  746  
  747     //patch  108, added  SOCRATES  8A llh
  748     if Pos(' SOCRATES 8 A', UpperC ase(Instru mentName))  > 0 then
  749       begin
  750         Temp Str := Sco reAnswers_ SOCRATES_8 A(
  751           Pa tientName,
  752           Pa tientDOB,
  753           Pa tientSex,
  754           An swerString );
  755  
  756         if T empStr = ' ' then
  757           Ex it;
  758  
  759         Resu ltString : = Progress Note_SOCRA TES_8A(
  760           Pa tientName,
  761           Pa tientDOB,
  762           Pa tientSex,
  763           Te mpStr,
  764           An swerString );
  765         Exit ;
  766       end;
  767  
  768     //patch  108, added  SST-VOI l lh
  769     if Pos(' SST-VOI',  UpperCase( Instrument Name)) > 0  then
  770       begin
  771         Temp Str := Sco reAnswers_ SSTVOI(
  772           Pa tientName,
  773           Pa tientDOB,
  774           Pa tientSex,
  775           An swerString );
  776  
  777         if T empStr = ' ' then
  778           Ex it;
  779  
  780         Resu ltString : = Progress Note_SSTVO I(
  781           Pa tientName,
  782           Pa tientDOB,
  783           Pa tientSex,
  784           Te mpStr,
  785           An swerString );
  786         Exit ;
  787       end;
  788  
  789     //patch  108, added  SST-VOF l lh
  790     if Pos(' SST-VOF',  UpperCase( Instrument Name)) > 0  then
  791       begin
  792         Temp Str := Sco reAnswers_ SSTVOF(
  793           Pa tientName,
  794           Pa tientDOB,
  795           Pa tientSex,
  796           An swerString );
  797  
  798         if T empStr = ' ' then
  799           Ex it;
  800  
  801         Resu ltString : = Progress Note_SSTVO F(
  802           Pa tientName,
  803           Pa tientDOB,
  804           Pa tientSex,
  805           Te mpStr,
  806           An swerString );
  807         Exit ;
  808       end;
  809  
  810     // patch  105, adde d PHQ-2 so  that posi tive and n egative st atements c an be adde d to repor t llh
  811       if Pos ('PHQ-2',  UpperCase( Instrument Name)) > 0  then
  812       begin
  813         Temp Str := Sco reAnswers_ PHQ2(
  814           An swerString );
  815  
  816         if T empStr = ' ' then
  817           Ex it;
  818  
  819         Resu ltString : = Progress Note_PHQ2(
  820           Te mpStr);
  821  
  822         Exit ;
  823       end;
  824  
  825     // patch  105, adde d PC PTSD  so that po sitive and  negative  statements  can be ad ded to rep ort llh
  826       if Pos ('PC PTSD' , UpperCas e(Instrume ntName)) >  0 then
  827       begin
  828         Temp Str := Sco reAnswers_ PCPTSD(
  829           An swerString );
  830  
  831         if T empStr = ' ' then
  832           Ex it;
  833  
  834         Resu ltString : = Progress Note_PCPTS D(
  835           Te mpStr);
  836  
  837         Exit ;
  838       end;
  839  
  840     if Pos(' BAI', Uppe rCase(Inst rumentName )) > 0 the n
  841       begin
  842         Temp Str := Sco reAnswers_ BAI(
  843           An swerString );
  844  
  845         if T empStr = ' ' then
  846           Ex it;
  847  
  848         Resu ltString : = Progress Note_BAI(
  849           Te mpStr);
  850  
  851         Exit ;
  852       end;
  853  
  854     if Pos(' BDI2', Upp erCase(Ins trumentNam e)) > 0 th en
  855       begin
  856         Temp Str := Sco reAnswers_ BDI2(
  857           An swerString );
  858  
  859         if T empStr = ' ' then
  860           Ex it;
  861  
  862         Resu ltString : = Progress Note_BDI2(
  863           Te mpStr);
  864  
  865         Exit ;
  866       end;
  867  
  868     if Pos(' BHS', Uppe rCase(Inst rumentName )) > 0 the n
  869       begin
  870         Temp Str := Sco reAnswers_ BHS(
  871           An swerString );
  872  
  873         if T empStr = ' ' then
  874           Ex it;
  875  
  876         Resu ltString : = Progress Note_BHS(
  877           Te mpStr);
  878  
  879         Exit ;
  880       end;
  881  
  882     if Pos(' BSI', Uppe rCase(Inst rumentName )) > 0 the n
  883       begin
  884         if I nstrumentN ame = 'BSI 18' then
  885           ex it;
  886  
  887         Temp Str := Sco reAnswers_ BSI(
  888           An swerString );
  889  
  890         if T empStr = ' ' then
  891           Ex it;
  892  
  893         Resu ltString : = Progress Note_BSI(
  894           Te mpStr);
  895  
  896         Exit ;
  897       end;
  898  
  899     if Pos(' SPSI', Upp erCase(Ins trumentNam e)) > 0 th en
  900       begin
  901         Temp Str := Sco reAnswers_ SPSI(
  902           Pa tientName,
  903           Pa tientDOB,
  904           Pa tientSex,
  905           An swerString );
  906  
  907         if T empStr = ' ' then
  908           Ex it;
  909  
  910         Resu ltString : = Progress Note_SPSI(
  911           Pa tientName,
  912           Pa tientDOB,
  913           Pa tientSex,
  914           Te mpStr,
  915           An swerString );
  916         Exit ;
  917       end;
  918  
  919     if Pos(' CAM', Uppe rCase(Inst rumentName )) > 0 the n
  920       begin
  921         Temp Str := Sco reAnswers_ CAM(
  922           Pa tientName,
  923           Pa tientDOB,
  924           Pa tientSex,
  925           An swerString );
  926  
  927         if T empStr = ' ' then
  928           Ex it;
  929  
  930         Resu ltString : = Progress Note_CAM(
  931           Pa tientName,
  932           Pa tientDOB,
  933           Pa tientSex,
  934           Te mpStr,
  935           An swerString );
  936         Exit ;
  937       end;
  938  
  939     if Pos(' DBAS', Upp erCase(Ins trumentNam e)) > 0 th en
  940       begin
  941         Temp Str := Sco reAnswers_ DBAS(
  942           Pa tientName,
  943           Pa tientDOB,
  944           Pa tientSex,
  945           An swerString );
  946  
  947         if T empStr = ' ' then
  948           Ex it;
  949  
  950         Resu ltString : = Progress Note_DBAS(
  951           Pa tientName,
  952           Pa tientDOB,
  953           Pa tientSex,
  954           Te mpStr,
  955           An swerString );
  956         Exit ;
  957       end;
  958  
  959     if Pos(' MDQ', Uppe rCase(Inst rumentName )) > 0 the n
  960       begin
  961         Temp Str := Sco reAnswers_ MDQ(
  962           Pa tientName,
  963           Pa tientDOB,
  964           Pa tientSex,
  965           An swerString );
  966  
  967         if T empStr = ' ' then
  968           Ex it;
  969  
  970         Resu ltString : = Progress Note_MDQ(
  971           Pa tientName,
  972           Pa tientDOB,
  973           Pa tientSex,
  974           Te mpStr,
  975           An swerString );
  976         Exit ;
  977       end;
  978  
  979     if Pos(' QOLI', Upp erCase(Ins trumentNam e)) > 0 th en
  980       begin
  981         Temp Str := Sco reAnswers_ QOLI(
  982           Pa tientName,
  983           Pa tientDOB,
  984           Pa tientSex,
  985           An swerString );
  986  
  987         if T empStr = ' ' then
  988           Ex it;
  989  
  990         Resu ltString : = Progress Note_QOLI(
  991           Pa tientName,
  992           Pa tientDOB,
  993           Pa tientSex,
  994           Te mpStr,
  995           An swerString );
  996         Exit ;
  997       end;
  998  
  999  
  1000     if Pos(' MMPI-2-RF' , UpperCas e(Instrume ntName)) >  0 then
  1001       begin
  1002  
  1003         Temp Str := Sco reAnswers_ MMPI2RF(
  1004           Pa tientName,
  1005           Pa tientDOB,
  1006           Pa tientSex,
  1007           An swerString );
  1008  
  1009         if T empStr = ' ' then
  1010           Ex it;
  1011  
  1012         Resu ltString : = Progress Note_MMPI2 RF(
  1013           Pa tientName,
  1014           Pa tientDOB,
  1015           Pa tientSex,
  1016           Te mpStr);
  1017  
  1018         Exit ;
  1019       end;
  1020  
  1021  
  1022     if Pos(' WHODAS 2',  UpperCase (Instrumen tName)) >  0 then
  1023       begin
  1024  
  1025         Temp Str := Sco reAnswers_ WHODAS(
  1026           Pa tientName,
  1027           Pa tientDOB,
  1028           Pa tientSex,
  1029           An swerString );
  1030  
  1031         if T empStr = ' ' then
  1032           Ex it;
  1033  
  1034         Resu ltString : = Progress Note_WHODA S(
  1035           Pa tientName,
  1036           Pa tientDOB,
  1037           Pa tientSex,
  1038           Te mpStr,
  1039           An swerString );
  1040  
  1041         Exit ;
  1042       end;
  1043  
  1044     if Pos(' WHOQOL-BRE F', UpperC ase(Instru mentName))  > 0 then
  1045       begin
  1046  
  1047         Temp Str := Sco reAnswers_ WHOQOL_BRE F(
  1048           Pa tientName,
  1049           Pa tientDOB,
  1050           Pa tientSex,
  1051           An swerString );
  1052  
  1053         if T empStr = ' ' then
  1054           Ex it;
  1055  
  1056         Resu ltString : = Progress Note_WHOQO L_BREF(
  1057           Pa tientName,
  1058           Pa tientDOB,
  1059           Pa tientSex,
  1060           Te mpStr,
  1061           An swerString );
  1062  
  1063         Exit ;
  1064       end;
  1065  
  1066     if Pos(' NEO-PI-3',  UpperCase (Instrumen tName)) >  0 then
  1067       begin
  1068         // T his has ra w and t-sc ores
  1069         Temp Str := Sco reAnswers_ NEOPI3(
  1070           Pa tientName,
  1071           Pa tientDOB,
  1072           Pa tientSex,
  1073           An swerString );
  1074  
  1075         if T empStr = ' ' then
  1076           Ex it;
  1077  
  1078         Resu ltString : = Progress Note_NEOPI 3(
  1079           Pa tientName,
  1080           Pa tientDOB,
  1081           Pa tientSex,
  1082           Te mpStr,
  1083           An swerString );
  1084  
  1085         Exit ;
  1086       end;
  1087  
  1088     if Pos(' BAM-C', Up perCase(In strumentNa me)) > 0 t hen
  1089       begin
  1090  
  1091         Temp Str := Sco reAnswers_ BAMC(
  1092           Pa tientName,
  1093           Pa tientDOB,
  1094           Pa tientSex,
  1095           An swerString );
  1096  
  1097         if T empStr = ' ' then
  1098           Ex it;
  1099  
  1100         Resu ltString : = Progress Note_BAMC(
  1101           Pa tientName,
  1102           Pa tientDOB,
  1103           Pa tientSex,
  1104           Te mpStr,
  1105           An swerString );
  1106  
  1107         Exit ;
  1108       end;
  1109  
  1110     if Pos(' BAM-R', Up perCase(In strumentNa me)) > 0 t hen
  1111       begin
  1112         Temp Str := Sco reAnswers_ BAMR(
  1113           Pa tientName,
  1114           Pa tientDOB,
  1115           Pa tientSex,
  1116           An swerString );
  1117  
  1118         if T empStr = ' ' then
  1119           Ex it;
  1120  
  1121         Resu ltString : = Progress Note_BAMR(
  1122           Pa tientName,
  1123           Pa tientDOB,
  1124           Pa tientSex,
  1125          Tem pStr,
  1126           An swerString );
  1127  
  1128         Exit ;
  1129       end;
  1130  
  1131     if Pos(' VR-12', Up perCase(In strumentNa me)) > 0 t hen
  1132       begin
  1133  
  1134         Temp Str := Sco reAnswers_ VR12(
  1135           Pa tientName,
  1136           Pa tientDOB,
  1137           Pa tientSex,
  1138           An swerString );
  1139  
  1140         if T empStr = ' ' then
  1141           Ex it;
  1142  
  1143         Resu ltString : = Progress Note_VR12(
  1144           Pa tientName,
  1145           Pa tientDOB,
  1146           Pa tientSex,
  1147           Te mpStr,
  1148           An swerString );
  1149  
  1150         Exit ;
  1151       end;
  1152  
  1153     if Pos(' MINICOG',  UpperCase( Instrument Name)) > 0  then
  1154       begin
  1155  
  1156         Temp Str := Sco reAnswers_ MINICOG(
  1157           Pa tientName,
  1158           Pa tientDOB,
  1159           Pa tientSex,
  1160           An swerString );
  1161  
  1162         if T empStr = ' ' then
  1163           Ex it;
  1164  
  1165         Resu ltString : = Progress Note_MINIC OG(
  1166           Pa tientName,
  1167           Pa tientDOB,
  1168           Pa tientSex,
  1169           Te mpStr,
  1170           An swerString );
  1171  
  1172         Exit ;
  1173       end;
  1174  
  1175     if Pos(' STMS', Upp erCase(Ins trumentNam e)) > 0 th en
  1176       begin
  1177  
  1178         Temp Str := Sco reAnswers_ STMS(
  1179           Pa tientName,
  1180           Pa tientDOB,
  1181           Pa tientSex,
  1182           An swerString );
  1183  
  1184         if T empStr = ' ' then
  1185           Ex it;
  1186  
  1187         Resu ltString : = Progress Note_STMS(
  1188           Pa tientName,
  1189           Pa tientDOB,
  1190           Pa tientSex,
  1191           Te mpStr,
  1192           An swerString );
  1193  
  1194         Exit ;
  1195       end;
  1196  
  1197     if Pos(' CDR', Uppe rCase(Inst rumentName )) > 0 the n
  1198       begin
  1199  
  1200         Temp Str := Sco reAnswers_ CDR(
  1201           Pa tientName,
  1202           Pa tientDOB,
  1203           Pa tientSex,
  1204           An swerString );
  1205  
  1206         if T empStr = ' ' then
  1207           Ex it;
  1208  
  1209         Resu ltString : = Progress Note_CDR(
  1210           Pa tientName,
  1211           Pa tientDOB,
  1212           Pa tientSex,
  1213           Te mpStr,
  1214           An swerString );
  1215  
  1216         Exit ;
  1217       end;
  1218  
  1219     if Pos(' FAST', Upp erCase(Ins trumentNam e)) > 0 th en
  1220       begin
  1221  
  1222         Temp Str := Sco reAnswers_ FAST(
  1223           Pa tientName,
  1224           Pa tientDOB,
  1225           Pa tientSex,
  1226           An swerString );
  1227  
  1228         if T empStr = ' ' then
  1229           Ex it;
  1230  
  1231         Resu ltString : = Progress Note_FAST(
  1232           Pa tientName,
  1233           Pa tientDOB,
  1234           Pa tientSex,
  1235           Te mpStr,
  1236           An swerString );
  1237  
  1238         Exit ;
  1239       end;
  1240  
  1241     if Pos(' BASIS-24',  UpperCase (Instrumen tName)) >  0 then
  1242       begin
  1243         Temp Str := Sco reAnswers_ BASIS(
  1244           Pa tientName,
  1245           Pa tientDOB,
  1246           Pa tientSex,
  1247           An swerString );
  1248  
  1249         if T empStr = ' ' then
  1250           Ex it;
  1251  
  1252         Resu ltString : = Progress Note_BASIS (
  1253           Pa tientName,
  1254           Pa tientDOB,
  1255           Pa tientSex,
  1256           Te mpStr,
  1257           An swerString );
  1258  
  1259         Exit ;
  1260       end;
  1261  
  1262     if Pos(' ISMI', Upp erCase(Ins trumentNam e)) > 0 th en
  1263       begin
  1264  
  1265         Temp Str := Sco reAnswers_ ISMI(
  1266           Pa tientName,
  1267           Pa tientDOB,
  1268           Pa tientSex,
  1269           An swerString );
  1270  
  1271         if T empStr = ' ' then
  1272           Ex it;
  1273  
  1274         Resu ltString : = Progress Note_ISMI(
  1275           Pa tientName,
  1276           Pa tientDOB,
  1277           Pa tientSex,
  1278           Te mpStr,
  1279           An swerString );
  1280  
  1281         Exit ;
  1282       end;
  1283  
  1284      // Scre en reader  version: p lace befor e the non- screen rea der
  1285     if Pos(' POQ-SR', U pperCase(I nstrumentN ame)) > 0  then
  1286       begin
  1287         Temp Str := Sco reAnswers_ POQ(
  1288           Pa tientName,
  1289           Pa tientDOB,
  1290           Pa tientSex,
  1291           An swerString );
  1292  
  1293         if T empStr = ' ' then
  1294           Ex it;
  1295  
  1296         Resu ltString : = Progress Note_POQ_S R(
  1297           Pa tientName,
  1298           Pa tientDOB,
  1299           Pa tientSex,
  1300           Te mpStr,
  1301           An swerString );
  1302  
  1303         Exit ;
  1304       end;
  1305  
  1306     if Pos(' POQ', Uppe rCase(Inst rumentName )) > 0 the n
  1307       begin
  1308  
  1309         Temp Str := Sco reAnswers_ POQ(
  1310           Pa tientName,
  1311           Pa tientDOB,
  1312           Pa tientSex,
  1313           An swerString );
  1314  
  1315         if T empStr = ' ' then
  1316           Ex it;
  1317  
  1318         Resu ltString : = Progress Note_POQ(
  1319           Pa tientName,
  1320           Pa tientDOB,
  1321           Pa tientSex,
  1322           Te mpStr,
  1323           An swerString );
  1324  
  1325         Exit ;
  1326       end;
  1327  
  1328     if Instr umentName  = 'AUDC' t hen
  1329       begin
  1330         Temp Str := Sco reAnswers_ AUDC(
  1331           An swerString );
  1332  
  1333         if T empStr = ' ' then
  1334           Ex it;
  1335  
  1336         Resu ltString : = Progress Note_AUDC(
  1337           Pa tientSex,
  1338           Te mpStr);
  1339         Exit ;
  1340       end;
  1341  
  1342     if Pos(' WHYMPI', U pperCase(I nstrumentN ame)) > 0  then
  1343       begin
  1344  
  1345         Temp Str := Sco reAnswers_ WHYMPI(
  1346           Pa tientName,
  1347           Pa tientDOB,
  1348           Pa tientSex,
  1349           An swerString );
  1350  
  1351         if T empStr = ' ' then
  1352           Ex it;
  1353  
  1354         Resu ltString : = Progress Note_WHYMP I(
  1355           Pa tientName,
  1356           Pa tientDOB,
  1357           Pa tientSex,
  1358           Te mpStr,
  1359           An swerString );
  1360  
  1361         Exit ;
  1362       end;
  1363  
  1364     if Pos(' SBR II', U pperCase(I nstrumentN ame)) > 0  then
  1365       begin
  1366  
  1367         Temp Str := Sco reAnswers_ SBR_II(
  1368           Pa tientName,
  1369           Pa tientDOB,
  1370           Pa tientSex,
  1371           An swerString );
  1372  
  1373         if T empStr = ' ' then
  1374           Ex it;
  1375  
  1376         Resu ltString : = Progress Note_SBR_I I(
  1377           Pa tientName,
  1378           Pa tientDOB,
  1379           Pa tientSex,
  1380           Te mpStr,
  1381           An swerString );
  1382  
  1383         Exit ;
  1384       end;
  1385   end;
  1386  
  1387   procedure  Custom(
  1388     Instrume ntName,
  1389     PatientN ame,
  1390     PatientD OB,
  1391     PatientS ex,
  1392     AnswerSt ring: stri ng;
  1393     var
  1394     ResultSt ring: stri ng); stdca ll;
  1395  
  1396   begin
  1397     ResultSt ring := '' ;
  1398     (*
  1399     if Trim( Instrument Name) = 'R OGERS BOGU S' then
  1400       begin
  1401  
  1402         Resu ltString : = Custom_B OGUS(
  1403           Pa tientName,
  1404           Pa tientDOB,
  1405           Pa tientSex,
  1406           An swerString );
  1407       end;
  1408       *)
  1409   end;
  1410  
  1411   procedure  StaticLook up(
  1412     Instrume ntName,
  1413     PatientI EN,
  1414     OrderedB yDUZ: stri ng;
  1415     var
  1416     ResultSt ring: stri ng); stdca ll;
  1417   // ResultS tring look s like:
  1418   //     Num ber=text^N umber=Text
  1419   //     whe re number  is place i n form's s equence
  1420   begin
  1421     ResultSt ring := '' ;
  1422  
  1423     if Trim( Instrument Name) = 'G DS DEMENTI A' then
  1424       begin
  1425         Resu ltString : =
  1426  
  1427         '0=                           Global  Deteriorat ion Scale'  + #13 + # 13 +
  1428           '1 . No cogni tive decli ne' + #13  +
  1429           'N o subjecti ve complai nts of mem ory defici t. No memo ry deficit  evident o n ' +
  1430           'c linical in terview. '  + #13 + # 13 +
  1431  
  1432         '2.  Very mild  cognitive  decline (A ge Associa ted Memory  Impairmen t) ' + #13  +
  1433           'S ubjective  complaints  of memory  deficit,  most frequ ently in f ollowing a reas: (a)  ' +
  1434           'f orgetting  where one  has placed  familiar  objects; ( b) forgett ing names  one ' +
  1435           'f ormerly kn ew well. N o objectiv e evidence  of memory  deficit o n clinical  ' +
  1436           'i nterview.  No objecti ve deficit s in emplo yment or s ocial situ ations. Ap propriate  ' +
  1437           'c oncern wit h respect  to symptom atology. '  + #13 + # 13 +
  1438  
  1439         '3.  Mild cogni tive decli ne (Mild C ognitive I mpairment)  ' + #13 +
  1440           'E arliest cl ear-cut de ficits. Ma nifestatio ns in more  than one  of the fol lowing are as: ' +
  1441           '( a) patient  may have  gotten los t when tra veling to  an unfamil iar locati on; (b) co workers '  +
  1442           'b ecome awar e of patie nt''s rela tively poo r performa nce; (c) w ord and '  +
  1443           'n ame findin g deficit  becomes ev ident to i ntimates;  (d) patien t may read  a passage  ' +
  1444           'o r a book a nd retain  relatively  little ma terial; (e ) patient  may demons trate ' +
  1445           'd ecreased f acility in  rememberi ng names u pon introd uction to  new people ; (f) ' +
  1446           'p atient may  have lost  or mispla ced an obj ect of val ue; (g) co ncentratio n deficit  ' +
  1447           'm ay be evid ent on cli nical test ing. Objec tive evide nce of mem ory defici t obtained  ' +
  1448           'o nly with a n intensiv e intervie w. Decreas ed perform ance in de manding '  +
  1449           'e mployment  and social  settings.  Denial be gins to be come manif est in pat ient. ' +
  1450           'M ild to mod erate anxi ety accomp anies symp toms. ' +  #13 + #13  +
  1451  
  1452         '4.  Moderate c ognitive d ecline (Mi ld Dementi a) ' + #13  +
  1453           'C lear-cut d eficit on  careful cl inical int erview. De ficit mani fest in fo llowing ar eas: ' +
  1454           '( a) decreas ed knowled ge of curr ent and re cent event s; (b) may  exhibit s ome ' +
  1455           'd eficit in  memory of  ones perso nal histor y; (c) con centration  deficit e licited on  ' +
  1456           's erial subt ractions;  (d) decrea sed abilit y to trave l, handle  finances,  etc. Frequ ently ' +
  1457           'n o deficit  in followi ng areas:  (a) orient ation to t ime and pl ace; (b) r ecognition  of ' +
  1458           'f amiliar pe rsons and  faces; (c)  ability t o travel t o familiar  locations . Inabilit y to ' +
  1459           'p erform com plex tasks . Denial i s dominant  defense m echanism.  Flattening  of ' +
  1460           'a ffect and  withdrawal  from chal lenging si tuations f requently  occur. ' +  #13 + #13  +
  1461  
  1462         '5.  Moderately  severe co gnitive de cline (Mod erate Deme ntia) ' +  #13 +
  1463           'P atient can  no longer  survive w ithout som e assistan ce. Patien t is unabl e during '  +
  1464           'i nterview t o recall a  major rel evant aspe ct of thei r current  lives, e.g ., an addr ess or ' +
  1465           't elephone n umber of m any years,  the names  of close  family mem bers (such  as ' +
  1466           'g randchildr en), the n ame of the  high scho ol or coll ege from w hich they  ' +
  1467           'g raduated.  Frequently  some diso rientation  to time ( date, day  of week, s eason, ' +
  1468           'o r to place . An educa ted person  may have  difficulty  counting  back from  40 ' +
  1469           'b y 4s or fr om 20 by 2 s. Persons  at this s tage retai n knowledg e of many  major ' +
  1470           'f acts regar ding thems elves and  others. Th ey invaria bly know t heir own n ames ' +
  1471           'a nd general ly know th eir spouse s'' and ch ildren''s  names. The y require  no ' +
  1472           'a ssistance  with toile ting and e ating, but  may have  some diffi culty choo sing the '  +
  1473           'p roper clot hing to we ar. ' + #1 3 + #13 +
  1474  
  1475         '6.  Severe cog nitive dec line (Mode rately Sev ere Dement ia) ' + #1 3 +
  1476           'M ay occasio nally forg et the nam e of the s pouse upon  whom they  are entir ely ' +
  1477           'd ependent f or surviva l. Will be  largely u naware of  all recent  events an d ' +
  1478           'e xperiences  in their  lives. Ret ain some k nowledge o f their pa st lives b ut this is  ' +
  1479           'v ery sketch y. General ly unaware  of their  surroundin gs, the ye ar, the se ason, etc.  ' +
  1480           'M ay have di fficulty c ounting fr om 10, bot h backward  and, some times, for ward. ' +
  1481           'W ill requir e some ass istance wi th activit ies of dai ly living,  e.g., may  become  '  +
  1482           'i ncontinent , will req uire trave l assistan ce but occ asionally  will be ab le to trav el to ' +
  1483           'f amiliar lo cations. D iurnal rhy thm freque ntly distu rbed. Almo st always  recall ' +
  1484           't heir own n ame. Frequ ently cont inue to be  able to d istinguish  familiar  from ' +
  1485           'u nfamiliar  persons in  their env ironment.  Personalit y and emot ional chan ges ' +
  1486           'o ccur. Thes e are quit e variable  and inclu de: (a) de lusional b ehavior, e .g., patie nts ' +
  1487           'm ay accuse  their spou se of bein g an impos tor, may t alk to ima ginary fig ures in '  +
  1488           't he environ ment, or t o their ow n reflecti on in the  mirror; (b ) obsessiv e symptoms , ' +
  1489           'e .g., perso n may cont inually re peat simpl e cleaning  activitie s; (c) anx iety ' +
  1490           's ymptoms, a gitation,  and even p reviously  nonexisten t violent  behavior m ay ' +
  1491           'o ccur; (d)  cognitive  abulla, i. e., loss o f willpowe r because  an individ ual cannot  ' +
  1492           'c arry a tho ught long  enough to  determine  a purposef ul course  of action.  ' + #13 +  #13 +
  1493  
  1494         '7.  Very sever e cognitiv e decline  (Severe De mentia) '  + #13 +
  1495           'A ll verbal  abilities  are lost o ver the co urse of th is stage.  Frequently  there is  no ' +
  1496           's peech at a ll -only u nintelligi ble uttera nces and r are emerge nce of see mingly ' +
  1497           'f orgotten w ords and p hrases. In continent  of urine,  requires a ssistance  toileting  ' +
  1498           'a nd feeding . Basic ps ychomotor  skills, e. g., abilit y to walk,  are lost  with the '  +
  1499           'p rogression  of this s tage. The  brain appe ars to no  longer be  able to te ll the bod y ' +
  1500           'w hat to do.  Generaliz ed rigidit y and deve lopmental  neurologic  reflexes  are ' +
  1501           'f requently  present.^  ';
  1502       end;
  1503  
  1504     if Trim( Instrument Name) = 'S LUMS' then
  1505       begin
  1506         Resu ltString : =
  1507           '1 7= Jill wa s a very s uccessful  stockbroke r. She mad e a lot of  money on  the stock  market. '  +
  1508           'S he then me t Jack, a  devastatin gly handso me man. Sh e married  him and ha d three ch ildren. '  +
  1509           'T hey lived  in Chicago . She then  stopped w ork and st ayed at ho me to brin g up her c hildren. '  +
  1510           'W hen they w ere teenag ers, she w ent back t o work. Sh e and Jack  lived hap pily ever  after.^';
  1511       end;
  1512   end;
  1513  
  1514   procedure  VistaLooku p(
  1515     Broker:  TRPCBroker ;
  1516     Instrume ntName,
  1517     PatientI EN,
  1518     OrderedB yDUZ: stri ng;
  1519     var
  1520     ResultSt ring: stri ng); stdca ll;
  1521   // ResultS tring look s like:
  1522   //     Num ber=text^N umber=Text ^
  1523   //     whe re number  is place i n form's s equence
  1524   begin
  1525     ResultSt ring := '' ;
  1526  
  1527     if Trim( Instrument Name) = 'S BR' then
  1528       begin
  1529         Resu ltString : = GetVista Text_SBR(
  1530           Br oker,
  1531           In strumentNa me,
  1532           Pa tientIEN,
  1533           Or deredByDUZ );
  1534       end;
  1535  
  1536     if Trim( Instrument Name) = 'S BR II' the n
  1537       begin
  1538         Resu ltString : = GetVista Text_SBR_I I(
  1539           Br oker,
  1540           In strumentNa me,
  1541           Pa tientIEN,
  1542           Or deredByDUZ );
  1543       end;
  1544  
  1545   end;
  1546  
  1547  
  1548  
  1549   procedure  SpecialRes ults(
  1550     var
  1551     ResultSt ring: stri ng); stdca ll;
  1552   begin
  1553     ResultSt ring := Ge tSpecialRe sults;
  1554   end;
  1555  
  1556  
  1557  
  1558  
  1559   end.
  1560  
  1561