XQ83D.m

XQ83D ;ISC-SF..SEA/JLI - MICRO SURGERY ON MENU TREES FOR ITEM DELETED FROM MENU ;04/16/2002  13:58 [ 07/29/2004   9:01 AM ]

 ;;8.0;KERNEL;**157**;Jul 10, 1995

 I $D(^DIC(19,+XQOPM,0)),$D(^(10,"B",+XQOPI)) S XQB=$O(^(+XQOPI,0)) I $D(^DIC(19,+XQOPM,10,XQB,0)),+^(0)=+XQOPI Q  ;  item hasn't been removed, or was put back on

 D TABLE^XQ83A

 S A="P" F XQI=0:0 S A=$O(^XUTL("XQO",A)) Q:A'["P"  I $D(^(A,U,XQOPI)),$D(^(XQOPM)) S XQAKEY=$S(+$E(A,2,99)=+XQOPM:1,1:0) D A

 Q

XPAND ;

 F L=0:0 S L=$O(^DIC(19,XQNEW,10,L)) Q:L'>0  S T=+^(L,0) I $P(^DIC(19,T,0),U,3)="",'$D(^TMP($J,"ACT",T)) S K=K+1,^(T)="",^TMP($J,"NEW",K)=T

 Q

 ;

A ;

 S PATH=""

 F XQ83DI=0:0 S PATH=$O(^TMP($J,"PATH",PATH)) Q:PATH=""  S XQ83DN=$L(PATH,","),XQJ=$P(PATH,",",XQ83DN-1),XQVAL=^(PATH),XQSYN=^(PATH,"SYN"),XQUC=^("U") I $D(^XUTL("XQO",A,U,XQJ)) S XQPATH=","_$S(XQAKEY:"",1:XQOPM_",")_PATH D DA

 K XQB,XQFND,XQJ,XQSYN,XQPATH,XQ83DI,XQ83DN,PATH

 Q

 ;

DA ;

 F XQK=0:0 S XQK=$O(^XUTL("XQO",A,U,XQJ,0,XQK)) Q:XQK'>0  S XQB=$P(^(XQK),U) I ","_XQB[XQPATH S ^(0)=^XUTL("XQO",A,U,XQJ,0)-1 K:^(0)'>0 ^(0) K ^(0,XQK) I XQSYN'="" S XQ2=XQSYN,XQ1=XQJ_U_"0" D DELNAM

 S XQB=$P(^XUTL("XQO",A,U,XQJ),U,6) I ","_XQB[XQPATH D DA1 I XQSYN'="" S XQ2=XQSYN,XQ1=XQJ_U_"0" D DELNAM

 I '$D(^XUTL("XQO",A,U,XQJ)) S XQ2=$E(XQUC,1,27),XQ1=XQJ_U_"1" D DELNAM

 Q

 ;

DA1 ;

 I $D(^XUTL("XQO",A,U,XQJ))'>9 K ^(XQJ) Q

 S XQ2=^XUTL("XQO",A,U,XQJ)

 ;

 S XQ1=0 F XQJJ=0:0 S XQJJ=$O(^XUTL("XQO",A,U,XQJ,0,XQJJ)) Q:XQJJ'>0  S XQ1=XQJJ

 S XQA=^XUTL("XQO",A,U,XQJ,0,XQ1),^(XQJ)=$P(^XUTL("XQO",A,U,XQJ),U,1,5)_U_$P(XQA,U,1,2)_U_$P(^(XQJ),U,8,9)_U_$P(XQA,U,3,4)_U_$P(^(XQJ),U,12,16)_U_$P(XQA,U,5)_U_$P(^(XQJ),U,18,99),^(0)=^(XQJ,0)-1 K:^(0)=0 ^(0) K ^(0,XQ1),XQA,XQ1,XQ2

 Q

 ;

DELNAM ;

 S XQ3=XQ2 F XQK=0:0 S XQ3=$O(^XUTL("XQO",A,XQ3)) Q:$E(XQ3,1,$L(XQ2))'=XQ2  I ^(XQ3)=XQ1 K ^(XQ3) Q

 K XQ1,XQ2,XQ3

 Q

 ;

XQ83D     ;ISC-SF..SEA/JLI - MICRO SURGERY ON MENU TREES FOR ITEM DELETED FROM MENU ;04/16/2002  13:58 [ 07/29/2004   9:01 AM ]

 +1       ;;8.0;KERNEL;**157**;Jul 10, 1995

 +2       ;  item hasn't been removed, or was put back on

           IF $DATA(^DIC(19,+XQOPM,0))

               IF $DATA(^(10,"B",+XQOPI))

                   SET XQB=$ORDER(^(+XQOPI,0))

                   IF $DATA(^DIC(19,+XQOPM,10,XQB,0))

                       IF +^(0)=+XQOPI

                           QUIT 

 +3        DO TABLE^XQ83A

 +4        SET A="P"

           FOR XQI=0:0

               SET A=$ORDER(^XUTL("XQO",A))

               IF A'["P"

                   QUIT 

               IF $DATA(^(A,U,XQOPI))

                   IF $DATA(^(XQOPM))

                       SET XQAKEY=$SELECT(+$EXTRACT(A,2,99)=+XQOPM:1,1:0)

                       DO A

 +5        QUIT 

XPAND     ;

 +1        FOR L=0:0

               SET L=$ORDER(^DIC(19,XQNEW,10,L))

               IF L'>0

                   QUIT 

               SET T=+^(L,0)

               IF $PIECE(^DIC(19,T,0),U,3)=""

                   IF '$DATA(^TMP($JOB,"ACT",T))

                       SET K=K+1

                       SET ^(T)=""

                       SET ^TMP($JOB,"NEW",K)=T

 +2        QUIT 

 +3       ;

A         ;

 +1        SET PATH=""

 +2        FOR XQ83DI=0:0

               SET PATH=$ORDER(^TMP($JOB,"PATH",PATH))

               IF PATH=""

                   QUIT 

               SET XQ83DN=$LENGTH(PATH,",")

               SET XQJ=$PIECE(PATH,",",XQ83DN-1)

               SET XQVAL=^(PATH)

               SET XQSYN=^(PATH,"SYN")

               SET XQUC=^("U")

               IF $DATA(^XUTL("XQO",A,U,XQJ))

                   SET XQPATH=","_$SELECT(XQAKEY:"",1:XQOPM_",")_PATH

                   DO DA

 +3        KILL XQB,XQFND,XQJ,XQSYN,XQPATH,XQ83DI,XQ83DN,PATH

 +4        QUIT 

 +5       ;

DA        ;

 +1        FOR XQK=0:0

               SET XQK=$ORDER(^XUTL("XQO",A,U,XQJ,0,XQK))

               IF XQK'>0

                   QUIT 

               SET XQB=$PIECE(^(XQK),U)

               IF ","_XQB[XQPATH

                   SET ^(0)=^XUTL("XQO",A,U,XQJ,0)-1

                   IF ^(0)'>0

                       KILL ^(0)

                   KILL ^(0,XQK)

                   IF XQSYN'=""

                       SET XQ2=XQSYN

                       SET XQ1=XQJ_U_"0"

                       DO DELNAM

 +2        SET XQB=$PIECE(^XUTL("XQO",A,U,XQJ),U,6)

           IF ","_XQB[XQPATH

               DO DA1

               IF XQSYN'=""

                   SET XQ2=XQSYN

                   SET XQ1=XQJ_U_"0"

                   DO DELNAM

 +3        IF '$DATA(^XUTL("XQO",A,U,XQJ))

               SET XQ2=$EXTRACT(XQUC,1,27)

               SET XQ1=XQJ_U_"1"

               DO DELNAM

 +4        QUIT 

 +5       ;

DA1       ;

 +1        IF $DATA(^XUTL("XQO",A,U,XQJ))'>9

               KILL ^(XQJ)

               QUIT 

 +2        SET XQ2=^XUTL("XQO",A,U,XQJ)

 +3       ;

 +4        SET XQ1=0

           FOR XQJJ=0:0

               SET XQJJ=$ORDER(^XUTL("XQO",A,U,XQJ,0,XQJJ))

               IF XQJJ'>0

                   QUIT 

               SET XQ1=XQJJ

 +5        SET XQA=^XUTL("XQO",A,U,XQJ,0,XQ1)

           SET ^(XQJ)=$PIECE(^XUTL("XQO",A,U,XQJ),U,1,5)_U_$PIECE(XQA,U,1,2)_U_$PIECE(^(XQJ),U,8,9)_U_$PIECE(XQA,U,3,4)_U_$PIECE(^(XQJ),U,12,16)_U_$PIECE(XQA,U,5)_U_$PIECE(^(XQJ),U,18,99)

           SET ^(0)=^(XQJ,0)-1

           IF ^(0)=0

               KILL ^(0)

           KILL ^(0,XQ1),XQA,XQ1,XQ2

 +6        QUIT 

 +7       ;

DELNAM    ;

 +1        SET XQ3=XQ2

           FOR XQK=0:0

               SET XQ3=$ORDER(^XUTL("XQO",A,XQ3))

               IF $EXTRACT(XQ3,1,$LENGTH(XQ2))'=XQ2

                   QUIT 

               IF ^(XQ3)=XQ1

                   KILL ^(XQ3)

                   QUIT 

 +2        KILL XQ1,XQ2,XQ3

 +3        QUIT 

 +4       ;