#!/usr/bin/perl -w

# file to ,  leans heavily on:
## $Header: /cys/people/brenner/http/docs/web/perl5/RCS/simple-form.cgi,v 1.5 1996/03/29 22:58:40 brenner Exp $
## Copyright (C) 1994 Steven E. Brenner
# this file was written by Chris Evans (http://www.psyctc.org/cgi-bin/mailto.pl?webmaster)
# and, though it's trivial, I claim copyright on it
# However, you may copy it freely provided:
# 1) you don't make a profit out of copying it or using it
# 2) or if you do, you liaise with me about it and we strike a deal!!
# 3) you don't change it any way (particularly not removing this stuff!)
# 4) or if you do change it, you liaise with me, and, with suitable credit
#    to you, we improve the original in line with what you've done!
# The correct citation for this file is:
# Evans (1998) rcsc2.prl http://psyctc.sghms.ac.uk/stats/rcsc2.prl
# 24.v.98

require 5.001;
use strict;
require "/usr/lib/cgi-bin/cgi-lib.pl";

MAIN:
{
  my (%input,    # The CGI data then the following are munged
      $pos,
      $sd_p,
      $mean_p,
      $sd_n,
      $mean_n,
      $data_there,
      $crit_a,
      $crit_b,
      $crit_c,
      $b_n_c,
      $width,
      $dp,
      $debug,
      $field);   # Each of the fields (used for testing) 
  

  # $width and $dp set the output format
  $width = 8;
  $dp = 3;


  # Read in all the variables set by the form
  &ReadParse(\%input);
  $pos = $input{'pos'};

  # Check that what's needed has been entered
  $data_there = 1;
  foreach $field (qw(sd_p mean_p)) {
    $data_there = 0 if !(length($input{$field}));
  }
  &CgiDie("Error: you must give at least the clinical mean and sd!  Try again.\n") unless $data_there;

  # Print the header
  print &PrintHeader;
  print &HtmlTop ("Clinically significant change");
  print "</CENTER>\n";

  # get the data into variables
  $sd_p = $input{'sd_p'};
  $mean_p = $input{'mean_p'};
  $b_n_c = length($input{'sd_n'}) && length($input{'mean_n'});
  $sd_n = $input{'sd_n'} if $b_n_c;
  $mean_n = $input{'mean_n'} if $b_n_c;

  # now process the data acquired
  if (!($mean_p =~ /[\d\.]/)) { 
     &CgiDie("Clinical mean as read from your input = $mean_p\n<P>Mean MUST be a number.  Try again!\n");
  }
  if (!($sd_p =~ /[\d\.]/)) { 
     &CgiDie("Clinical S.D. as read from your input = $sd_p\n<P>S.D. MUST be a positive number.  Try again!\n");
  }
  if ($sd_p <= 0) {
     &CgiDie("Clinical S.D. as read from your input = $sd_p\n<P>S.D. MUST be more than zero.  Try again!\n");
  }


  if ($b_n_c) {
     if (!($mean_n =~ /[\d\.]/)) { 
        &CgiDie("Normative mean as read from your input = $mean_n\n<P>Mean MUST be a number.  Try again!\n");
     }
     if (!($sd_n =~ /[\d\.]/)) { 
        &CgiDie("Normative S.D. as read from your input = $sd_n\n<P>S.D. MUST be a positive number.  Try again!\n");
     }
     if ($sd_n <= 0) {
        &CgiDie("Normative S.D. as read from your input = $sd_n\n<P>S.D. MUST be more than zero.  Try again!\n");
     }
     if ($mean_n == $mean_p) {
        &CgiDie("Clinical mean as read = $mean_p, normative mean as read = $mean_n.  They're the same, something wrong here.  Try again!\n");
     }
     if ($pos) {
        if ($mean_n < $mean_p) {
           &CgiDie("Clinical mean ($mean_p) higher than normative ($mean_n) but you've said measure is positively tuned.  That's wrong!  Try again!\n");
        }
     } else {
        if ($mean_n > $mean_p) {
           &CgiDie("Clinical mean ($mean_p) lower than normative ($mean_n) but you've said measure is negatively tuned.  That's wrong!  Try again!\n");
        }
     }
  }  

  if ($b_n_c) {
     print "Since you have given both clinical and normative distribution parameters ";
     print "there are three possible criteria.<P>";
  } else {
     print "Since you have only given clinical distribution parameters";
     print "there is only one criterion of clinically significant change,";
     print "Jacobson, Follette & Revenstorf's 1984 criterion C<P>";
  }
  # calculate reliable change criterion A
  if ($pos) {
     $crit_a = $mean_p + 2*$sd_p;
  } else {
     $crit_a = $mean_p - 2*$sd_p;
  }
  print "<HR><H2>Criterion A: criterion purely in terms of clinical distribution</H2>";
  printf "Criterion A = %${width}.${dp}f <BR>\n",$crit_a;
  if ($pos) {
     print "Change to this level or above is regarded as clinically significant by criterion A";
  } else {
       print "Change to this level or below it is regarded as clinically significant by criterion A";
  }

  if ($b_n_c) {
     # calculate reliable change criterion B
     if ($pos) {
        $crit_b = $mean_n - 2*$sd_n;
     } else {
        $crit_b = $mean_n + 2*$sd_n;
     } 
     print "<HR><H2>Criterion B: criterion purely in terms of normative data</H2>";
     printf "Criterion B = %${width}.${dp}f <BR>\n",$crit_b;
     if ($pos) {
        print "Change to this level or above is regarded as clinically significant by criterion B";
     } else {
          print "Change to this level or below it is regarded as clinically significant by criterion B";
     }

     # calculate reliable change criterion C
     $crit_c = ($sd_p*$mean_n + $sd_n*$mean_p)/($sd_n + $sd_p);
     print "<HR><H2>Criterion C: criterion in terms of both clinical and normative data</H2>";
     printf "Criterion C = %${width}.${dp}f <BR>\n",$crit_c;
     if ($pos) {
        print "Change to this level or above is regarded as clinically significant by criterion C";
     } else {
        print "Change to this level or below it is regarded as clinically significant by criterion C";
     }
   }

   print "\n<HR>\n<UL>\n";
   print "<LI><A HREF=\"http://www.psyctc.org/stats/\">other statistical info. at this site</A>\n";
   print "<LI><A HREF=\"http://www.psyctc.org/stats/rcsc.htm\">reliable and clinical change info.</A>\n";
   print "<LI><A HREF=\"http://www.psyctc.org/tools/\">tools and measures page</A>\n";
   print "<LI><A HREF=\"http://www.psyctc.org/grids/\">grids and PCP pages</A>\n";
   print "<LI><A HREF=\"http://www.psyctc.org/\">main site intro. page</A>\n</UL>";
   # Close the document cleanly.
   print &HtmlBot;
}