% --------------------------------------------------------------------------
%   FILE:       FUNC.PL
%   AUTHOR:     Tim Duncan
%   UPDATED:    Mon Aug 10 18:14:17 BST 1987
%   PURPOSE:    Functions called by Prosenet 'func' arcs.
% --------------------------------------------------------------------------


:- op(100,fx,*).
:- op(100,xfy,:).



/* ---------------------- FUNCTIONS ------------------------

Prosenet 'func' arcs are called via function_call/1, and the
output recovered from the environment variable 'function_output'
As a debugging aid, the name of the function is returned if it
fails.
*/


function_call(F) :- call(F).
function_call(F) :- setenv(function_output,[*allcaps,F]).



probdesc :-  /* principles */
    getenv(principle,[Problem:Compl|Others]),
    setenv(function_output,Problem).


compldesc :-   /* principles */
    getenv(principle,[Problem:Compl|Others]),
    setenv(function_output,Compl).


intriskdesc :- /* intubation */
    getenv(intub_risk,Desc),
    setenv(function_output,Desc).


descchostech :- /* describe the chosen technique */
    getenv(chostech,[Tech|Subtree]),
    describe(technique,[Tech],Desc),
    setenv(function_output,Desc).

descalttech :- /* describe an alternative technique */
    getenv(alts,[[Tech:R:P|Sub]|Alts]),
    describe(technique,[Tech],Desc),
    setenv(function_output,Desc).


descsubtech :- descchostech.        % because environment pushed


desconerisk :-  /* describe a single risk */
    getenv(tlist,[R:Features|More]),
    member(desc(Desc),Features),
    ( member(prob(Prob),Features),
      not(redundant(sentence_level,Prob)),
      member(probdesc(Pdesc),Features)
    ; null(Pdesc) ),                     % ignore problem if already described
    ( member(mech(Mech),Features),
      member(mechdesc(Mdesc),Features),
      ( redundant(paragraph_level,Mech),
        Mdesc2 = [*comma,again,*comma|Mdesc]
      ; Mdesc2 = Mdesc )
    ; null(Mdesc2) ),
    setenv(function_output,[Desc,Pdesc,Mdesc2]), !.




/* special risks (eg: balanced anesthesia given HBP) are always described,
whether or not previously described. These are flagged RISKSPEC in PMFs
*/

specrisk :-
    getenv(tlist,[R:Features|More]),
    member(desc(Desc),Features),
    setenv(function_output,Desc), !.



/* describe a conditional risk (eg: succinylcholine risky with CVA if it
was recent and involves hemiparesis.
*/

desccond :-
    getenv(tlist,[R:Features|More]),
    member(cond(C),Features),
    setenv(function_output,C), !.



/* Describe the context of the risk, ie: the disease or operation that makes
the technique risky.
*/

desccontext :-
    getenv(tlist,[R:Features|More]),
    member(context(Context),Features),
    do(redundant(sentence_level,Context)),  % update redundant list but don't fail
    describe(problem,Context,Description),
    setenv(function_output,Description), !.



/* redundant/2
Mode: redundant(+,+)
Args: redundant(Key,Item)

Check and update list of items done. There are three lists:
sentence_level, paragraph_level, and global. The first two
remember problems, contexts and mechanism discussed, the
global list remembers techniques. The sentence_level list
is initialised each time RISK_S is entered, and the para-
graph_level list is initialised when one of INT, IM, N, or
MINORS is entered.

This predicate is used as a test by functions, and so succeeds
when the item(s) are redundant, and fails (after updating the
relevant list) if they are new. Which list is indicated by the key.
*/

redundant(K,X) :-
    ( recorded(redundant,(K,Redundant),Old) ; null(Redundant) ),
    redundant(X,Redundant,Update),
    ( Update = Redundant       % no change - therefore X was redundant
    ; recorda(redundant,(K,Update),_),
      ( null(Redundant)
      ; erase(Old) ),
      !, fail ), !.             % new items so not redundant

redundant([],X,X) :- !.
redundant([H|T],R,U) :-
    member(H,R), !,
    redundant(T,R,U).
redundant([H|T],R,U) :- !,
    redundant(T,[H|R],U).           % add to redundant list
redundant(X,R,R) :-
    member(X,R), !.
redundant(X,R,[X|R]) :- !.




/* Used to describe risks or benefits.
If there are more than one, then seperate
them with *comma "of", until the final one
which should be *comma "and of"
*/

descrisklist([R:H],D) :- !,
    descrisk(H,D).
descrisklist([R:H,R2:H2],[D,*comma,and,of,D2]) :- !,
    descrisk(H,D),
    descrisk(H2,D2).
descrisklist([R:H|T],[D,*comma,of|T2]) :-
    descrisk(H,D), !,
    descrisklist(T,T2).


descrisk(L,[Desc|Cond]) :-
    member(desc(Desc),L),
    ( member(cond(C),L),
      Cond = [if,C]
    ; null(Cond) ), !.


descbenes :-
    getenv(blist,Benes),
    descrisklist(Benes,Desc),
    setenv(function_output,Desc), !.



descrisknumb :-  /* Say how many risks there are */
    getenv(tlist,Risks),
    length(Risks,Num),
    ( nth_item(Num,[one,two,three,four],Desc)
    ; Desc = several ),
    setenv(function_output,[Desc]), !.


/* describe the context under which a cprule applies */

desccpcontext :-
    getenv(cprule,[[not(Context)]:Why|More]), !,
    describe(problem,Context,Problem),
    setenv(function_output,[without|Problem]), !.
desccpcontext :-
    getenv(cprule,[Context:Why|More]),
    describe(problem,Context,Problem),
    setenv(function_output,[with|Problem]), !.



descwhy :- /* describe the reason for a CP rule preference */
    getenv(cprule,[Context:Why|More]),
    setenv(function_output,Why), !.


descprob :-       % wellchosen
    getenv(good_techs,[prob(Desc):Gtechlst|More]),
    setenv(function_output,Desc), !.


desccntxt :-       % minors
    getenv(subplan,P),
    setenv(function_output,P), !.


descwctech :-     % wc
    getenv(gtechlst,[Tech:D|More]),
    describe(technique,Tech,Desc),
    setenv(function_output,Desc), !.


descbenewc :-     % wc
    getenv(gtechlst,[Tech:D|More]),
    member(desc(Desc),D),
    setenv(function_output,Desc), !.



linenum :-         % minors
    getenv(linenum,[Previous]),
    Line is Previous+1,
    setenv(linenum,[Line]),
    setenv(function_output,[*nl,Line,*period]), !.


desctech :-       % imx
    getenv(minors,[T:R:D|_]),
    describe(technique,T,Desc),
    setenv(function_output,Desc), !.



comma_and :-      % wc
    ( getenv(gtechlst,[Only_one]),
      setenv(function_output,[*comma,and])
    ; setenv(function_output,[*comma]) ), !.
