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