90 lines
4.5 KiB
Mathematica
90 lines
4.5 KiB
Mathematica
XQ83R ;SF-ISC.SEA/JLI/LUKE - SURGERY ON ^XUTL("XQO", NODES FOR REGULAR MODIFICATIONS TO OPTIONS ;04/08/2003 12:12
|
|
;;8.0;KERNEL;**47,157,286**;Jul 10, 1995
|
|
Q
|
|
REG S XQOPI=+XQOP,XQC1=XQOPI_",",XQC2=","_XQC1
|
|
D TABLE^XQ83A
|
|
N J S J=1
|
|
S XQ83R="" F I=0:0 S I=$O(^DIC(19,"AD",XQOPI,I)) Q:I'>0 S XQ83R(J)=I,J=J+1 ;S XQ83R=XQ83R_I_","
|
|
S A="P" F %I=0:0 S XQ83RL=0 S A=$O(^XUTL("XQO",A)) Q:$E(A)'="P" D
|
|
. I $D(^XUTL("XQO",A,U,XQOPI)) D Q
|
|
. . L +^XUTL("XQO",A):0 K ^(A,0)
|
|
. . F XQ83RI=1:1 S XQOPM=$O(XQ83R(XQ83RI)) S:XQOPM="" ^XUTL("XQO",A,0)=%XQT1 L:XQOPM="" -^XUTL("XQO",A) Q:XQOPM="" D ADD^XQ83A
|
|
. F XQ83RI=1:1 S XQOPM=$O(XQ83R(XQ83RI)) Q:XQOPM="" D
|
|
. . I $D(^XUTL("XQO",A,"^",XQOPM)) D
|
|
. . . I '$D(XQ83LOCK) L +^XUTL("XQO",A):0 S XQ83LOCK=1 K ^XUTL("XQO",A,0)
|
|
. . . D ADD^XQ83A
|
|
. I $D(XQ83LOCK) L -^XUTL("XQO",A) K XQ83LOCK S ^XUTL("XQO",A,0)=%XQT1
|
|
.Q
|
|
K XQ83R,XQ83RI,XQ83RL
|
|
Q
|
|
;
|
|
A ;
|
|
S B=0 F J=0:0 S B=$O(^XUTL("XQO",A,B)) Q:B=""!(B=U) I +^(B)=XQOPI K ^(B)
|
|
D A1
|
|
F I=0:0 S I=$O(^XUTL("XQO",A,U,I)) Q:I'>0 D A2
|
|
Q
|
|
A2 ;
|
|
S L=0,%XQX=$P(^XUTL("XQO",A,U,I),U,9) I $E(%XQX,1,$L(XQC1))=XQC1!(%XQX[XQC2) S L=1
|
|
I 'L F J=0:0 S J=$O(^XUTL("XQO",A,U,I,0,J)) Q:J'>0 S %XQX=$P(^(J),U,2) I $E(%XQX,1,$L(XQC1))=XQC1!(%XQX[XQC2) S L=1 Q
|
|
I L S K=0 D D F J=0:0 S J=$O(^XUTL("XQO",A,U,I,0,J)) Q:J'>0 D D1
|
|
I L I K=0 K ^XUTL("XQO",A,U,I)
|
|
K L,K
|
|
Q
|
|
;
|
|
A1 ;
|
|
Q:$P(^DIC(19,XQOPI,0),U,3)'="" D:'($D(^("U"))#2) UP S %XQX=^DIC(19,XQOPI,"U"),%XQX2=1 D A11
|
|
S %XQX2=0 F M=0:0 S M=$O(^DIC(19,"AD",XQOPI,M)) Q:M'>0 S N=$O(^(M,0)) Q:N'>0 S %XQX=$S('($D(^DIC(19,M,10,N,0))#2):"",1:$P(^(0),U,2)) I %XQX'="" D A11
|
|
Q
|
|
A11 ;
|
|
S %XQY=%XQX F P=1:1 S %XQY=$O(^XUTL("XQO",A,%XQY)) Q:$P(%XQY,U,1)'=%XQX Q:+$P(%XQY,U,2)'=(P-1) I +^(%XQY)=XQOPI S P=0 Q
|
|
I $P(%XQY,U,1)=%XQX S %XQY=$O(^XUTL("XQO",A,%XQY)) Q:$P(%XQY,U,1)'=%XQX I +^(%XQY)=XQOPI S P=0 Q
|
|
I P S ^XUTL("XQO",A,(%XQX_U_$S(P=1:"",1:P-1)))=XQOPI_U_%XQX2
|
|
Q
|
|
;
|
|
D ;
|
|
S XQA=$P(^XUTL("XQO",A,U,I),U,9) D GET Q:XQA="" S ^XUTL("XQO",A,U,I)=U_$P(^DIC(19,I,0),U,1,2)_U_$S($P(^(0),U,3)]"":1,1:"")_U_$P(^(0),U,4)_U_XQA_U_XQK_U_$P(^(0),U,7,8)_U_XQP_U_XQE_U_$P(^(0),U,11,15)_U_XQF_U_$P(^(0),U,17,99),K=K+1
|
|
Q
|
|
D1 ;
|
|
S XQA=$P(^XUTL("XQO",A,U,I,0,J),U,2) D GET K ^XUTL("XQO",A,U,I,0,J) Q:XQA="" I K>0 S ^(K)=XQA_U_XQK_U_XQP_U_XQE_U_XQF,K=K+1 Q
|
|
S ^XUTL("XQO",A,U,I)=U_$P(^DIC(19,I,0),U,1,2)_U_$S($P(^(0),U,3)]"":1,1:"")_U_$P(^(0),U,4)_U_XQA_U_XQK_U_$P(^(0),U,7,8)_U_XQP_U_XQE_U_$P(^(0),U,11,15)_U_XQF_U_$P(^(0),U,17,99),K=K+1
|
|
Q
|
|
;
|
|
GET ;
|
|
S XQOOO="",(XQK,XQP,XQE,XQF)="" F M=1:1 S %XQA=$P(XQA,",",M) Q:%XQA'>0 D SUM
|
|
S:XQOOO XQA="" K XQOOO
|
|
Q
|
|
;
|
|
SUM ;
|
|
S XQK1=$P(^DIC(19,%XQA,0),U,6),XQE1=$P(^(0),U,10),XQF1="" I $D(^(3)) S XQF1=$P(^(3),U)
|
|
S XQK=$S(XQK'=""&(XQK1'=""):XQK_","_XQK1,1:XQK_XQK1),XQE=$S(XQE'=""&(XQE1'=""):XQE_","_XQE1,1:XQE_XQE1),XQF=$S(XQF'=""&(XQF1'=""):XQF_","_XQF1,1:XQF_XQF1)
|
|
S XQOOO=$S($P(^DIC(19,%XQA,0),U,3)'="":1,1:XQOOO)
|
|
S XQP1="" F I=0:0 S I=$O(^DIC(19,%XQA,3.91,I)) Q:I'>0 S XQP1=$S(XQP1'="":XQP1_";",1:"")_$P(^(I,0),U)_$P(^(0),U,2)
|
|
S:XQP1="" XQP1=$P(^DIC(19,%XQA,0),U,9) S XQP=$S(XQP1'=""&(XQP'=""):XQP_";"_XQP1,1:XQP_XQP1)
|
|
Q
|
|
;
|
|
UP S X=$P(^DIC(19,XQOPI,0),U,2) I X'?.PUN S X=$$UP^XLFSTR(X) ;F Z=1:1 Q:X?.NUP S W=$A(X,Z) I W<123,W>96 S X=$E(X,1,Z-1)_$C(W-32)_$E(X,Z+1,255)
|
|
S X=$E(X,1,30),^DIC(19,XQOPI,"U")=X,^DIC(19,"C",X,XQOPI)=""
|
|
Q
|
|
;
|
|
SYN ;
|
|
S A="P" F S=0:0 S A=$O(^XUTL("XQO",A)) Q:$E(A)'="P" D SYN1
|
|
K A,S,T,XQSYN,XQNAM
|
|
Q
|
|
SYN1 ;
|
|
S XQNAM="",V=XQOPI_U_"0" F T=0:0 S XQNAM=$O(^XUTL("XQO",A,XQNAM)) Q:XQNAM=""!(XQNAM=U) I ^(XQNAM)=V K ^(XQNAM)
|
|
I $S('$D(^DIC(19,XQOPI,0)):1,$P(^(0),U,3)'="":1,1:0) S XQNAM="",V=XQOPI_U_"1" F T=0:0 S XQNAM=$O(^XUTL("XQO",A,XQNAM)) Q:XQNAM=""!(XQNAM=U) I ^(XQNAM)=V K ^(XQNAM)
|
|
Q:'$D(^DIC(19,XQOPI,0)) Q:$P(^DIC(19,XQOPI,0),U,3)'="" F XQOPM=0:0 S XQOPM=$O(^DIC(19,"AD",XQOPI,XQOPM)) Q:XQOPM'>0 S XQ1=$O(^(XQOPM,0)) I $D(^DIC(19,XQOPM,10,XQ1,0)) S XQSYN=$P(^(0),U,2) I XQSYN'="" D SYN2
|
|
Q
|
|
SYN2 ;
|
|
Q:'$D(^XUTL("XQO",A,U,XQOPI)) S XQSYN2A=","_XQOPM_","_XQOPI_","
|
|
S XQSYN2=$S($P(A,"P",2)=XQOPM:1,(","_$P(^XUTL("XQO",A,U,XQOPI),U,9))[XQSYN2A:1,1:0) F T=0:0 Q:XQSYN2 S T=$O(^XUTL("XQO",A,U,XQOPI,0,T)) Q:T'>0 I (","_$P(^(T),U,2))[XQSYN2A S XQSYN2=1
|
|
K XQSYN2A I 'XQSYN2 K T,XQSYN2 Q
|
|
S XQLAST=XQOPI,V=XQLAST_U_"0",XQSYNY=XQSYN D SYN3 K XQLAST,V,XQSYNY,XQSYN2
|
|
Q
|
|
SYN3 S XQNAM=XQSYNY_"]]]]]]]]]]]" F XQ83RT=1:1 S XQNAM=$O(^XUTL("XQO",A,XQNAM)) Q:$P(XQNAM,U,1)'=XQSYNY I +^(XQNAM)=+V S XQ83RT=0 Q
|
|
Q:'XQ83RT I XQ83RT=1 S ^XUTL("XQO",A,(XQSYNY_U))=V Q
|
|
I XQ83RT>1,$D(^XUTL("XQO",A,XQSYNY_U)) S ^(XQSYNY_U_"1")=^(XQSYNY_U) K ^(XQSYNY_U)
|
|
F XQ83RT=1:1 I '$D(^XUTL("XQO",A,(XQSYNY_U_XQ83RT))) S ^(XQSYNY_U_XQ83RT)=V Q
|
|
K XQ83RT
|
|
Q
|