# Manage a dynamic form.
#
# The form collects medical information.  Upon submission a document
# would be presented to the user advising them of what action they should
# take (see a doctor, go to hospital, etc)
#
# The form starts with three fields: "name" and "age" (which we won't bother 
# checking in this applet - see form3.tcl) and "gender" which is a selection 
# for Male/Female.

# The setting of the gender field determines which fields should be added.
# (Gender == Female && age >= 50) => add "Most recent Mammogramme" field
# (Gender == Female && age < 50) => add "Are your periods regular?" & 
# "Most recent PAP smear" fields.
#
# (Gender == Male && age > 40) => add "Most recent heart check" field

set namewin {}
set agewin {}
set genderwin {}
set mamwin {}
set papwin {}
set periodwin {}
set heartwin {}

set name {}
set age {}
set gender {}

proc HMreset_form {} {
    global patient namewin age agewin gender genderwin

    set patient [$namewin get]
    set age [$agewin get]
    set gender [$genderwin.list get [$genderwin.list curselection]]
}

proc terminate {} {
    global agewin genderwin

    bind $agewin <KeyPress> {}
    bind $genderwin.list <ButtonPress> {}
}

proc HMsubmit_form {method query} {
    global patient namewin age agewin gender genderwin mamwin periodwin papwin
    global heartwin

    set query {}
    if {$patient != {}} {append query " name \{$patient"\}}
    if {$age != {}} {append query " age $age"}
    if {$gender != {}} {append query " gender $gender"}
    if {[winfo exists $mamwin]} {append query " mammogramme \{[$mamwin get]\}"}
    if {[winfo exists $papwin]} {append query " papsmear \{[$papwin get]\}"}
    if {[winfo exists $periodwin]} \
	{append query " periods [$periodwin get [$periodwin curselection]]"}
    if {[winfo exists $heartwin]} \
	{append query " lastheart [$heartwin get [$heartwin curselection]]"}
    return $query
}

# Setup each form item.

proc HMapplet_item {type name item} {
    global patient namewin age agewin gender genderwin resetwin

    switch $name {
	name {
	    set namewin $item
	    set patient [$item get]
	}
	age {
	    set agewin $item
	    set age [$item get]
	    bind $agewin <KeyPress> {state_change}
	    # Move this binding to after the Class binding
	    bindtags $agewin [concat [lrange [bindtags $agewin] 1 end] " " [lindex [bindtags $agewin] 0]]
	}
	gender {
	    set genderwin $item
	    bind $genderwin.list <ButtonPress> {state_change}
	    # Move this binding to after the Class binding
	    bindtags $genderwin.list [concat [lrange [bindtags $genderwin.list] 1 end] " " [lindex [bindtags $genderwin.list] 0]]
	    state_change
	}
    }

    if {$type == "reset"} {
	set resetwin $item
    }
}

# Called from state_change - removes additional items from the form

proc remove_variable_fields {} {
    global genderwin resetwin

    [set win [applet embedwindow]] delete \
	[$win index "$genderwin + 1 char"] [$win index $resetwin]
    # Put the newline back in
    $win insert [$win index $resetwin] "\n\n"
    uplevel set changed 1
}

# Called to process possible changes in the form's state.

proc state_change {} {
    global age agewin gender genderwin mamwin papwin periodwin resetwin
    global heartwin

    # Detect changes to the state of the form

    set changed 0
    set newgender [$genderwin.list get [$genderwin.list curselection]]
    if {$gender != $newgender} {
	# Remove all inappropriate fields
	remove_variable_fields
	set gender $newgender
    }
    set newage [$agewin get]
    if {$age != $newage && $newage != {}} {
	# Look at the relations to work out whether things need to be reset
	switch $gender {
	    Female {
		if {$age == {} || ($age >= 50 && $newage < 50) ||
		    ($age < 50 && $newage >= 50)} {
		    remove_variable_fields
		}
	    }
	    Male {
		if {$age > 40 && $newage <= 40} {
		    remove_variable_fields
		} elseif {$age <= 40 && $newage > 40} {
		    remove_variable_fields
		}
	    }
	}
	set age $newage
    }

    # Layout new fields according to the form's new state

    if {$changed} {
	set win [applet embedwindow]
	# Now set up the new fields
	switch $gender {
	    Female {
		if {$age >= 50} {
		    # Add "Most recent Mammogramme" field
		    $win insert [$win index $resetwin] "Your most recent Mammogramme: "
		    set mamwin [entry $win.form4mam -takefocus 1]
		    $win window create [$win index $resetwin] -window $mamwin
		    $win insert [$win index $resetwin] "\n"
		} elseif {$age != {}} {
		    # Add "Are your periods regular?" & "Most recent PAP smear" fields

		    $win insert [$win index $resetwin] "Are your periods regular? "
		    set periodwin [listbox $win.form4period -selectmode single -width 0 -height 2 -exportselection 0]
		    $periodwin insert end "Yes"
		    $periodwin insert end "No"
		    $periodwin selection set 0
		    $win window create [$win index $resetwin] -window $periodwin

		    $win insert [$win index $resetwin] "\nYour most recent PAP smear: "
		    set papwin [entry $win.form4pap -takefocus 1]
		    $win window create [$win index $resetwin] -window $papwin
		    $win insert [$win index $resetwin] "\n"
		}
	    }
	    Male {
		if {$age > 40} {
		    # Add "Most recent heart check" field
		    $win insert [$win index $resetwin] "Your most recent heart check: "
		    set heartwin [entry $win.form4heart -takefocus 1]
		    $win window create [$win index $resetwin] -window $heartwin
		    $win insert [$win index $resetwin] "\n"
		}
	    }
	    default {
		# A very confused person!
	    }
	}
    }
}

wm withdraw .
