XQT5.m

XQT5 ;SEA/MJM - Menu Template Utilities ;11/17/94  08:53 [ 04/02/2003   8:29 AM ]

 ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003

 ;;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

XQT5      ;SEA/MJM - Menu Template Utilities ;11/17/94  08:53 [ 04/02/2003   8:29 AM ]

 +1       ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003

 +2       ;;8.0;KERNEL;;Jul 10, 1995

 +3       ;

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