Released XU*8*594 SEQ #466 Extracted from mail message **KIDS**:XU*8.0*594^ **INSTALL NAME** XU*8.0*594 "BLD",1407,0) XU*8.0*594^KERNEL^0^3120112^y "BLD",1407,1,0) ^^2^2^3120110^ "BLD",1407,1,1,0) Please refer to the Description in the FORUM Patch Module for details. "BLD",1407,1,2,0) "BLD",1407,4,0) ^9.64PA^^ "BLD",1407,6.3) 6 "BLD",1407,"KRN",0) ^9.67PA^9002226^21 "BLD",1407,"KRN",.4,0) .4 "BLD",1407,"KRN",.401,0) .401 "BLD",1407,"KRN",.402,0) .402 "BLD",1407,"KRN",.403,0) .403 "BLD",1407,"KRN",.5,0) .5 "BLD",1407,"KRN",.84,0) .84 "BLD",1407,"KRN",3.6,0) 3.6 "BLD",1407,"KRN",3.8,0) 3.8 "BLD",1407,"KRN",9.2,0) 9.2 "BLD",1407,"KRN",9.8,0) 9.8 "BLD",1407,"KRN",9.8,"NM",0) ^9.68A^1^1 "BLD",1407,"KRN",9.8,"NM",1,0) XUS1B^^0^B8805326 "BLD",1407,"KRN",9.8,"NM","B","XUS1B",1) "BLD",1407,"KRN",19,0) 19 "BLD",1407,"KRN",19.1,0) 19.1 "BLD",1407,"KRN",101,0) 101 "BLD",1407,"KRN",409.61,0) 409.61 "BLD",1407,"KRN",771,0) 771 "BLD",1407,"KRN",779.2,0) 779.2 "BLD",1407,"KRN",870,0) 870 "BLD",1407,"KRN",8989.51,0) 8989.51 "BLD",1407,"KRN",8989.51,"NM",0) ^9.68A^1^1 "BLD",1407,"KRN",8989.51,"NM",1,0) XU594^^0 "BLD",1407,"KRN",8989.51,"NM","B","XU594",1) "BLD",1407,"KRN",8989.52,0) 8989.52 "BLD",1407,"KRN",8989.52,"NM",0) ^9.68A^^ "BLD",1407,"KRN",8994,0) 8994 "BLD",1407,"KRN",9002226,0) 9002226 "BLD",1407,"KRN","B",.4,.4) "BLD",1407,"KRN","B",.401,.401) "BLD",1407,"KRN","B",.402,.402) "BLD",1407,"KRN","B",.403,.403) "BLD",1407,"KRN","B",.5,.5) "BLD",1407,"KRN","B",.84,.84) "BLD",1407,"KRN","B",3.6,3.6) "BLD",1407,"KRN","B",3.8,3.8) "BLD",1407,"KRN","B",9.2,9.2) "BLD",1407,"KRN","B",9.8,9.8) "BLD",1407,"KRN","B",19,19) "BLD",1407,"KRN","B",19.1,19.1) "BLD",1407,"KRN","B",101,101) "BLD",1407,"KRN","B",409.61,409.61) "BLD",1407,"KRN","B",771,771) "BLD",1407,"KRN","B",779.2,779.2) "BLD",1407,"KRN","B",870,870) "BLD",1407,"KRN","B",8989.51,8989.51) "BLD",1407,"KRN","B",8989.52,8989.52) "BLD",1407,"KRN","B",8994,8994) "BLD",1407,"KRN","B",9002226,9002226) "BLD",1407,"QDEF") ^^^^YES^^^^NO^^NO "BLD",1407,"QUES",0) ^9.62^^ "BLD",1407,"REQB",0) ^9.611^1^1 "BLD",1407,"REQB",1,0) XU*8.0*543^1 "BLD",1407,"REQB","B","XU*8.0*543",1) "KRN",8989.51,275,-1) 0^1 "KRN",8989.51,275,0) XU594^Patch 594 switch^0^^Remove patch 543 fix "KRN",8989.51,275,1) Y^^Remove code fix from patch 543 "KRN",8989.51,275,20,0) ^8989.512^5^5^3120111^^ "KRN",8989.51,275,20,1,0) This parameter will skip the code that patch 543 uses. If patch "KRN",8989.51,275,20,2,0) 543 broke the iMedConsent application, this parameter should be "KRN",8989.51,275,20,3,0) set to YES. The default is NO. "KRN",8989.51,275,20,4,0) "KRN",8989.51,275,20,5,0) "KRN",8989.51,275,30,0) ^8989.513I^1^1 "KRN",8989.51,275,30,1,0) 1^4.2 "MBREQ") 0 "ORD",20,8989.51) 8989.51;20;;;PAR1E1^XPDTA2;PAR1F1^XPDIA3;PAR1E1^XPDIA3;PAR1F2^XPDIA3;;PAR1DEL^XPDIA3(%) "ORD",20,8989.51,0) PARAMETER DEFINITION "PKG",3,-1) 1^1 "PKG",3,0) KERNEL^XU^SIGN-ON, SECURITY, MENU DRIVER, DEVICES, TASKMAN^ "PKG",3,20,0) ^9.402P^2^2 "PKG",3,20,1,0) 200^^XDRM200N "PKG",3,20,1,1) "PKG",3,20,2,0) 2^^RGDRM03 "PKG",3,20,2,1) "PKG",3,20,"B",2,2) "PKG",3,20,"B",200,1) "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) 594^3120112 "PKG",3,22,1,"PAH",1,1,0) ^^2^2^3120112 "PKG",3,22,1,"PAH",1,1,1,0) Please refer to the Description in the FORUM Patch Module for details. "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") YES "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","XUS1B") 0^1^B8805326^B8553582 "RTN","XUS1B",1,0) XUS1B ;ISCSF/RWF - Auto sign-on ;10/27/10 15:14 "RTN","XUS1B",2,0) ;;8.0;KERNEL;**59,337,395,469,543,594**;Jul 10, 1995;Build 6 "RTN","XUS1B",3,0) ;Per VHA Directive 2004-038, this routine should not be modified. "RTN","XUS1B",4,0) Q "RTN","XUS1B",5,0) ; "RTN","XUS1B",6,0) AUTOXUS() ;Do the check for XUS and Auto Sign-on "RTN","XUS1B",7,0) N %,FG,Y "RTN","XUS1B",8,0) I $G(XQXFLG("ASO")) Q 0 ;Already tried once. "RTN","XUS1B",9,0) G AUTO "RTN","XUS1B",10,0) ; "RTN","XUS1B",11,0) AUTOXWB() ;Do the check for XWB and Auto Sign-on "RTN","XUS1B",12,0) N %,FG,Y,NUNOW "RTN","XUS1B",13,0) I $G(XQXFLG("ASO")) Q 0 ;Already tried so skip. "RTN","XUS1B",14,0) S XUNOW=$$NOW^XLFDT ;p543 "RTN","XUS1B",15,0) AUTO ;Common code "RTN","XUS1B",16,0) I ($T(^XWBCAGNT)="")!($P(XOPT,U,18)="d") S XQXFLG("ZEBRA")=-1 Q 0 ;Disabled "RTN","XUS1B",17,0) S Y=$$CHKVIP(),%=0 "RTN","XUS1B",18,0) I Y>0 S %=$$PREF($P(XOPT,U,18),$P($G(^VA(200,Y,200)),U,18)) "RTN","XUS1B",19,0) I Y>0,'% S Y=0 ;No Auto signon "RTN","XUS1B",20,0) ;check parameter, skip set if yes, default is no p594 "RTN","XUS1B",21,0) I Y>0,'$$GET^XPAR("SYS","XU594",1,"Q") S DUZ(2)=+FG ;Set Division p543 "RTN","XUS1B",22,0) Q Y "RTN","XUS1B",23,0) ; "RTN","XUS1B",24,0) CHKVIP() ;Check for a Valid current IP "RTN","XUS1B",25,0) N REF,XREF,IEN,R0,ENV,JOB,HNDL,XTMP "RTN","XUS1B",26,0) ;D SETUP ;To log data for debug "RTN","XUS1B",27,0) S IEN=0,ENV=$$ENV,REF=$G(IO("IP")) I $L(REF) D GETHNDL(.HNDL) "RTN","XUS1B",28,0) ;Look thru the IP X-ref "RTN","XUS1B",29,0) I $L(REF) D LKUP("AS1",$P(REF,":")) ;Will set IEN "RTN","XUS1B",30,0) Q IEN "RTN","XUS1B",31,0) ; "RTN","XUS1B",32,0) LKUP(XREF,LK) ;Check one X-ref "RTN","XUS1B",33,0) N R0,R1,IX,D1,NM ;p543 "RTN","XUS1B",34,0) S IX=0,IEN=0 "RTN","XUS1B",35,0) F S IX=$O(^XUSEC(0,XREF,LK,IX)) Q:'$L(IX) D CHK Q:IEN>0 "RTN","XUS1B",36,0) Q "RTN","XUS1B",37,0) CHK ;Could this be a good one. "RTN","XUS1B",38,0) S R0=$G(^XUSEC(0,IX,0)) "RTN","XUS1B",39,0) ;Check that IP really matches "RTN","XUS1B",40,0) I $P(R0,U,11)'=REF Q ;p543 "RTN","XUS1B",41,0) ;Check entry does not have sign-off D/T. p543 "RTN","XUS1B",42,0) I $P(R0,U,4) Q "RTN","XUS1B",43,0) ;If have a Client name check that same as log. "RTN","XUS1B",44,0) S NM=$$LOW^XLFSTR($P(R0,U,12)) "RTN","XUS1B",45,0) I $D(IO("CLNM")),$L(NM),NM'=$$LOW^XLFSTR(IO("CLNM")) Q "RTN","XUS1B",46,0) ;Check date within 8 hours p543 "RTN","XUS1B",47,0) S D1=$$FMDIFF^XLFDT(XUNOW,IX,2) I (D1>28800)!(D1<-5) Q "RTN","XUS1B",48,0) ;Check handle. Use timeout on Lock p543 "RTN","XUS1B",49,0) S R1=$P(R0,U,13) I $L(R1),$D(HNDL(R1)) D "RTN","XUS1B",50,0) . L +^XWB("SESSION",IX_"~"_R1):DILOCKTM I $T L -^XWB("SESSION",IX_"~"_R1) Q "RTN","XUS1B",51,0) . ;Remove D LOG after debug. "RTN","XUS1B",52,0) . S IEN=+R0,FG=$P(R0,"^",17),XQXFLG("ASO")=IX ;D LOG Q ;Found a match "RTN","XUS1B",53,0) . Q "RTN","XUS1B",54,0) Q "RTN","XUS1B",55,0) ; "RTN","XUS1B",56,0) ENV() N Y D GETENV^%ZOSV "RTN","XUS1B",57,0) Q Y "RTN","XUS1B",58,0) ; "RTN","XUS1B",59,0) PREF(%1,%2) ; "RTN","XUS1B",60,0) Q $S($L(%2):%2,1:%1) "RTN","XUS1B",61,0) ; "RTN","XUS1B",62,0) GETHNDL(RET) ;Get the Handles from the Client "RTN","XUS1B",63,0) N %,%1,X,XXX,TS "RTN","XUS1B",64,0) ;Don't call Terminal servers/Proxy's "RTN","XUS1B",65,0) S TS=$G(IO("IP")) "RTN","XUS1B",66,0) I $L(TS),$O(^XTV(8989.3,1,405.2,"B",TS,0)) S XQXFLG("ZEBRA")=-1 Q ;Disable to TS and Proxy's "RTN","XUS1B",67,0) S %=$$CMD^XWBCAGNT(.XXX,"XWB GET HANDLES") I '% S XQXFLG("ZEBRA")=-1 Q ;Disable on Timeout p543 "RTN","XUS1B",68,0) Q:'$O(XXX(0)) "RTN","XUS1B",69,0) ;build array "RTN","XUS1B",70,0) S RET=0,%1=1 F %=1:1:$L(XXX(%1),"^") S X=$P(XXX(%1),"^",%) S:X]"" RET(X)="",RET=RET+1 "RTN","XUS1B",71,0) Q "RTN","XUS1B",72,0) ;Temp for data collection "RTN","XUS1B",73,0) SETUP ; "RTN","XUS1B",74,0) N N1,N2 "RTN","XUS1B",75,0) I '$D(^XTMP("XUSP543","CNT")) S ^XTMP("XUSP543",0)=$$HTFM^XLFDT($H+30)_"^"_XUNOW,^("CNT")=0 "RTN","XUS1B",76,0) S N1="XUSP543",N2="CNT" "RTN","XUS1B",77,0) X "S XTMP=$INCREMENT(^XTMP(N1,N2))" "RTN","XUS1B",78,0) S ^XTMP("XUSP543",XTMP,0)=$G(IO("IP"))_U_$G(IO("ZIO"))_U_XUNOW "RTN","XUS1B",79,0) Q "RTN","XUS1B",80,0) ; "RTN","XUS1B",81,0) LOG ;Log more data "RTN","XUS1B",82,0) M ^XTMP("XUSP543",XTMP,"HNDL")=HNDL "RTN","XUS1B",83,0) S ^XTMP("XUSP543",XTMP,"R0")=R0,^("R1")=R1,^("IX")=IX "RTN","XUS1B",84,0) Q "VER") 8.0^22.0 "BLD",1407,6) ^466 **END** **END**