note description: "An electronic health (e-Health) system." author: "Jackie Wang" class HEALTH_SYSTEM create make feature {NONE} -- Initialization default_create -- Process instances of classes with no creation clause. -- (Default: do nothing.) -- (from ANY) do end feature -- Access generating_type: TYPE [detachable HEALTH_SYSTEM] -- Type of current object -- (type of which it is a direct instance) -- (from ANY) external "built_in" ensure -- from ANY generating_type_not_void: Result /= Void end generator: STRING_8 -- Name of current object's generating class -- (base class of the type of which it is a direct instance) -- (from ANY) external "built_in" ensure -- from ANY generator_not_void: Result /= Void generator_not_empty: not Result.is_empty end feature -- Comparison frozen deep_equal (a: detachable ANY; b: like arg #1): BOOLEAN -- Are a and b either both void -- or attached to isomorphic object structures? -- (from ANY) do if a = Void then Result := b = Void else Result := b /= Void and then a.is_deep_equal (b) end ensure -- from ANY instance_free: class shallow_implies_deep: standard_equal (a, b) implies Result both_or_none_void: (a = Void) implies (Result = (b = Void)) same_type: (Result and (a /= Void)) implies (b /= Void and then a.same_type (b)) symmetric: Result implies deep_equal (b, a) end frozen equal (a: detachable ANY; b: like arg #1): BOOLEAN -- Are a and b either both void or attached -- to objects considered equal? -- (from ANY) do if a = Void then Result := b = Void else Result := b /= Void and then a.is_equal (b) end ensure -- from ANY instance_free: class definition: Result = (a = Void and b = Void) or else ((a /= Void and b /= Void) and then a.is_equal (b)) end frozen is_deep_equal (other: HEALTH_SYSTEM): BOOLEAN -- Are Current and other attached to isomorphic object structures? -- (from ANY) require -- from ANY other_not_void: other /= Void external "built_in" ensure -- from ANY shallow_implies_deep: standard_is_equal (other) implies Result same_type: Result implies same_type (other) symmetric: Result implies other.is_deep_equal (Current) end is_equal (other: HEALTH_SYSTEM): BOOLEAN -- Is other attached to an object considered -- equal to current object? -- (from ANY) require -- from ANY other_not_void: other /= Void external "built_in" ensure -- from ANY symmetric: Result implies other ~ Current consistent: standard_is_equal (other) implies Result end frozen standard_equal (a: detachable ANY; b: like arg #1): BOOLEAN -- Are a and b either both void or attached to -- field-by-field identical objects of the same type? -- Always uses default object comparison criterion. -- (from ANY) do if a = Void then Result := b = Void else Result := b /= Void and then a.standard_is_equal (b) end ensure -- from ANY instance_free: class definition: Result = (a = Void and b = Void) or else ((a /= Void and b /= Void) and then a.standard_is_equal (b)) end frozen standard_is_equal (other: HEALTH_SYSTEM): BOOLEAN -- Is other attached to an object of the same type -- as current object, and field-by-field identical to it? -- (from ANY) require -- from ANY other_not_void: other /= Void external "built_in" ensure -- from ANY same_type: Result implies same_type (other) symmetric: Result implies other.standard_is_equal (Current) end feature -- Status report conforms_to (other: ANY): BOOLEAN -- Does type of current object conform to type -- of other (as per Eiffel: The Language, chapter 13)? -- (from ANY) require -- from ANY other_not_void: other /= Void external "built_in" end same_type (other: ANY): BOOLEAN -- Is type of current object identical to type of other? -- (from ANY) require -- from ANY other_not_void: other /= Void external "built_in" ensure -- from ANY definition: Result = (conforms_to (other) and other.conforms_to (Current)) end feature -- Duplication frozen clone (other: detachable ANY): like other obsolete "Use `twin' instead. [2017-05-31]" -- Void if other is void; otherwise new object -- equal to other -- -- For non-void other, clone calls copy; -- to change copying/cloning semantics, redefine copy. -- (from ANY) do if other /= Void then Result := other.twin end ensure -- from ANY instance_free: class equal: Result ~ other end copy (other: HEALTH_SYSTEM) -- Update current object using fields of object attached -- to other, so as to yield equal objects. -- (from ANY) require -- from ANY other_not_void: other /= Void type_identity: same_type (other) external "built_in" ensure -- from ANY is_equal: Current ~ other end frozen deep_clone (other: detachable ANY): like other obsolete "Use `deep_twin' instead. [2017-05-31]" -- Void if other is void: otherwise, new object structure -- recursively duplicated from the one attached to other -- (from ANY) do if other /= Void then Result := other.deep_twin end ensure -- from ANY instance_free: class deep_equal: deep_equal (other, Result) end frozen deep_copy (other: HEALTH_SYSTEM) -- Effect equivalent to that of: -- copy (other . deep_twin) -- (from ANY) require -- from ANY other_not_void: other /= Void do copy (other.deep_twin) ensure -- from ANY deep_equal: deep_equal (Current, other) end frozen deep_twin: HEALTH_SYSTEM -- New object structure recursively duplicated from Current. -- (from ANY) external "built_in" ensure -- from ANY deep_twin_not_void: Result /= Void deep_equal: deep_equal (Current, Result) end frozen standard_clone (other: detachable ANY): like other obsolete "Use `standard_twin' instead. [2017-05-31]" -- Void if other is void; otherwise new object -- field-by-field identical to other. -- Always uses default copying semantics. -- (from ANY) do if other /= Void then Result := other.standard_twin end ensure -- from ANY instance_free: class equal: standard_equal (Result, other) end frozen standard_copy (other: HEALTH_SYSTEM) -- Copy every field of other onto corresponding field -- of current object. -- (from ANY) require -- from ANY other_not_void: other /= Void type_identity: same_type (other) external "built_in" ensure -- from ANY is_standard_equal: standard_is_equal (other) end frozen standard_twin: HEALTH_SYSTEM -- New object field-by-field identical to other. -- Always uses default copying semantics. -- (from ANY) external "built_in" ensure -- from ANY standard_twin_not_void: Result /= Void equal: standard_equal (Result, Current) end frozen twin: HEALTH_SYSTEM -- New object equal to Current -- twin calls copy; to change copying/twinning semantics, redefine copy. -- (from ANY) external "built_in" ensure -- from ANY twin_not_void: Result /= Void is_equal: Result ~ Current end feature -- Basic operations frozen as_attached: attached HEALTH_SYSTEM obsolete "Remove calls to this feature. [2017-05-31]" -- Attached version of Current. -- (Can be used during transitional period to convert -- non-void-safe classes to void-safe ones.) -- (from ANY) do Result := Current end frozen default: detachable HEALTH_SYSTEM -- Default value of object's type -- (from ANY) do end frozen default_pointer: POINTER -- Default value of type POINTER -- (Avoid the need to write p.default for -- some p of type POINTER.) -- (from ANY) do ensure -- from ANY instance_free: class end default_rescue -- Process exception for routines with no Rescue clause. -- (Default: do nothing.) -- (from ANY) do end frozen do_nothing -- Execute a null action. -- (from ANY) do ensure -- from ANY instance_free: class end feature -- Commands add_interaction (m1, m2: MEDICATION) -- Add an interaction between 'm1' and 'm2'. require m1 /= Void and then m2 /= Void m1 /= m2 local rs: SET [MEDICATION] p: PATIENT do di.extend (mm ([m1, m2])) di.extend (mm ([m2, m1])) across pr as c loop p := c.item.first rs := pr.image (p) if rs.has (m1) and rs.has (m2) then dpr.extend (pi ([p, m1 |-> m2])) dpr.extend (pi ([p, m2 |-> m1])) warn := True end end ensure dangerous_interactions_extended: di ~ (old di.deep_twin).extended (mm ([m1, m2])).extended (mm ([m2, m1])) end add_medication (m: MEDICATION) -- Add medication 'm' into the system. require m /= Void and then not medications.has (m) do medications.extend (m) ensure medications.count = old medications.count + 1 medications ~ (old medications.deep_twin).extended (m) end add_patient (p: PATIENT) -- Add patient 'p' into the system. require p /= Void and then not patients.has (p) do patients.extend (p) ensure patients.count = old patients.count + 1 patients ~ (old patients.deep_twin).extended (p) end add_to_prescription (p1: PATIENT; m1: MEDICATION) -- Add a prescription of 'm1' to 'p1'. require p1 /= Void and m1 /= Void local p: PATIENT m2: MEDICATION do pr.extend (pm ([p1, m1])) across pr as c loop p := c.item.first m2 := c.item.second if di.has (mm ([m1, m2])) then dpr.extend (pi ([p, m1 |-> m2])) dpr.extend (pi ([p, m2 |-> m1])) warn := True end end ensure interactions_stay_intact: di ~ old di.deep_twin prescriptions_extended: pr ~ (old pr.deep_twin).extended (pm ([p1, m1])) dangerous_prescriptions_report_updated: across patients as patient all across medications as med_1 all across medications as med_2 all dpr.has (pi ([patient.item, med_1.item |-> med_2.item])) = ((old dpr.deep_twin).has (pi ([patient.item, med_1.item |-> med_2.item])) or else (p1 ~ patient.item and across medications as med some di.has (mm ([med.item, m1])) and pr.has (pm ([p1, med.item])) and pr.has (pm ([p1, m1])) and (m1 |-> med.item ~ med_1.item |-> med_2.item or else m1 |-> med.item ~ med_2.item |-> med_1.item) end)) end end end warning_for_supervisor_reset: warn = across (old pr.deep_twin).domain as patient some across (old pr.deep_twin).image (patient.item) as med some di.has (mm ([med.item, m1])) end end or else (old warn) end remove_from_prescription (p1: PATIENT; m1: MEDICATION) -- Remove prescription of 'm1' to 'p1'. require p1 /= Void and m1 /= Void local m: MEDICATION do pr.subtract (pm ([p1, m1])) across pr as c loop m := c.item.second if dpr.has (pi ([p1, m1 |-> m])) then dpr.subtract (pi ([p1, m1 |-> m])) dpr.subtract (pi ([p1, m |-> m1])) end end ensure prescription_removed: pr ~ (old pr.deep_twin).subtracted (pm ([p1, m1])) dangerous_prescriptions_report_updated: across medications as med all not (dpr.has (pi ([p1, med.item |-> m1])) or else dpr.has (pi ([p1, m1 |-> med.item]))) end end feature -- Constructor make -- Initialize an empty system. do create patients.make_empty create medications.make_empty create pr.make_empty create di.make_empty create dpr.make_empty warn := False ensure patients.is_empty medications.is_empty pr.is_empty di.is_empty dpr.is_empty not warn end feature -- Output Io: STD_FILES -- Handle to standard file setup -- (from ANY) once create Result Result.set_output_default ensure -- from ANY instance_free: class io_not_void: Result /= Void end out: STRING_8 -- New string containing terse printable representation -- of current object -- (from ANY) do Result := tagged_out ensure -- from ANY out_not_void: Result /= Void end print (o: detachable ANY) -- Write terse external representation of o -- on standard output. -- (from ANY) do if o /= Void then Io.put_string (o.out) end ensure -- from ANY instance_free: class end frozen tagged_out: STRING_8 -- New string containing terse printable representation -- of current object -- (from ANY) external "built_in" ensure -- from ANY tagged_out_not_void: Result /= Void end feature -- Platform Operating_environment: OPERATING_ENVIRONMENT -- Objects available from the operating system -- (from ANY) once create Result ensure -- from ANY instance_free: class operating_environment_not_void: Result /= Void end feature {NONE} -- Retrieval frozen internal_correct_mismatch -- Called from runtime to perform a proper dynamic dispatch on correct_mismatch -- from MISMATCH_CORRECTOR. -- (from ANY) local l_msg: STRING_8 l_exc: EXCEPTIONS do if attached {MISMATCH_CORRECTOR} Current as l_corrector then l_corrector.correct_mismatch else create l_msg.make_from_string ("Mismatch: ") create l_exc l_msg.append (generating_type.name) l_exc.raise_retrieval_exception (l_msg) end end feature -- State Attributes di: REL [MEDICATION, MEDICATION] -- dangerous interactions dpr: REL [PATIENT, INTERACTION] -- dangerous prescriptions report medications: SET [MEDICATION] -- set of medications patients: SET [PATIENT] -- set of patients pr: REL [PATIENT, MEDICATION] -- prescriptions warn: BOOLEAN -- warning signal for the system supervisor feature {NONE} -- Workaround to avoid using convert mm (t: TUPLE [MEDICATION, MEDICATION]): PAIR [MEDICATION, MEDICATION] do create Result.make_from_tuple (t) end pi (t: TUPLE [PATIENT, INTERACTION]): PAIR [PATIENT, INTERACTION] do create Result.make_from_tuple (t) end pm (t: TUPLE [PATIENT, MEDICATION]): PAIR [PATIENT, MEDICATION] do create Result.make_from_tuple (t) end invariant symmetry: across medications as m1 all across medications as m2 all di.has (mm ([m1.item, m2.item])) = di.has (mm ([m2.item, m1.item])) end end irreflexivity: across medications as m1 all not di.has (mm ([m1.item, m1.item])) end dangerous_prescriptions_reported: across medications as m1 all across medications as m2 all across patients as p1 all (di.has (mm ([m1.item, m2.item])) and pr.has (pm ([p1.item, m1.item])) and pr.has (pm ([p1.item, m2.item]))) = dpr.image (p1.item).has (m1.item |-> m2.item) end end end -- from ANY reflexive_equality: standard_is_equal (Current) reflexive_conformance: conforms_to (Current) end -- class HEALTH_SYSTEM
Generated by ISE EiffelStudio