- XQSET ;MJM/SEA - Rebuild display/user XUTL("XQO") ;05/09/2011
- ;;8.0;KERNEL;**28,82,155,569**;Jul 10, 1995;Build 4
- SET ;Rebuild the +XQDIC and "U"_DUZ nodes
- ;
- ;** P569 START CJM
- I XQDIC["U",$P(XQDIC,"U",2)'=DUZ D Q
- .D
- ..N DUZ
- ..S DUZ=$P(XQDIC,"U",2)
- ..D NEWSET
- .D
- ..N XQDIC
- ..S XQDIC="U"_DUZ
- ..D NEWSET
- D NEWSET
- Q
- ;
- NEWSET ;
- ;
- ; ** P569 END CJM
- ;
- K ^XUTL("XQO",XQDIC)
- I XQDIC=+XQDIC,'$D(^DIC(19,XQDIC,0)) Q
- F XQSI=0:0 S XQSI=$S(+XQDIC:$O(^DIC(19,XQDIC,10,XQSI)),1:$O(^VA(200,DUZ,203,XQSI))) Q:XQSI'>0 I $D(^(XQSI,0)) S XQSY=^(0) D SET1
- S XQSK=250,XQSD="",XQSM=1,XQSY=0,XQNO=0
- F XQSI=0:0 S XQSY=$O(XQST(XQSY)) Q:XQSY=""!($E(XQSY,1,4)="ZZZZ") D
- .S XQS0=+XQST(XQSY)
- .D DIS
- .S:(XQSK<$L(XQS0)) ^XUTL("XQO",XQDIC,0,XQSM)=XQSD,XQSD="",XQSK=250,XQSM=XQSM+1
- .I XQNO S XQNO=0 Q
- .S XQSD=XQSD_XQS0,XQSK=XQSK-$L(XQS0)
- .Q
- I XQDIC=+XQDIC,$D(^DIC(19,XQDIC,0))#2 S:'$D(^DIC(19,XQDIC,99)) ^DIC(19,XQDIC,99)=$H S %H=^DIC(19,XQDIC,99)
- I XQDIC'=+XQDIC S:'$D(^VA(200,DUZ,203.1)) ^VA(200,DUZ,203.1)=$H S %H=^VA(200,DUZ,203.1)
- S ^XUTL("XQO",XQDIC,0,XQSM)=XQSD,^XUTL("XQO",XQDIC,0)=XQSM_U_%H
- S XQSY=0 F XQSI=0:0 S XQSY=$O(XQST(XQSY)) Q:XQSY="" S %=XQST(XQSY),XQSK=$E(XQSY,5,99) D:$E(XQSK,1)=" " XBLK S:$L(XQSK) ^XUTL("XQO",XQDIC,XQSK)=%
- K %,%H,X,XQNO,XQSA,XQSB,XQSD,XQSDO,XQSI,XQSL,XQSK,XQS0,XQSOO,XQSPR,XQSN,XQST,XQSM,XQSX,XQSZ,XQSY
- Q
- ;
- SET1 Q:'$D(^DIC(19,+XQSY,0)) S XQS0=^(0),X=$S($D(^("U")):^("U"),1:"") I X="" S X=$E($P(XQS0,U,2),1,30) D UP S ^("U")=X
- S XQSOO=$P(XQS0,U,3),XQS0=$P(XQS0,U,1,2)_U_($S($P(XQS0,U,3)]"":1,1:""))_U_$P(XQS0,U,4,99)
- S (XQSX,XQSZ)="",%=$P(XQS0,U,9) I %]"",$L(%)>2 S XQSX=%_"MO-FR",XQSZ="MO-FR "_%
- I $D(^DIC(19,+XQSY,3.91)) F XQSL=0:0 S XQSL=$O(^DIC(19,+XQSY,3.91,XQSL)) Q:XQSL'>0 I ^(XQSL,0)]"" S XQSX=$S(XQSX'="":XQSX_";",1:"")_$P(^(0),U,1)_$P(^(0),U,2),XQSZ=$S(XQSZ'="":XQSZ_"; ",1:"")_$P(^(0),U,2)_" "_$P(^(0),U,1)
- I XQSX]"" S $P(XQS0,U,9)=XQSX
- S XQSX="" I $P(XQS0,U,16),$D(^DIC(19,+XQSY,3)) S XQSX=$P(^(3),U) I XQSX'="" S $P(XQS0,U,16)=XQSX
- S XQSN=$P(XQSY,U,2),XQSDO=$P(XQSY,U,3),^XUTL("XQO",XQDIC,"^",+XQSY)=XQSN_U_$P(XQS0,U,1,4)_"^^"_$P(XQS0,U,6,99)
- I $L(X) S:X?.N X=" "_X S X=$S($L(XQSN):"ZZZZ",$L(XQSDO):$E(0,1,($L(XQSDO*100)=3))_(XQSDO*100),1:"BBBB")_X D:$D(XQST(X)) SET3 S XQST(X)=+XQSY_"^1"
- I $L(XQSN) S X=XQSN D UP Q:'$L(X) S:X?.N X=$E(" ",1,5-$L(X))_X S X=$S($L(XQSDO):$E(0,1,($L(XQSDO*100)=3))_(XQSDO*100),1:"AAAA")_X D:$D(XQST(X)) SET3 S XQST(X)=+XQSY_"^0"
- S:XQSOO]"" XQST(X,"OO")=XQSOO
- S:XQSZ]"" XQST(X,"TM")=XQSZ
- Q
- SET3 S XQSD=X F I=0:0 S XQSM=$O(XQST(XQSD)) Q:($P(XQSM,U,1)'=X) S XQSD=XQSM
- S I=+$P(XQSD,U,2) S X=X_U_(I+1) Q
- CK ;
- S %=$P(^DIC(19,D0,0),U,6),%Y=$P(^DIC(19,D0,0),U,1) I $S($L(%):$D(^XUSEC(%,DUZ)),1:1)
- Q:'$T
- I DUZ(0)="@"!$D(^XUSEC("XUMGR",DUZ))!$D(^VA(200,DUZ,19.5,Y,0))
- Q:'$T
- CK1 S %=$P(^DIC(19,D0,0),U,4),%Y=$P(^DIC(19,Y,0),U,4) I $S((%'="O"&(%'="Q"))&(%Y'="Q"):1,(%="O"&(%Y="O")):1,(%="Q"&((%Y="O")!(%Y="Q"))):1,1:0)
- Q
- DEV ;See if device is legit for this option
- S (%,XQSJ)=0 Q:'$D(^DIC(19,+XQSW,3.96,0))
- F XQSL=1:1 S %=$O(^DIC(19,+XQSW,3.96,%)) Q:%=""!(%'=+%) S:XQSIO=^(%,0) XQSJ=1
- Q
- UP S X=$$UP^XLFSTR(X) ;F XQSA=1:1 Q:X?.NUP S %=$A(X,XQSA) I %<123,%>96 S X=$E(X,1,XQSA-1)_$C(%-32)_$E(X,XQSA+1,255)
- Q
- XBLK F XASB=0:0 S XQSW=$E(XQSK,1) Q:XQSW'=" " S XQSK=$E(XQSK,2,99)
- Q
- DIS ;Create display nodes
- S %=$S($D(^XUTL("XQO",XQDIC,"^",XQS0)):^(XQS0),1:"") S:$L(%) XQS0=% I '$L(%) S %=$O(^DIC(19,XQDIC,10,"B",XQS0,%)),%=$P(^DIC(19,XQDIC,10,%,0),U,2),XQS0=%_U_^DIC(19,XQS0,0)
- I "MO"[$P(XQS0,U,5) S $P(XQS0,U,3)=$P(XQS0,U,3)_" ..."
- I "SB"[$P(XQS0,U,5) S XQNO=1 ;Don't Display servers or broker-type options
- S XQS0=$P(XQS0,U,1,3)_U_$S($D(XQST(XQSY,"OO")):XQST(XQSY,"OO"),1:"")_U_$P(XQS0,U,7)_U_$S($D(XQST(XQSY,"TM")):XQST(XQSY,"TM"),1:"")_U_$P(XQS0,U,11)_U_$P(XQS0,U,17)_U
- Q
- XQSET ;MJM/SEA - Rebuild display/user XUTL("XQO") ;05/09/2011
- +1 ;;8.0;KERNEL;**28,82,155,569**;Jul 10, 1995;Build 4
- SET ;Rebuild the +XQDIC and "U"_DUZ nodes
- +1 ;
- +2 ;** P569 START CJM
- +3 IF XQDIC["U"
- IF $PIECE(XQDIC,"U",2)'=DUZ
- Begin DoDot:1
- +4 Begin DoDot:2
- +5 NEW DUZ
- +6 SET DUZ=$PIECE(XQDIC,"U",2)
- +7 DO NEWSET
- End DoDot:2
- +8 Begin DoDot:2
- +9 NEW XQDIC
- +10 SET XQDIC="U"_DUZ
- +11 DO NEWSET
- End DoDot:2
- End DoDot:1
- QUIT
- +12 DO NEWSET
- +13 QUIT
- +14 ;
- NEWSET ;
- +1 ;
- +2 ; ** P569 END CJM
- +3 ;
- +4 KILL ^XUTL("XQO",XQDIC)
- +5 IF XQDIC=+XQDIC
- IF '$DATA(^DIC(19,XQDIC,0))
- QUIT
- +6 FOR XQSI=0:0
- SET XQSI=$SELECT(+XQDIC:$ORDER(^DIC(19,XQDIC,10,XQSI)),1:$ORDER(^VA(200,DUZ,203,XQSI)))
- IF XQSI'>0
- QUIT
- IF $DATA(^(XQSI,0))
- SET XQSY=^(0)
- DO SET1
- +7 SET XQSK=250
- SET XQSD=""
- SET XQSM=1
- SET XQSY=0
- SET XQNO=0
- +8 FOR XQSI=0:0
- SET XQSY=$ORDER(XQST(XQSY))
- IF XQSY=""!($EXTRACT(XQSY,1,4)="ZZZZ")
- QUIT
- Begin DoDot:1
- +9 SET XQS0=+XQST(XQSY)
- +10 DO DIS
- +11 IF (XQSK<$LENGTH(XQS0))
- SET ^XUTL("XQO",XQDIC,0,XQSM)=XQSD
- SET XQSD=""
- SET XQSK=250
- SET XQSM=XQSM+1
- +12 IF XQNO
- SET XQNO=0
- QUIT
- +13 SET XQSD=XQSD_XQS0
- SET XQSK=XQSK-$LENGTH(XQS0)
- +14 QUIT
- End DoDot:1
- +15 IF XQDIC=+XQDIC
- IF $DATA(^DIC(19,XQDIC,0))#2
- IF '$DATA(^DIC(19,XQDIC,99))
- SET ^DIC(19,XQDIC,99)=$HOROLOG
- SET %H=^DIC(19,XQDIC,99)
- +16 IF XQDIC'=+XQDIC
- IF '$DATA(^VA(200,DUZ,203.1))
- SET ^VA(200,DUZ,203.1)=$HOROLOG
- SET %H=^VA(200,DUZ,203.1)
- +17 SET ^XUTL("XQO",XQDIC,0,XQSM)=XQSD
- SET ^XUTL("XQO",XQDIC,0)=XQSM_U_%H
- +18 SET XQSY=0
- FOR XQSI=0:0
- SET XQSY=$ORDER(XQST(XQSY))
- IF XQSY=""
- QUIT
- SET %=XQST(XQSY)
- SET XQSK=$EXTRACT(XQSY,5,99)
- IF $EXTRACT(XQSK,1)=" "
- DO XBLK
- IF $LENGTH(XQSK)
- SET ^XUTL("XQO",XQDIC,XQSK)=%
- +19 KILL %,%H,X,XQNO,XQSA,XQSB,XQSD,XQSDO,XQSI,XQSL,XQSK,XQS0,XQSOO,XQSPR,XQSN,XQST,XQSM,XQSX,XQSZ,XQSY
- +20 QUIT
- +21 ;
- SET1 IF '$DATA(^DIC(19,+XQSY,0))
- QUIT
- SET XQS0=^(0)
- SET X=$SELECT($DATA(^("U")):^("U"),1:"")
- IF X=""
- SET X=$EXTRACT($PIECE(XQS0,U,2),1,30)
- DO UP
- SET ^("U")=X
- +1 SET XQSOO=$PIECE(XQS0,U,3)
- SET XQS0=$PIECE(XQS0,U,1,2)_U_($SELECT($PIECE(XQS0,U,3)]"":1,1:""))_U_$PIECE(XQS0,U,4,99)
- +2 SET (XQSX,XQSZ)=""
- SET %=$PIECE(XQS0,U,9)
- IF %]""
- IF $LENGTH(%)>2
- SET XQSX=%_"MO-FR"
- SET XQSZ="MO-FR "_%
- +3 IF $DATA(^DIC(19,+XQSY,3.91))
- FOR XQSL=0:0
- SET XQSL=$ORDER(^DIC(19,+XQSY,3.91,XQSL))
- IF XQSL'>0
- QUIT
- IF ^(XQSL,0)]""
- SET XQSX=$SELECT(XQSX'="":XQSX_";",1:"")_$PIECE(^(0),U,1)_$PIECE(^(0),U,2)
- SET XQSZ=$SELECT(XQSZ'="":XQSZ_"; ",1:"")_$PIECE(^(0),U,2)_" "_$PIECE(^(0),U,1)
- +4 IF XQSX]""
- SET $PIECE(XQS0,U,9)=XQSX
- +5 SET XQSX=""
- IF $PIECE(XQS0,U,16)
- IF $DATA(^DIC(19,+XQSY,3))
- SET XQSX=$PIECE(^(3),U)
- IF XQSX'=""
- SET $PIECE(XQS0,U,16)=XQSX
- +6 SET XQSN=$PIECE(XQSY,U,2)
- SET XQSDO=$PIECE(XQSY,U,3)
- SET ^XUTL("XQO",XQDIC,"^",+XQSY)=XQSN_U_$PIECE(XQS0,U,1,4)_"^^"_$PIECE(XQS0,U,6,99)
- +7 IF $LENGTH(X)
- IF X?.N
- SET X=" "_X
- SET X=$SELECT($LENGTH(XQSN):"ZZZZ",$LENGTH(XQSDO):$EXTRACT(0,1,($LENGTH(XQSDO*100)=3))_(XQSDO*100),1:"BBBB")_X
- IF $DATA(XQST(X))
- DO SET3
- SET XQST(X)=+XQSY_"^1"
- +8 IF $LENGTH(XQSN)
- SET X=XQSN
- DO UP
- IF '$LENGTH(X)
- QUIT
- IF X?.N
- SET X=$EXTRACT(" ",1,5-$LENGTH(X))_X
- SET X=$SELECT($LENGTH(XQSDO):$EXTRACT(0,1,($LENGTH(XQSDO*100)=3))_(XQSDO*100),1:"AAAA")_X
- IF $DATA(XQST(X))
- DO SET3
- SET XQST(X)=+XQSY_"^0"
- +9 IF XQSOO]""
- SET XQST(X,"OO")=XQSOO
- +10 IF XQSZ]""
- SET XQST(X,"TM")=XQSZ
- +11 QUIT
- SET3 SET XQSD=X
- FOR I=0:0
- SET XQSM=$ORDER(XQST(XQSD))
- IF ($PIECE(XQSM,U,1)'=X)
- QUIT
- SET XQSD=XQSM
- +1 SET I=+$PIECE(XQSD,U,2)
- SET X=X_U_(I+1)
- QUIT
- CK ;
- +1 SET %=$PIECE(^DIC(19,D0,0),U,6)
- SET %Y=$PIECE(^DIC(19,D0,0),U,1)
- IF $SELECT($LENGTH(%):$DATA(^XUSEC(%,DUZ)),1:1)
- +2 IF '$TEST
- QUIT
- +3 IF DUZ(0)="@"!$DATA(^XUSEC("XUMGR",DUZ))!$DATA(^VA(200,DUZ,19.5,Y,0))
- +4 IF '$TEST
- QUIT
- CK1 SET %=$PIECE(^DIC(19,D0,0),U,4)
- SET %Y=$PIECE(^DIC(19,Y,0),U,4)
- IF $SELECT((%'="O"&(%'="Q"))&(%Y'="Q"):1,(%="O"&(%Y="O")):1,(%="Q"&((%Y="O")!(%Y="Q"))):1,1:0)
- +1 QUIT
- DEV ;See if device is legit for this option
- +1 SET (%,XQSJ)=0
- IF '$DATA(^DIC(19,+XQSW,3.96,0))
- QUIT
- +2 FOR XQSL=1:1
- SET %=$ORDER(^DIC(19,+XQSW,3.96,%))
- IF %=""!(%'=+%)
- QUIT
- IF XQSIO=^(%,0)
- SET XQSJ=1
- +3 QUIT
- UP ;F XQSA=1:1 Q:X?.NUP S %=$A(X,XQSA) I %<123,%>96 S X=$E(X,1,XQSA-1)_$C(%-32)_$E(X,XQSA+1,255)
- SET X=$$UP^XLFSTR(X)
- +1 QUIT
- XBLK FOR XASB=0:0
- SET XQSW=$EXTRACT(XQSK,1)
- IF XQSW'=" "
- QUIT
- SET XQSK=$EXTRACT(XQSK,2,99)
- +1 QUIT
- DIS ;Create display nodes
- +1 SET %=$SELECT($DATA(^XUTL("XQO",XQDIC,"^",XQS0)):^(XQS0),1:"")
- IF $LENGTH(%)
- SET XQS0=%
- IF '$LENGTH(%)
- SET %=$ORDER(^DIC(19,XQDIC,10,"B",XQS0,%))
- SET %=$PIECE(^DIC(19,XQDIC,10,%,0),U,2)
- SET XQS0=%_U_^DIC(19,XQS0,0)
- +2 IF "MO"[$PIECE(XQS0,U,5)
- SET $PIECE(XQS0,U,3)=$PIECE(XQS0,U,3)_" ..."
- +3 ;Don't Display servers or broker-type options
- IF "SB"[$PIECE(XQS0,U,5)
- SET XQNO=1
- +4 SET XQS0=$PIECE(XQS0,U,1,3)_U_$SELECT($DATA(XQST(XQSY,"OO")):XQST(XQSY,"OO"),1:"")_U_$PIECE(XQS0,U,7)_U_$SELECT($DATA(XQST(XQSY,"TM")):XQST(XQSY,"TM"),1:"")_U_$PIECE(XQS0,U,11)_U_$PIECE(XQS0,U,17)_U
- +5 QUIT
