Released XU*8*537 SEQ #449 Extracted from mail message **KIDS**:XU*8.0*537^ **INSTALL NAME** XU*8.0*537 "BLD",1264,0) XU*8.0*537^KERNEL^0^3091203^y "BLD",1264,1,0) ^^2^2^3091027^ "BLD",1264,1,1,0) Kernel patch XU*8.0*537; Fix UNDEFINED in XQ83A. Please refer "BLD",1264,1,2,0) to the Description in Forum Patch Module for details. "BLD",1264,4,0) ^9.64PA^^ "BLD",1264,6.3) 3 "BLD",1264,"ABPKG") n "BLD",1264,"KRN",0) ^9.67PA^9002226^21 "BLD",1264,"KRN",.4,0) .4 "BLD",1264,"KRN",.401,0) .401 "BLD",1264,"KRN",.402,0) .402 "BLD",1264,"KRN",.403,0) .403 "BLD",1264,"KRN",.5,0) .5 "BLD",1264,"KRN",.84,0) .84 "BLD",1264,"KRN",3.6,0) 3.6 "BLD",1264,"KRN",3.8,0) 3.8 "BLD",1264,"KRN",9.2,0) 9.2 "BLD",1264,"KRN",9.8,0) 9.8 "BLD",1264,"KRN",9.8,"NM",0) ^9.68A^1^1 "BLD",1264,"KRN",9.8,"NM",1,0) XQ83A^^0^B28714957 "BLD",1264,"KRN",9.8,"NM","B","XQ83A",1) "BLD",1264,"KRN",19,0) 19 "BLD",1264,"KRN",19.1,0) 19.1 "BLD",1264,"KRN",101,0) 101 "BLD",1264,"KRN",409.61,0) 409.61 "BLD",1264,"KRN",771,0) 771 "BLD",1264,"KRN",779.2,0) 779.2 "BLD",1264,"KRN",870,0) 870 "BLD",1264,"KRN",8989.51,0) 8989.51 "BLD",1264,"KRN",8989.52,0) 8989.52 "BLD",1264,"KRN",8994,0) 8994 "BLD",1264,"KRN",9002226,0) 9002226 "BLD",1264,"KRN","B",.4,.4) "BLD",1264,"KRN","B",.401,.401) "BLD",1264,"KRN","B",.402,.402) "BLD",1264,"KRN","B",.403,.403) "BLD",1264,"KRN","B",.5,.5) "BLD",1264,"KRN","B",.84,.84) "BLD",1264,"KRN","B",3.6,3.6) "BLD",1264,"KRN","B",3.8,3.8) "BLD",1264,"KRN","B",9.2,9.2) "BLD",1264,"KRN","B",9.8,9.8) "BLD",1264,"KRN","B",19,19) "BLD",1264,"KRN","B",19.1,19.1) "BLD",1264,"KRN","B",101,101) "BLD",1264,"KRN","B",409.61,409.61) "BLD",1264,"KRN","B",771,771) "BLD",1264,"KRN","B",779.2,779.2) "BLD",1264,"KRN","B",870,870) "BLD",1264,"KRN","B",8989.51,8989.51) "BLD",1264,"KRN","B",8989.52,8989.52) "BLD",1264,"KRN","B",8994,8994) "BLD",1264,"KRN","B",9002226,9002226) "BLD",1264,"QDEF") ^^^^NO^^^^NO^^NO "BLD",1264,"QUES",0) ^9.62^^ "BLD",1264,"REQB",0) ^9.611^1^1 "BLD",1264,"REQB",1,0) XU*8.0*494^0 "BLD",1264,"REQB","B","XU*8.0*494",1) "MBREQ") 0 "PKG",3,-1) 1^1 "PKG",3,0) KERNEL^XU^SIGN-ON, SECURITY, MENU DRIVER, DEVICES, TASKMAN^ "PKG",3,20,0) ^9.402P^^0 "PKG",3,22,0) ^9.49I^1^1 "PKG",3,22,1,0) 8.0^3090706^3090706^6 "PKG",3,22,1,"PAH",1,0) 537^3091203 "PKG",3,22,1,"PAH",1,1,0) ^^2^2^3091203 "PKG",3,22,1,"PAH",1,1,1,0) Kernel patch XU*8.0*537; Fix UNDEFINED in XQ83A. Please refer "PKG",3,22,1,"PAH",1,1,2,0) to the Description in Forum Patch Module for details. "QUES","XPF1",0) Y "QUES","XPF1","??") ^D REP^XPDH "QUES","XPF1","A") Shall I write over your |FLAG| File "QUES","XPF1","B") YES "QUES","XPF1","M") D XPF1^XPDIQ "QUES","XPF2",0) Y "QUES","XPF2","??") ^D DTA^XPDH "QUES","XPF2","A") Want my data |FLAG| yours "QUES","XPF2","B") YES "QUES","XPF2","M") D XPF2^XPDIQ "QUES","XPI1",0) YO "QUES","XPI1","??") ^D INHIBIT^XPDH "QUES","XPI1","A") Want KIDS to INHIBIT LOGONs during the install "QUES","XPI1","B") NO "QUES","XPI1","M") D XPI1^XPDIQ "QUES","XPM1",0) PO^VA(200,:EM "QUES","XPM1","??") ^D MG^XPDH "QUES","XPM1","A") Enter the Coordinator for Mail Group '|FLAG|' "QUES","XPM1","B") "QUES","XPM1","M") D XPM1^XPDIQ "QUES","XPO1",0) Y "QUES","XPO1","??") ^D MENU^XPDH "QUES","XPO1","A") Want KIDS to Rebuild Menu Trees Upon Completion of Install "QUES","XPO1","B") NO "QUES","XPO1","M") D XPO1^XPDIQ "QUES","XPZ1",0) Y "QUES","XPZ1","??") ^D OPT^XPDH "QUES","XPZ1","A") Want to DISABLE Scheduled Options, Menu Options, and Protocols "QUES","XPZ1","B") NO "QUES","XPZ1","M") D XPZ1^XPDIQ "QUES","XPZ2",0) Y "QUES","XPZ2","??") ^D RTN^XPDH "QUES","XPZ2","A") Want to MOVE routines to other CPUs "QUES","XPZ2","B") NO "QUES","XPZ2","M") D XPZ2^XPDIQ "RTN") 1 "RTN","XQ83A") 0^1^B28714957^B28620340 "RTN","XQ83A",1,0) XQ83A ;ISC-SF..SEA/JLI,LUKE - MICROSURGERY ON MENU TREES TO ADD A NEW ITEM TO A MENU ;10/27/2009 "RTN","XQ83A",2,0) ;;8.0;KERNEL;**157,494,537**;Jul 10, 1995;Build 3 "RTN","XQ83A",3,0) ;;"Per VHA Directive 2004-038, this routine should not be modified". "RTN","XQ83A",4,0) ENTRY ; "RTN","XQ83A",5,0) D TABLE "RTN","XQ83A",6,0) I XQC'="P" S A="P" F XQJ=0:0 S A=$O(^DIC(19,"AXP",A)) Q:$E(A)'="P" I $D(^(A,U,XQOPM)) L +^DIC(19,"AXP",A):10 Q:'$T K ^(A,0) D ADD S ^DIC(19,"AXP",A,0)=%XQT1 L -^DIC(19,"AXP",A) "RTN","XQ83A",7,0) K L,M,N,P,R,S,T,XQJ,XQLAST,XQLM,XQLM1,XQNAM,XQNAME,XQNEW,XQOLD,XQP1,XQP2,XQPATH,XQSYN "RTN","XQ83A",8,0) Q "RTN","XQ83A",9,0) TABLE ; "RTN","XQ83A",10,0) K ^TMP($J,"NEW"),^("S2"),^("PATH") Q:'$D(^DIC(19,XQOPI,0)) "RTN","XQ83A",11,0) S ^TMP($J,"NEW",1,1)=XQOPI_",",S2=^DIC(19,XQOPI,0) S:$P(S2,U,3)'="" $P(S2,U,6)=" OOO " K SU S:$D(^("U")) SU=^("U") "RTN","XQ83A",12,0) S XQP="" F IJ=0:0 S IJ=$O(^DIC(19,XQOPI,3.91,IJ)) Q:IJ'>0 I ($D(^(IJ,0))#2),$P(^(0),U)'="" S XQP=$S(XQP="":"",1:XQP_",")_$P(^(0),U)_$P(^(0),U,2) "RTN","XQ83A",13,0) S:XQP'="" $P(S2,U,9)=XQP S ^TMP($J,"S2",XQOPI)=S2 S:$D(SU) ^(XQOPI,"U")=SU I XQC="P" S XQNEW=XQOPM,XQOLD="",N=1,S=1 D XPAND "RTN","XQ83A",14,0) F J=0:0 S J=$O(^TMP($J,"NEW",J)),N=J+1,S=1 Q:J'>0 F K=0:0 S K=$O(^TMP($J,"NEW",J,K)) Q:K'>0 S XQOLD=^(K),XQNEW=+$P(XQOLD,",",J) I $D(^DIC(19,XQNEW,10)) D XPAND "RTN","XQ83A",15,0) D PATHS K ^TMP($J,"OLD"),^("NEW"),^("S2") "RTN","XQ83A",16,0) Q "RTN","XQ83A",17,0) ; "RTN","XQ83A",18,0) XPAND ; eXPAND option into subtree, if it is a menu "RTN","XQ83A",19,0) F L=0:0 S L=$O(^DIC(19,XQNEW,10,L)) Q:L'>0 S T=+$G(^(L,0)),S1=$P(^(0),U,2),S2=$G(^DIC(19,T,0)) S:$P(S2,U,3)'="" $P(S2,U,6)=" OOO " I XQC2'[(","_T_",")&(XQOLD'[(","_T_",")) D X1 "RTN","XQ83A",20,0) K S1,S2 "RTN","XQ83A",21,0) Q "RTN","XQ83A",22,0) ; "RTN","XQ83A",23,0) CLEAN(XQNEW,L) ;clean broken pointers if found on the sub menu with IEN=XQNEW - P ;494 "RTN","XQ83A",24,0) N DA,DIK "RTN","XQ83A",25,0) S DA(1)=XQNEW,DA=L,DIK="^DIC(19,"_DA(1)_","_10_"," "RTN","XQ83A",26,0) D ^DIK "RTN","XQ83A",27,0) Q "RTN","XQ83A",28,0) ; "RTN","XQ83A",29,0) X1 ; "RTN","XQ83A",30,0) S ^TMP($J,"NEW",N,S)=XQOLD_T_"," S:$G(S1)'="" ^(S,"S")=S1 S S=S+1 Q:$D(^TMP($J,"S2",T)) S ^(T)=S2 S:$D(^DIC(19,T,"U")) ^TMP($J,"S2",T,"U")=^("U") "RTN","XQ83A",31,0) S XQP="" I $D(^DIC(19,T,3.91)) F IJ=0:0 S IJ=$O(^DIC(19,T,3.91,IJ)) Q:IJ'>0 I ($D(^(IJ,0))#2),$P(^(0),U,1)'="" S XQP=$S(XQP="":"",1:XQP_",")_$P(^(0),U,1)_$P(^(0),U,2) "RTN","XQ83A",32,0) I XQP'="" S $P(^TMP($J,"S2",T),U,9)=XQP "RTN","XQ83A",33,0) Q "RTN","XQ83A",34,0) PATHS ; "RTN","XQ83A",35,0) F I=0:0 S I=$O(^TMP($J,"NEW",I)) Q:I'>0 F J=0:0 S J=$O(^TMP($J,"NEW",I,J)) Q:J'>0 S PATH=^(J),SYN=$S($D(^(J,"S")):^("S"),1:"") D PATH1 "RTN","XQ83A",36,0) Q "RTN","XQ83A",37,0) PATH1 ; "RTN","XQ83A",38,0) S T=$P(PATH,",",I),NPATH=$P(PATH,",",1,I-1)_",",BASE=$S(NPATH'=",":^TMP($J,"PATH",NPATH),1:"") "RTN","XQ83A",39,0) S XQK=$P(BASE,U,7),XQE=$P(BASE,U,11),XQP=$P(BASE,U,10),XQF=$P(BASE,U,17) "RTN","XQ83A",40,0) S NEW=^TMP($J,"S2",T),XQUC=$S($D(^(T,"U")):^("U"),1:"") "RTN","XQ83A",41,0) S XQK1=$P(NEW,U,6),XQE1=$P(NEW,U,10),XQP1=$P(NEW,U,9),XQF1="" I $P(NEW,U,16),$D(^DIC(19,T,3)) S XQF1=$P(^(3),U) "RTN","XQ83A",42,0) S XQK=$S(XQK'=""&(XQK1'=""):XQK_","_XQK1,1:XQK_XQK1),XQE=$S(XQE'=""&(XQE1'=""):XQE_","_XQE1,1:XQE_XQE1),XQP=$S(XQP'=""&(XQP1'=""):XQP_","_XQP,1:XQP_XQP1),XQF=$S(XQF'=""&(XQF1'=""):XQF_","_XQF1,1:XQF_XQF1) "RTN","XQ83A",43,0) S ^TMP($J,"PATH",PATH)=U_$P(NEW,U,1,2)_U_$S($P(NEW,U,3)]"":1,1:"")_U_$P(NEW,U,4)_U_PATH_U_XQK_U_$P(NEW,U,7,8)_U_XQP_U_XQE_U_$P(NEW,U,11,15)_U_XQF_U_$P(NEW,U,17,99),^(PATH,"U")=XQUC,^("SYN")=SYN "RTN","XQ83A",44,0) Q "RTN","XQ83A",45,0) ; "RTN","XQ83A",46,0) ADD ; "RTN","XQ83A",47,0) Q:'$D(^DIC(19,"AXP",A,U,XQOPM)) G:$D(^TMP($J,"OLD",XQOPM)) DOIT S ^TMP($J,"OLD",XQOPM,1)=^DIC(19,"AXP",A,U,XQOPM) "RTN","XQ83A",48,0) S N=0 F J=2:1 S N=$O(^DIC(19,"AXP",A,U,XQOPM,0,N)) Q:N'>0 S P=^(N),$P(L,U,7)=$P(P,U,2),$P(L,U,10,11)=$P(P,U,3,4),$P(L,U,5)=$P(P,U),P=$P(^(N),U),^TMP($J,"OLD",XQOPM,J)=L F K=1:1:J-1 I $P(^TMP($J,"OLD",XQOPM,K),U,9)=P K ^(J) S J=J-1 Q "RTN","XQ83A",49,0) DOIT K ^TMP($J,"PATH",(XQOPI_","),"SYN") S XQ83AJ=$O(^DIC(19,XQOPM,10,"B",XQOPI,0)) Q:XQ83AJ'>0 S XQ83AJ=$P(^DIC(19,XQOPM,10,XQ83AJ,0),U,2) I XQ83AJ'="" S ^TMP($J,"PATH",(XQOPI_","),"SYN")=XQ83AJ "RTN","XQ83A",50,0) F XQ83AJ=0:0 S XQ83AJ=$O(^TMP($J,"OLD",XQOPM,XQ83AJ)) Q:XQ83AJ'>0 S T=^(XQ83AJ) D ADD1 "RTN","XQ83A",51,0) Q "RTN","XQ83A",52,0) ; "RTN","XQ83A",53,0) ADD1 ; "RTN","XQ83A",54,0) S XQA=$P(T,U,6),XQK=$P(T,U,7),XQP=$P(T,U,10),XQE=$P(T,U,11),XQF=$P(T,U,17) "RTN","XQ83A",55,0) S PATH="" F K=0:0 S PATH=$O(^TMP($J,"PATH",PATH)) Q:PATH="" S BASE=^(PATH),XQUC=^(PATH,"U"),SYN=$S($D(^("SYN")):^("SYN"),1:"") D ADD2 "RTN","XQ83A",56,0) Q "RTN","XQ83A",57,0) ; "RTN","XQ83A",58,0) ADD2 ; "RTN","XQ83A",59,0) S XQK1=$P(BASE,U,7),XQP1=$P(BASE,U,10),XQE1=$P(BASE,U,11),XQF1=$P(BASE,U,17) S XQK1=$S(XQK'=""&(XQK1'=""):XQK_","_XQK1,1:XQK_XQK1),XQP1=$S(XQP'=""&(XQP1'=""):XQP_","_XQP1,1:XQP_XQP1),XQE1=$S(XQE'=""&(XQE1'=""):XQE_","_XQE1,1:XQE_XQE1) "RTN","XQ83A",60,0) S XQF1=$S(XQF'=""&(XQF1'=""):XQF_","_XQF1,1:XQF_XQF1) "RTN","XQ83A",61,0) S XQFLG=0,N=$L(PATH,","),T=$P(PATH,",",N-1) "RTN","XQ83A",62,0) I $S('$D(^DIC(19,"AXP",A,U,T)):1,$P(^(T),U,6)=(XQA_PATH):1,1:0) S ^(T)=$P(BASE,U,1,5)_U_XQA_PATH_U_XQK1_U_$P(BASE,U,8,9)_U_XQP1_U_XQE1_U_$P(BASE,U,12,16)_U_XQF1_U_$P(BASE,U,18,99),XQFLG=1 "RTN","XQ83A",63,0) I 'XQFLG S BASE1=XQA_PATH_U_XQK1_U_XQP1_U_XQE1_U_XQF1 F N=0:0 S N=$O(^DIC(19,"AXP",A,U,T,0,N)) Q:N'>0 S L=N I $P(^(N),U)=(XQA_PATH) S ^(N)=BASE1,XQFLG=1 Q "RTN","XQ83A",64,0) I 'XQFLG F N=1:1 I '$D(^DIC(19,"AXP",A,U,T,0,N)) S ^(N)=BASE1,^(0)=$S('($D(^DIC(19,"AXP",A,U,T,0))#2):0,1:^(0))+1 Q "RTN","XQ83A",65,0) S XQSYNY=$E($S(XQUC'="":XQUC,1:$P(BASE,U,3)),1,27),V=T_U_"1" D SYN3^XQ83R "RTN","XQ83A",66,0) I SYN'="" S XQSYNY=SYN,V=T_U_"0" D SYN3^XQ83R "RTN","XQ83A",67,0) K V "RTN","XQ83A",68,0) Q "VER") 8.0^22.0 "BLD",1264,6) ^449 **END** **END**