-
Notifications
You must be signed in to change notification settings - Fork 0
/
ect-formulae.pl
75 lines (64 loc) · 1.85 KB
/
ect-formulae.pl
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
#!/usr/bin/perl
eval 'exec /usr/bin/perl -S $0 ${1+"$@"}'
if $running_under_some_shell;
# this emulates #! processing on NIH machines.
# (remove #! line above if indigestible)
eval '$'.$1.'$2;' while $ARGV[0] =~ /^([A-Za-z_0-9]+=)(.*)/ && shift;
# process any FOO=bar switches
#/usr/bin/awk -f
$, = ' '; # set output field separator
$\ = "\n"; # set output record separator
print 'ECT dosing formulae';
printf (('Please, enter the age of the patient: '));
$age = <>;
while ($age < 18 || $age > 120) {
print 'out of range, please, type a valid age';
$age = <>;
if ($age > 18 && $age < 120) {
last;
}
}
printf (('Please, enter the sex of the patient(M/F): '));
while ($sex ne 'M' || $sex ne 'm' || $sex ne 'f' || $sex ne 'F') {
$sex = <STDIN>;
chomp($sex);
if ($sex eq 'M' || $sex eq 'm' || $sex eq 'F' || $sex eq 'f') {
last;
}
else {
print 'Value is out of range. Please, type M or F';
}
}
$H = $age * 2.5;
$A = $age * 5;
{
print 'According to the Half-Age based dosing method the charge is ' . $H
. ' mC';
}
{
print 'According to the Age-based dosing method the charge is ' . $A .
' mC';
}
if ($age < 65) {
print 'According to (Bennett et al. 2012) the charge is 200 mC';
}
elsif ($age > 65) {
print 'According to (Bennett et al. 2012) the charge is 250 mC';
}
if ($sex eq 'M' || $sex eq 'm') {
print 'According to (Schoyen et al. 2015) the Age-based dose is ' . ($A +
25) . ' to ' . ($A + 50) . ' mC. The Half-age dose is ' . ($H + 25) .
' to ' . ($H + 50) . ' mC';
}
elsif ($sex eq 'F' || $sex eq 'f') {
print 'According to (Schoyen et al. 2015) The Half-age dose is ' . ($H -
50) . ' to ' . ($H - 25) . ' mC. The Age-based dose is ' . ($A - 50) .
' to ' . ($A - 25) . ' mC.';
last;
}
sub readline {
if ($getline_ok = (($_ = <>) ne '')) {
;
}
$_;
}