source: WorldVistAEHR/trunk/r/KERNEL-XU-A4A7-USC-XG-XLF-XNOA-XPD-XQ-XVIR-ZI-ZOSF-ZOSV-ZT-ZU-%Z-XIP--XQAB--XUC--XUR--ZIN--ZTED/XQ83R.m@ 1661

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