23 lines
2.1 KiB
Mathematica
23 lines
2.1 KiB
Mathematica
|
SRCUSS4 ;TAMPA/CFB - SCREEN SERVER ; 24 Jan 1989 7:40 AM
|
||
|
|
;;3.0; Surgery ;;24 Jun 93
|
||
|
|
PAGE S (Q("P",Q),Q8,Q6,Q("C"))=1 K Q0(Q) I Q=1,Q7="DR" S Q7="DR("_Q_","_+Q(0,Q) I '$D(@(Q7_")"))#2 S Q7="DR"
|
||
|
|
I $E(Q7,$L(Q7))=")" S Q7=$E(Q7,1,$L(Q7)-1)
|
||
|
|
S Q(12,6)=$S($D(@(Q7_$S(Q7["(":")",1:""))):@(Q7_$S(Q7["(":")",1:"")),1:".01;") S:Q(12,6)=".01" Q(12,6)=".01;" S Q0(Q,0)=$S(Q7["Q1":$P(Q(12,6),";",3,999),1:Q(12,6)) D PA1
|
||
|
|
F Q0(0)=0:0 S @("Q0(0)=$O("_Q7_$S(Q7["("&($E(Q7,$L(Q7))'="("):",",1:"(")_Q0(0)_"))") Q:Q0(0)<1 S Q(12,6)=@(Q7_$S(Q7["("&($E(Q7,$L(Q7))'="("):",",1:"(")_Q0(0)_")"),Q0(Q,0)=Q0(Q,0)_$S(Q7["Q1":$P(Q(12,6),";",3,999),1:Q(12,6)) D PA1
|
||
|
|
I $D(Q(14)),Q("TEM"),'$D(^TMP("SRCUSS",$J,Q(14),Q,+Q(0,Q))) S Q0(-1)=1000 F Q0(0)=0:0 S Q0(0)=$O(Q0(Q,Q0(0))) Q:Q0(0)<1 S ^TMP("SRCUSS",$J,Q(14),Q,+Q(0,Q),Q0(0))=$P(Q0(Q,Q0(0)),";",2,999) D PAGE0
|
||
|
|
Q
|
||
|
|
PAGE0 F Q0(-2)=0:0 S Q0(-2)=$O(Q0(Q,Q0(0),Q0(-2))) Q:Q0(-2)<1 S ^TMP("SRCUSS",$J,Q(14),Q,+Q(0,Q),Q0(-1))="Q0("_Q_","_Q0(0)_","_Q0(-2)_")",^(Q0(-1)+1000)=Q0(Q,Q0(0),Q0(-2)),Q0(-1)=Q0(-1)+1
|
||
|
|
Q
|
||
|
|
PA1 S (Q(2),Q(7))=$P(Q0(Q,0),";",1) Q:Q(7)=""!(+Q(7)=999999999) I (Q(2)[":"&(Q(2)?1NP.E))!($E(Q(2),1)="[") S Q0(Q,0)=$P(Q0(Q,0),";",2,999) D CO^SRCUSS0:Q(7)?1NP.E,TEM:$E(Q(7),1)="["
|
||
|
|
S Q("C1")=$P(Q0(Q,0),";",1) I $E(Q("C1"),1)?1U S Q0(Q,Q8,Q("C"))=$P(Q("C1"),";",1),Q("C1")="X Q0("_Q_","_Q8_","_Q("C")_")",Q("C")=Q("C")+1
|
||
|
|
S Q0(Q,Q8)=$S(Q6=1:Q3(Q)_";",1:Q0(Q,Q8))_Q("C1")_";",Q0(Q,0)=$P(Q0(Q,0),";",2,999),Q6=Q6+1 I Q0(Q,0)'="" S:Q6=(17-Q)!(Q(7)="H 0") (Q("P",Q),Q8)=Q8+1,(Q6,Q("C"))=1
|
||
|
|
G PA1
|
||
|
|
TEM S Q(2)=$E(Q(2),2,99),(Q(2),Q(12,9))=$P(Q(2),"]",1) Q:'$D(^DIE("B",Q(2)))#2
|
||
|
|
S Q(14)=$O(^DIE("B",Q(2),0)),Q0(Q)=Q(2),Q(12,5)=Q7
|
||
|
|
TEMC S Q7="^DIE("_Q(14)_",""DR"","_Q_","_+Q(0,Q)
|
||
|
|
I Q("TEM"),$D(^TMP("SRCUSS",$J,Q(14),"DATE")),$P(^DIE(Q(14),0),U,2)'=^TMP("SRCUSS",$J,Q(14),"DATE") K ^TMP("SRCUSS",$J,Q(14))
|
||
|
|
I Q("TEM"),'$D(^TMP("SRCUSS",$J,Q(14),"DATE")) S ^TMP("SRCUSS",$J,Q(14),"DATE")=$P(^DIE(Q(14),0),U,2)
|
||
|
|
I Q("TEM"),$D(^TMP("SRCUSS",$J,Q(14),Q,+Q(0,Q))) F Q8=0:0 S Q8=$O(^TMP("SRCUSS",$J,Q(14),Q,+Q(0,Q),Q8)) Q:'Q8!(Q8>1999) S:Q8<1000 Q0(Q,Q8)=Q3(Q)_";"_^(Q8),Q("P",Q)=Q8 S:Q8>999 @^(Q8)=^(Q8+1000)
|
||
|
|
I $T S Q(13)=1,Q7=Q(12,5) Q
|
||
|
|
D PAGE S Q(13)=1,Q7=Q(12,5) Q
|