XQT5 ;SEA/MJM - Menu Template Utilities ;11/17/94 08:53
;;8.0;KERNEL;;Jul 10, 1995
;
NO1 ;Check 1st menu to see if the tree is still good
S XQPM=^XUTL("XQ",$J,"XQM"),XQMA=$P(^VA(200,DUZ,19.8,XQN,1,1,0),",",2),XQSIB=+$P(^(0),U,2),XQCO=$O(^DIC(19,"B","XUCOMMAND",0)),XQNO1=1
I XQMA["U" N XQDIC S XQDIC="U"_DUZ,XQNO1=0 D SETU I '$D(^XUTL("XQO",XQMA,"^",XQSIB)) S XQY=-1
I XQNO1,XQMA=XQCO N XQDIC S XQDIC=XQCO,XQNO1=0 D SET I '$D(^XUTL("XQO",XQMA,"^",XQSIB)) S XQY=-1
I XQNO1 S:XQPM'=XQMA XQY=-1 N XQDIC S XQDIC=XQPM D SET I '$D(^XUTL("XQO",XQPM,"^",XQSIB)) S XQY=-1
I XQMA=XQPM N XQDIC S XQDIC=XQPM D SET
I XQY=-1 W !!,*7,"==> Your menu structure has changed. Sorry,",!?4,"you will have to recreate this template." K ^XUTL("XQT",$J,XQUR)
Q
;
SET ;Build the ^XUTL("XQO",+XQDIC [ or "U"_DUZ]) nodes if need be
L +^XUTL("XQO",XQDIC):5 D:$S('$D(^XUTL("XQO",XQDIC,0)):1,'$D(^DIC(19,XQDIC,99)):1,1:^DIC(19,XQDIC,99)'=$P(^XUTL("XQO",XQDIC,0),U,2)) ^XQSET L -^XUTL("XQO",XQDIC)
Q
;
SETU ;Build the ^XUTL("XQO","U"_DUZ) nodes if need be
D:$S('$D(^XUTL("XQO","U"_DUZ)):1,'$D(^VA(200,DUZ,203.1)):1,1:^VA(200,DUZ,203.1)'=$P(^XUTL("XQO","U"_DUZ,0),U,2)) ^XQSET
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXQT5 1183 printed Dec 13, 2024@02:06:52 Page 2
XQT5 ;SEA/MJM - Menu Template Utilities ;11/17/94 08:53
+1 ;;8.0;KERNEL;;Jul 10, 1995
+2 ;
NO1 ;Check 1st menu to see if the tree is still good
+1 SET XQPM=^XUTL("XQ",$JOB,"XQM")
SET XQMA=$PIECE(^VA(200,DUZ,19.8,XQN,1,1,0),",",2)
SET XQSIB=+$PIECE(^(0),U,2)
SET XQCO=$ORDER(^DIC(19,"B","XUCOMMAND",0))
SET XQNO1=1
+2 IF XQMA["U"
NEW XQDIC
SET XQDIC="U"_DUZ
SET XQNO1=0
DO SETU
IF '$DATA(^XUTL("XQO",XQMA,"^",XQSIB))
SET XQY=-1
+3 IF XQNO1
IF XQMA=XQCO
NEW XQDIC
SET XQDIC=XQCO
SET XQNO1=0
DO SET
IF '$DATA(^XUTL("XQO",XQMA,"^",XQSIB))
SET XQY=-1
+4 IF XQNO1
if XQPM'=XQMA
SET XQY=-1
NEW XQDIC
SET XQDIC=XQPM
DO SET
IF '$DATA(^XUTL("XQO",XQPM,"^",XQSIB))
SET XQY=-1
+5 IF XQMA=XQPM
NEW XQDIC
SET XQDIC=XQPM
DO SET
+6 IF XQY=-1
WRITE !!,*7,"==> Your menu structure has changed. Sorry,",!?4,"you will have to recreate this template."
KILL ^XUTL("XQT",$JOB,XQUR)
+7 QUIT
+8 ;
SET ;Build the ^XUTL("XQO",+XQDIC [ or "U"_DUZ]) nodes if need be
+1 LOCK +^XUTL("XQO",XQDIC):5
if $SELECT('$DATA(^XUTL("XQO",XQDIC,0))
DO ^XQSET
LOCK -^XUTL("XQO",XQDIC)
+2 QUIT
+3 ;
SETU ;Build the ^XUTL("XQO","U"_DUZ) nodes if need be
+1 if $SELECT('$DATA(^XUTL("XQO","U"_DUZ))
DO ^XQSET
+2 QUIT
