Released XU*8*569 SEQ #459 Extracted from mail message **KIDS**:XU*8.0*569^ **INSTALL NAME** XU*8.0*569 "BLD",1540,0) XU*8.0*569^KERNEL^0^3110509^y "BLD",1540,1,0) ^^2^2^3110509^ "BLD",1540,1,1,0) Please see the National Patch Module for the patch description. "BLD",1540,1,2,0) "BLD",1540,4,0) ^9.64PA^^ "BLD",1540,6.3) 1 "BLD",1540,"ABPKG") n "BLD",1540,"INID") ^n "BLD",1540,"INIT") REBUILD^XUP569 "BLD",1540,"KRN",0) ^9.67PA^9002226^21 "BLD",1540,"KRN",.4,0) .4 "BLD",1540,"KRN",.401,0) .401 "BLD",1540,"KRN",.402,0) .402 "BLD",1540,"KRN",.403,0) .403 "BLD",1540,"KRN",.5,0) .5 "BLD",1540,"KRN",.84,0) .84 "BLD",1540,"KRN",3.6,0) 3.6 "BLD",1540,"KRN",3.8,0) 3.8 "BLD",1540,"KRN",9.2,0) 9.2 "BLD",1540,"KRN",9.8,0) 9.8 "BLD",1540,"KRN",9.8,"NM",0) ^9.68A^3^3 "BLD",1540,"KRN",9.8,"NM",1,0) XQSET^^0^B21199509 "BLD",1540,"KRN",9.8,"NM",2,0) XQCS^^0^B35440882 "BLD",1540,"KRN",9.8,"NM",3,0) XUP569^^0^B182199 "BLD",1540,"KRN",9.8,"NM","B","XQCS",2) "BLD",1540,"KRN",9.8,"NM","B","XQSET",1) "BLD",1540,"KRN",9.8,"NM","B","XUP569",3) "BLD",1540,"KRN",19,0) 19 "BLD",1540,"KRN",19.1,0) 19.1 "BLD",1540,"KRN",101,0) 101 "BLD",1540,"KRN",409.61,0) 409.61 "BLD",1540,"KRN",771,0) 771 "BLD",1540,"KRN",779.2,0) 779.2 "BLD",1540,"KRN",870,0) 870 "BLD",1540,"KRN",8989.51,0) 8989.51 "BLD",1540,"KRN",8989.52,0) 8989.52 "BLD",1540,"KRN",8994,0) 8994 "BLD",1540,"KRN",9002226,0) 9002226 "BLD",1540,"KRN","B",.4,.4) "BLD",1540,"KRN","B",.401,.401) "BLD",1540,"KRN","B",.402,.402) "BLD",1540,"KRN","B",.403,.403) "BLD",1540,"KRN","B",.5,.5) "BLD",1540,"KRN","B",.84,.84) "BLD",1540,"KRN","B",3.6,3.6) "BLD",1540,"KRN","B",3.8,3.8) "BLD",1540,"KRN","B",9.2,9.2) "BLD",1540,"KRN","B",9.8,9.8) "BLD",1540,"KRN","B",19,19) "BLD",1540,"KRN","B",19.1,19.1) "BLD",1540,"KRN","B",101,101) "BLD",1540,"KRN","B",409.61,409.61) "BLD",1540,"KRN","B",771,771) "BLD",1540,"KRN","B",779.2,779.2) "BLD",1540,"KRN","B",870,870) "BLD",1540,"KRN","B",8989.51,8989.51) "BLD",1540,"KRN","B",8989.52,8989.52) "BLD",1540,"KRN","B",8994,8994) "BLD",1540,"KRN","B",9002226,9002226) "BLD",1540,"QDEF") ^^^^NO^^^^NO^^NO "BLD",1540,"QUES",0) ^9.62^^ "BLD",1540,"REQB",0) ^9.611^2^2 "BLD",1540,"REQB",1,0) XU*8.0*253^2 "BLD",1540,"REQB",2,0) XU*8.0*155^2 "BLD",1540,"REQB","B","XU*8.0*155",2) "BLD",1540,"REQB","B","XU*8.0*253",1) "INIT") REBUILD^XUP569 "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^1^1 "PKG",3,20,1,0) 200^^XDRM200N "PKG",3,20,1,1) "PKG",3,20,"B",200,1) "PKG",3,22,0) ^9.49I^1^1 "PKG",3,22,1,0) 8.0^3080616^3080616^6 "PKG",3,22,1,"PAH",1,0) 569^3110509 "PKG",3,22,1,"PAH",1,1,0) ^^2^2^3110509 "PKG",3,22,1,"PAH",1,1,1,0) Please see the National Patch Module for the patch description. "PKG",3,22,1,"PAH",1,1,2,0) "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") 3 "RTN","XQCS") 0^2^B35440882^B34794389 "RTN","XQCS",1,0) XQCS ;SEA/Luke - Client/Server Utilities ;05/09/2011 "RTN","XQCS",2,0) ;;8.0;KERNEL;**15,28,82,116,115,177,188,157,253,569**;Jul 10, 1995;Build 1 "RTN","XQCS",3,0) ; "RTN","XQCS",4,0) CHK(XQUSR,XQOPT,XQRPC) ;Check to see if this user can run this RPC from "RTN","XQCS",5,0) ;this option. Called by XWBSEC and XUSRB. "RTN","XQCS",6,0) ; "RTN","XQCS",7,0) ;Input: XQUSR-DUZ of user "RTN","XQCS",8,0) ; XQOPT - name or IEN of the option "RTN","XQCS",9,0) ; XQRPC - name or IEN of the remote procedure. If this "RTN","XQCS",10,0) ; variable is null no check is made to see if a "RTN","XQCS",11,0) ; procedure is allowed. That is, we only look "RTN","XQCS",12,0) ; to see if the option is there and if the user "RTN","XQCS",13,0) ; has been assigned access to it. "RTN","XQCS",14,0) ; "RTN","XQCS",15,0) ;Output: XQMES - returned as 1 if the user is allowed to use this "RTN","XQCS",16,0) ; option (and RPC is valid if XQRPC input variable is not "RTN","XQCS",17,0) ; null), or as a message string explaining why the option "RTN","XQCS",18,0) ; or RPC is not allowed. "RTN","XQCS",19,0) ; "RTN","XQCS",20,0) ;Rules: If M code exsists in ^DIC(19,option#,"RPC",rpc#,1) the "RTN","XQCS",21,0) ; RULES field for a corresponding RPC, the software sets "RTN","XQCS",22,0) ; the flag XQRPCOK to 1 and executes the field's code. "RTN","XQCS",23,0) ; If the flag is returned as less than 1, the request for "RTN","XQCS",24,0) ; use of that RPC is denied. Rules are written by the "RTN","XQCS",25,0) ; package developer and are not required. "RTN","XQCS",26,0) ; "RTN","XQCS",27,0) ; "RTN","XQCS",28,0) N %,X,XQCY0,XQDIC,XQKEY,XQRPCOK,XQPM,XQSM,XQSMY,XQYSAV "RTN","XQCS",29,0) ; "RTN","XQCS",30,0) S XQMES=1 "RTN","XQCS",31,0) D OPT I 'XQMES Q XQMES "RTN","XQCS",32,0) I ($G(XQY0)'="XUS SIGNON")&(XQUSR>0) D USER I 'XQMES Q XQMES "RTN","XQCS",33,0) S %=$G(XQRPC) I %]"" S XQRPC=% D RPC I 'XQMES Q XQMES "RTN","XQCS",34,0) Q XQMES "RTN","XQCS",35,0) ; "RTN","XQCS",36,0) ; "RTN","XQCS",37,0) OPT ;See if the option is there and is a broker type option "RTN","XQCS",38,0) I XQOPT'=+XQOPT S XQOPT=$O(^DIC(19,"B",XQOPT,0)) "RTN","XQCS",39,0) I XQOPT'>0 S XQMES="No such option in the ""B"" cross reference of the Option File." Q "RTN","XQCS",40,0) I $G(MODE)="CHECK" D OPT1 Q "RTN","XQCS",41,0) I '$D(^TMP("XQCS",$J)) S XQOPT=$$OPTLK($P(^DIC(19,XQOPT,0),U)) "RTN","XQCS",42,0) Q "RTN","XQCS",43,0) OPT1 ; "RTN","XQCS",44,0) I XQOPT'=+XQOPT S XQOPT=$O(^DIC(19,"B",XQOPT,0)) I XQOPT'>0 S XQMES="No such option in the ""B"" cross reference of the Option File." Q "RTN","XQCS",45,0) I '$D(^DIC(19,XQOPT,0)) S XQMES="No such option in the Option File." Q "RTN","XQCS",46,0) ;I $P(^DIC(19,XQOPT,0),U,4)'="B" S XQMES="This option is not a Client/Server-type option." Q "RTN","XQCS",47,0) ; "RTN","XQCS",48,0) ;Check for Out-Of-Order, etc. Patch XU*8*38 7/16/96 "RTN","XQCS",49,0) ; "RTN","XQCS",50,0) S XQCY0=^DIC(19,XQOPT,0) ;W XQCY0 "RTN","XQCS",51,0) I $L($P(XQCY0,U,3)) S XQMES="Option out of order with message: "_$P(XQCY0,U,3)_"." Q "RTN","XQCS",52,0) I $L($P(XQCY0,U,6)) S %=$P(XQCY0,U,6) I '$D(^XUSEC(%,DUZ)) S XQMES="Option locked, "_$P(^VA(200,DUZ,0),U)_" does not hold the key." Q "RTN","XQCS",53,0) I $L($P(XQCY0,U,16)) I $D(^DIC(19,XQOPT,3)),^(3)]"" S %=^(3) I $D(^XUSEC(%,DUZ)) S XQMES="Reverse lock, "_$P(^VA(200,DUZ,0),U)_" holds the key." Q "RTN","XQCS",54,0) I $L($P(XQCY0,U,9)) S XQZ=$P(XQCY0,U,9) D ^XQDATE S (XX,X)=% D XQO^XQ92 I X=""!(XX'=X) S XQMES="This option is time restricted." Q "RTN","XQCS",55,0) I $D(^DIC(19,+XQOPT,3.91)),$P(^(3.91,0),U,4)>1 S:$D(XQY) XQYSAV=XQY D ^XQDATE S X=%,XQY=+XQOPT D ^XQ92 S:$D(XQYSAV) XQY=XQYSAV I X="" S XQMES="This option is time restricted." Q "RTN","XQCS",56,0) ;End patch 38 "RTN","XQCS",57,0) Q "RTN","XQCS",58,0) ; "RTN","XQCS",59,0) OPTLK(V) ;Lookup a Option in the file, Return it's IEN "RTN","XQCS",60,0) N XQOPT S XQOPT=$O(^DIC(19,"B",V,0)) I XQOPT'>0 Q "" "RTN","XQCS",61,0) I '$D(XQMES) N XQMES S XQMES=1 "RTN","XQCS",62,0) N XQCS,XQCSO S XQCS(XQOPT)="" N XQOPT K ^TMP("XQCS",$J) "RTN","XQCS",63,0) F S XQOPT=$O(XQCS("")) Q:XQOPT="" K XQCS(XQOPT) I '$D(XQCSO(XQOPT)) D OPT1 D:XQMES I 'XQMES Q "RTN","XQCS",64,0) . N I,J F I=0:0 S I=$O(^DIC(19,XQOPT,"RPC",I)) Q:I'>0 K J S J=^(I,0) S:$D(^(1)) J(1)=^(1) I '$D(^TMP("XQCS",$J,+J)) S ^TMP("XQCS",$J,+J,0)=J I $D(J(1)) S ^(1)=J(1) "RTN","XQCS",65,0) . F I=0:0 S I=$O(^DIC(19,XQOPT,10,I)) Q:I'>0 S J=+^(I,0) I $P(^DIC(19,J,0),U,4)="B" S XQCS(J)="" "RTN","XQCS",66,0) . S XQCSO(XQOPT)="" "RTN","XQCS",67,0) . Q "RTN","XQCS",68,0) Q $O(^DIC(19,"B",V,0)) "RTN","XQCS",69,0) ; "RTN","XQCS",70,0) RPC ;See if rpc exsists, is registered, is locked, etc. "RTN","XQCS",71,0) ; I '$D(^DIC(19,XQOPT,"RPC",0)) S XQMES="No RPC subfile defined for the option "_$P(^DIC(19,XQOPT,0),U)_"." Q "RTN","XQCS",72,0) ; I $P(^DIC(19,XQOPT,"RPC",0),U,4)<1 S XQMES="No remote procedure calls registered for the option "_$P(^DIC(19,XQOPT,0),U)_"." Q "RTN","XQCS",73,0) I XQRPC'=+XQRPC S XQRPC=$O(^XWB(8994,"B",XQRPC,0)) I XQRPC'>0 S XQMES="No RPC by that name in the ""B"" cross-reference of the Remote Procedure File." Q "RTN","XQCS",74,0) I '$D(^XWB(8994,XQRPC,0)) S XQMES="No such procedure in the Remote Procedure File." Q "RTN","XQCS",75,0) ; I '$D(^DIC(19,XQOPT,"RPC","B",XQRPC)) S XQMES="The remote procedure "_$P(^XWB(8994,XQRPC,0),U)_" is not registered to the option "_$P(^DIC(19,XQOPT,0),U)_"." Q "RTN","XQCS",76,0) I '$D(^TMP("XQCS",$J,XQRPC)) S XQMES="The remote procedure "_$P(^XWB(8994,XQRPC,0),U)_" is not registered to the option "_$P(^DIC(19,XQOPT,0),U)_"." Q "RTN","XQCS",77,0) ; S %=$O(^DIC(19,XQOPT,"RPC","B",XQRPC,0)),XQKEY=$P(^DIC(19,XQOPT,"RPC",%,0),U,2) "RTN","XQCS",78,0) S XQKEY=$P(^TMP("XQCS",$J,XQRPC,0),U,2) "RTN","XQCS",79,0) I $L(XQKEY) I '$D(^XUSEC(XQKEY,XQUSR)) S XQMES="Remote procedure is locked." Q "RTN","XQCS",80,0) ; "RTN","XQCS",81,0) RULES ;Check the rules for this RPC "RTN","XQCS",82,0) ;S %=$O(^DIC(19,XQOPT,"RPC","B",XQRPC,0)) "RTN","XQCS",83,0) ;I $D(^DIC(19,XQOPT,"RPC",%,1)),$L(^(1)) D "RTN","XQCS",84,0) I $D(^TMP("XQCS",$J,XQRPC,1)),$L(^(1)) D "RTN","XQCS",85,0) . S XQRPCOK=1 "RTN","XQCS",86,0) . X ^TMP("XQCS",$J,XQRPC,1) "RTN","XQCS",87,0) . I XQRPCOK<1 S XQMES="Remote procedure request failed rules test." "RTN","XQCS",88,0) . Q "RTN","XQCS",89,0) Q "RTN","XQCS",90,0) ; "RTN","XQCS",91,0) ; "RTN","XQCS",92,0) ; "RTN","XQCS",93,0) USER ;See if XQUSR has been assigned access this option or not "RTN","XQCS",94,0) ; "RTN","XQCS",95,0) N XQYES "RTN","XQCS",96,0) S XQMES=1,(XQSMY,%,XQYES)=0 "RTN","XQCS",97,0) ; "RTN","XQCS",98,0) TOP ;See if XQOPT is on top level of a tree: primary, secondary, or common "RTN","XQCS",99,0) S XQPM=+$G(^VA(200,XQUSR,201)) I XQOPT=XQPM Q "RTN","XQCS",100,0) ; "RTN","XQCS",101,0) ;Check the Common Options (XUCOMMAND) "RTN","XQCS",102,0) I $D(^DIC(19,"B","XUCOMMAND")) D "RTN","XQCS",103,0) . N XQCOM "RTN","XQCS",104,0) . S XQCOM=$O(^DIC(19,"B","XUCOMMAND",0)) "RTN","XQCS",105,0) . I $D(^DIC(19,XQCOM,10,"B",XQOPT)) S XQYES=1 "RTN","XQCS",106,0) . I XQYES Q "RTN","XQCS",107,0) . I '$D(^XUTL("XQO","PXU",0)) S %=$$BUILD("PXU") "RTN","XQCS",108,0) . I $D(^XUTL("XQO","PXU","^",XQOPT)) S XQYES=1 "RTN","XQCS",109,0) . Q "RTN","XQCS",110,0) I XQYES Q "RTN","XQCS",111,0) ; "RTN","XQCS",112,0) ; "RTN","XQCS",113,0) I $D(^VA(200,XQUSR,203,0)),$P(^(0),U,4)>0 S XQSMY=1 D "RTN","XQCS",114,0) .;** P569 START CJM "RTN","XQCS",115,0) .N DUZ S DUZ=XQUSR "RTN","XQCS",116,0) .;** P569 END CJM "RTN","XQCS",117,0) . S XQDIC="U"_XQUSR I $S('$D(^XUTL("XQO",XQDIC,0)):1,'$D(^VA(200,XQUSR,203.1)):1,1:^VA(200,XQUSR,203.1)'=$P(^XUTL("XQO",XQDIC,0),U,2)) D ^XQSET "RTN","XQCS",118,0) . S (XQSM,%)=0 "RTN","XQCS",119,0) . F Q:% S XQSM=$O(^XUTL("XQO",XQDIC,"^",XQSM)) Q:XQSM="" I XQSM=XQOPT S XQYES=1 Q "RTN","XQCS",120,0) . Q "RTN","XQCS",121,0) I XQYES Q "RTN","XQCS",122,0) ; "RTN","XQCS",123,0) DEEP ;See if it's under the top somewhere - start with primary tree "RTN","XQCS",124,0) I XQPM>0 D "RTN","XQCS",125,0) .S XQDIC="P"_XQPM "RTN","XQCS",126,0) .S XQYES=$S($D(^XUTL("XQO",XQDIC,"^",XQOPT)):1,$D(^DIC(19,"AXQ",XQDIC,"^",XQOPT)):1,1:0) "RTN","XQCS",127,0) .Q "RTN","XQCS",128,0) I XQYES Q "RTN","XQCS",129,0) ; "RTN","XQCS",130,0) ;Check secondary trees "RTN","XQCS",131,0) S (XQSM,%)=0 "RTN","XQCS",132,0) I XQSMY F Q:XQYES S XQSM=$O(^XUTL("XQO","U"_XQUSR,"^",XQSM)) Q:XQSM="" D "RTN","XQCS",133,0) .S XQDIC="P"_XQSM "RTN","XQCS",134,0) .S XQYES=$S($D(^XUTL("XQO",XQDIC,"^",XQOPT)):1,$D(^DIC(19,"AXQ",XQDIC,"^",XQOPT)):1,1:0) "RTN","XQCS",135,0) . Q "RTN","XQCS",136,0) I XQYES Q "RTN","XQCS",137,0) ; "RTN","XQCS",138,0) I $L(XQMES<5) S XQMES="User "_$P(^VA(200,XQUSR,0),U)_" does not have access to option "_$P(^DIC(19,XQOPT,0),U) "RTN","XQCS",139,0) Q "RTN","XQCS",140,0) ; "RTN","XQCS",141,0) ;End of main program "RTN","XQCS",142,0) ; "RTN","XQCS",143,0) BUILD(XQDIC) ;A missing ^XUTL node brings us here "RTN","XQCS",144,0) I $D(^DIC(19,"AXQ",XQDIC)) D "RTN","XQCS",145,0) .L +^DIC(19,"AXQ",XQDIC):5 "RTN","XQCS",146,0) .I '$D(^XUTL("XQO",XQDIC)) M ^XUTL("XQO",XQDIC)=^DIC(19,"AXQ",XQDIC) "RTN","XQCS",147,0) .L -^DIC(19,"AXQ",XQDIC) "RTN","XQCS",148,0) .Q "RTN","XQCS",149,0) I $D(^XUTL("XQO",XQDIC,0)) Q 1 "RTN","XQCS",150,0) ; "RTN","XQCS",151,0) ;If they are not even in ^DIC the make them from scratch "RTN","XQCS",152,0) I '$D(^DIC(19,"AXQ",XQDIC)) D "RTN","XQCS",153,0) .;D REACT^XQ84(DUZ) "RTN","XQCS",154,0) .S XQMES="Your menus are being rebuilt. Please try again later." "RTN","XQCS",155,0) Q 0 "RTN","XQSET") 0^1^B21199509^B17368151 "RTN","XQSET",1,0) XQSET ;MJM/SEA - Rebuild display/user XUTL("XQO") ;05/09/2011 "RTN","XQSET",2,0) ;;8.0;KERNEL;**28,82,155,569**;Jul 10, 1995;Build 1 "RTN","XQSET",3,0) SET ;Rebuild the +XQDIC and "U"_DUZ nodes "RTN","XQSET",4,0) ; "RTN","XQSET",5,0) ;** P569 START CJM "RTN","XQSET",6,0) I XQDIC["U",$P(XQDIC,"U",2)'=DUZ D Q "RTN","XQSET",7,0) .D "RTN","XQSET",8,0) ..N DUZ "RTN","XQSET",9,0) ..S DUZ=$P(XQDIC,"U",2) "RTN","XQSET",10,0) ..D NEWSET "RTN","XQSET",11,0) .D "RTN","XQSET",12,0) ..N XQDIC "RTN","XQSET",13,0) ..S XQDIC="U"_DUZ "RTN","XQSET",14,0) ..D NEWSET "RTN","XQSET",15,0) D NEWSET "RTN","XQSET",16,0) Q "RTN","XQSET",17,0) ; "RTN","XQSET",18,0) NEWSET ; "RTN","XQSET",19,0) ; "RTN","XQSET",20,0) ; ** P569 END CJM "RTN","XQSET",21,0) ; "RTN","XQSET",22,0) K ^XUTL("XQO",XQDIC) "RTN","XQSET",23,0) I XQDIC=+XQDIC,'$D(^DIC(19,XQDIC,0)) Q "RTN","XQSET",24,0) F XQSI=0:0 S XQSI=$S(+XQDIC:$O(^DIC(19,XQDIC,10,XQSI)),1:$O(^VA(200,DUZ,203,XQSI))) Q:XQSI'>0 I $D(^(XQSI,0)) S XQSY=^(0) D SET1 "RTN","XQSET",25,0) S XQSK=250,XQSD="",XQSM=1,XQSY=0,XQNO=0 "RTN","XQSET",26,0) F XQSI=0:0 S XQSY=$O(XQST(XQSY)) Q:XQSY=""!($E(XQSY,1,4)="ZZZZ") D "RTN","XQSET",27,0) .S XQS0=+XQST(XQSY) "RTN","XQSET",28,0) .D DIS "RTN","XQSET",29,0) .S:(XQSK<$L(XQS0)) ^XUTL("XQO",XQDIC,0,XQSM)=XQSD,XQSD="",XQSK=250,XQSM=XQSM+1 "RTN","XQSET",30,0) .I XQNO S XQNO=0 Q "RTN","XQSET",31,0) .S XQSD=XQSD_XQS0,XQSK=XQSK-$L(XQS0) "RTN","XQSET",32,0) .Q "RTN","XQSET",33,0) I XQDIC=+XQDIC,$D(^DIC(19,XQDIC,0))#2 S:'$D(^DIC(19,XQDIC,99)) ^DIC(19,XQDIC,99)=$H S %H=^DIC(19,XQDIC,99) "RTN","XQSET",34,0) I XQDIC'=+XQDIC S:'$D(^VA(200,DUZ,203.1)) ^VA(200,DUZ,203.1)=$H S %H=^VA(200,DUZ,203.1) "RTN","XQSET",35,0) S ^XUTL("XQO",XQDIC,0,XQSM)=XQSD,^XUTL("XQO",XQDIC,0)=XQSM_U_%H "RTN","XQSET",36,0) S XQSY=0 F XQSI=0:0 S XQSY=$O(XQST(XQSY)) Q:XQSY="" S %=XQST(XQSY),XQSK=$E(XQSY,5,99) D:$E(XQSK,1)=" " XBLK S:$L(XQSK) ^XUTL("XQO",XQDIC,XQSK)=% "RTN","XQSET",37,0) K %,%H,X,XQNO,XQSA,XQSB,XQSD,XQSDO,XQSI,XQSL,XQSK,XQS0,XQSOO,XQSPR,XQSN,XQST,XQSM,XQSX,XQSZ,XQSY "RTN","XQSET",38,0) Q "RTN","XQSET",39,0) ; "RTN","XQSET",40,0) SET1 Q:'$D(^DIC(19,+XQSY,0)) S XQS0=^(0),X=$S($D(^("U")):^("U"),1:"") I X="" S X=$E($P(XQS0,U,2),1,30) D UP S ^("U")=X "RTN","XQSET",41,0) S XQSOO=$P(XQS0,U,3),XQS0=$P(XQS0,U,1,2)_U_($S($P(XQS0,U,3)]"":1,1:""))_U_$P(XQS0,U,4,99) "RTN","XQSET",42,0) S (XQSX,XQSZ)="",%=$P(XQS0,U,9) I %]"",$L(%)>2 S XQSX=%_"MO-FR",XQSZ="MO-FR "_% "RTN","XQSET",43,0) I $D(^DIC(19,+XQSY,3.91)) F XQSL=0:0 S XQSL=$O(^DIC(19,+XQSY,3.91,XQSL)) Q:XQSL'>0 I ^(XQSL,0)]"" S XQSX=$S(XQSX'="":XQSX_";",1:"")_$P(^(0),U,1)_$P(^(0),U,2),XQSZ=$S(XQSZ'="":XQSZ_"; ",1:"")_$P(^(0),U,2)_" "_$P(^(0),U,1) "RTN","XQSET",44,0) I XQSX]"" S $P(XQS0,U,9)=XQSX "RTN","XQSET",45,0) S XQSX="" I $P(XQS0,U,16),$D(^DIC(19,+XQSY,3)) S XQSX=$P(^(3),U) I XQSX'="" S $P(XQS0,U,16)=XQSX "RTN","XQSET",46,0) S XQSN=$P(XQSY,U,2),XQSDO=$P(XQSY,U,3),^XUTL("XQO",XQDIC,"^",+XQSY)=XQSN_U_$P(XQS0,U,1,4)_"^^"_$P(XQS0,U,6,99) "RTN","XQSET",47,0) I $L(X) S:X?.N X=" "_X S X=$S($L(XQSN):"ZZZZ",$L(XQSDO):$E(0,1,($L(XQSDO*100)=3))_(XQSDO*100),1:"BBBB")_X D:$D(XQST(X)) SET3 S XQST(X)=+XQSY_"^1" "RTN","XQSET",48,0) I $L(XQSN) S X=XQSN D UP Q:'$L(X) S:X?.N X=$E(" ",1,5-$L(X))_X S X=$S($L(XQSDO):$E(0,1,($L(XQSDO*100)=3))_(XQSDO*100),1:"AAAA")_X D:$D(XQST(X)) SET3 S XQST(X)=+XQSY_"^0" "RTN","XQSET",49,0) S:XQSOO]"" XQST(X,"OO")=XQSOO "RTN","XQSET",50,0) S:XQSZ]"" XQST(X,"TM")=XQSZ "RTN","XQSET",51,0) Q "RTN","XQSET",52,0) SET3 S XQSD=X F I=0:0 S XQSM=$O(XQST(XQSD)) Q:($P(XQSM,U,1)'=X) S XQSD=XQSM "RTN","XQSET",53,0) S I=+$P(XQSD,U,2) S X=X_U_(I+1) Q "RTN","XQSET",54,0) CK ; "RTN","XQSET",55,0) S %=$P(^DIC(19,D0,0),U,6),%Y=$P(^DIC(19,D0,0),U,1) I $S($L(%):$D(^XUSEC(%,DUZ)),1:1) "RTN","XQSET",56,0) Q:'$T "RTN","XQSET",57,0) I DUZ(0)="@"!$D(^XUSEC("XUMGR",DUZ))!$D(^VA(200,DUZ,19.5,Y,0)) "RTN","XQSET",58,0) Q:'$T "RTN","XQSET",59,0) CK1 S %=$P(^DIC(19,D0,0),U,4),%Y=$P(^DIC(19,Y,0),U,4) I $S((%'="O"&(%'="Q"))&(%Y'="Q"):1,(%="O"&(%Y="O")):1,(%="Q"&((%Y="O")!(%Y="Q"))):1,1:0) "RTN","XQSET",60,0) Q "RTN","XQSET",61,0) DEV ;See if device is legit for this option "RTN","XQSET",62,0) S (%,XQSJ)=0 Q:'$D(^DIC(19,+XQSW,3.96,0)) "RTN","XQSET",63,0) F XQSL=1:1 S %=$O(^DIC(19,+XQSW,3.96,%)) Q:%=""!(%'=+%) S:XQSIO=^(%,0) XQSJ=1 "RTN","XQSET",64,0) Q "RTN","XQSET",65,0) UP S X=$$UP^XLFSTR(X) ;F XQSA=1:1 Q:X?.NUP S %=$A(X,XQSA) I %<123,%>96 S X=$E(X,1,XQSA-1)_$C(%-32)_$E(X,XQSA+1,255) "RTN","XQSET",66,0) Q "RTN","XQSET",67,0) XBLK F XASB=0:0 S XQSW=$E(XQSK,1) Q:XQSW'=" " S XQSK=$E(XQSK,2,99) "RTN","XQSET",68,0) Q "RTN","XQSET",69,0) DIS ;Create display nodes "RTN","XQSET",70,0) S %=$S($D(^XUTL("XQO",XQDIC,"^",XQS0)):^(XQS0),1:"") S:$L(%) XQS0=% I '$L(%) S %=$O(^DIC(19,XQDIC,10,"B",XQS0,%)),%=$P(^DIC(19,XQDIC,10,%,0),U,2),XQS0=%_U_^DIC(19,XQS0,0) "RTN","XQSET",71,0) I "MO"[$P(XQS0,U,5) S $P(XQS0,U,3)=$P(XQS0,U,3)_" ..." "RTN","XQSET",72,0) I "SB"[$P(XQS0,U,5) S XQNO=1 ;Don't Display servers or broker-type options "RTN","XQSET",73,0) S XQS0=$P(XQS0,U,1,3)_U_$S($D(XQST(XQSY,"OO")):XQST(XQSY,"OO"),1:"")_U_$P(XQS0,U,7)_U_$S($D(XQST(XQSY,"TM")):XQST(XQSY,"TM"),1:"")_U_$P(XQS0,U,11)_U_$P(XQS0,U,17)_U "RTN","XQSET",74,0) Q "RTN","XUP569") 0^3^B182199^n/a "RTN","XUP569",1,0) XUP569 ;ALB/CJM - post-install for XU*8*569 ;05/09/2011 "RTN","XUP569",2,0) ;;8.0;KERNEL;**569**;Jul 10, 1995;Build 1 "RTN","XUP569",3,0) ; "RTN","XUP569",4,0) REBUILD ;rebuild all secondary menus "RTN","XUP569",5,0) N DUZ,XQDIC "RTN","XUP569",6,0) S DUZ=0 "RTN","XUP569",7,0) F S DUZ=$O(^VA(200,DUZ)) Q:'DUZ D "RTN","XUP569",8,0) .S XQDIC="U"_DUZ "RTN","XUP569",9,0) .L +^XUTL("XQO",XQDIC):5 "RTN","XUP569",10,0) .D SET^XQSET "RTN","XUP569",11,0) .L -^XUTL("XQO",XQDIC) "RTN","XUP569",12,0) Q "VER") 8.0^22.0 **END** **END**