Released XU*8*491 SEQ #406 Extracted from mail message **KIDS**:XU*8.0*491^ **INSTALL NAME** XU*8.0*491 "BLD",1072,0) XU*8.0*491^KERNEL^0^3080421^y "BLD",1072,1,0) ^^5^5^3080421^^^^ "BLD",1072,1,1,0) Please see the patch description on FORUM, in the National "BLD",1072,1,2,0) Patch Module. "BLD",1072,1,3,0) "BLD",1072,1,4,0) "BLD",1072,1,5,0) "BLD",1072,4,0) ^9.64PA^^ "BLD",1072,6.3) 6 "BLD",1072,"KRN",0) ^9.67PA^779.2^20 "BLD",1072,"KRN",.4,0) .4 "BLD",1072,"KRN",.401,0) .401 "BLD",1072,"KRN",.402,0) .402 "BLD",1072,"KRN",.403,0) .403 "BLD",1072,"KRN",.5,0) .5 "BLD",1072,"KRN",.84,0) .84 "BLD",1072,"KRN",3.6,0) 3.6 "BLD",1072,"KRN",3.8,0) 3.8 "BLD",1072,"KRN",9.2,0) 9.2 "BLD",1072,"KRN",9.8,0) 9.8 "BLD",1072,"KRN",9.8,"NM",0) ^9.68A^1^1 "BLD",1072,"KRN",9.8,"NM",1,0) XPDUTL^^0^B22402525 "BLD",1072,"KRN",9.8,"NM","B","XPDUTL",1) "BLD",1072,"KRN",19,0) 19 "BLD",1072,"KRN",19,"NM",0) ^9.68A^^ "BLD",1072,"KRN",19.1,0) 19.1 "BLD",1072,"KRN",101,0) 101 "BLD",1072,"KRN",409.61,0) 409.61 "BLD",1072,"KRN",771,0) 771 "BLD",1072,"KRN",779.2,0) 779.2 "BLD",1072,"KRN",870,0) 870 "BLD",1072,"KRN",8989.51,0) 8989.51 "BLD",1072,"KRN",8989.52,0) 8989.52 "BLD",1072,"KRN",8994,0) 8994 "BLD",1072,"KRN","B",.4,.4) "BLD",1072,"KRN","B",.401,.401) "BLD",1072,"KRN","B",.402,.402) "BLD",1072,"KRN","B",.403,.403) "BLD",1072,"KRN","B",.5,.5) "BLD",1072,"KRN","B",.84,.84) "BLD",1072,"KRN","B",3.6,3.6) "BLD",1072,"KRN","B",3.8,3.8) "BLD",1072,"KRN","B",9.2,9.2) "BLD",1072,"KRN","B",9.8,9.8) "BLD",1072,"KRN","B",19,19) "BLD",1072,"KRN","B",19.1,19.1) "BLD",1072,"KRN","B",101,101) "BLD",1072,"KRN","B",409.61,409.61) "BLD",1072,"KRN","B",771,771) "BLD",1072,"KRN","B",779.2,779.2) "BLD",1072,"KRN","B",870,870) "BLD",1072,"KRN","B",8989.51,8989.51) "BLD",1072,"KRN","B",8989.52,8989.52) "BLD",1072,"KRN","B",8994,8994) "BLD",1072,"QDEF") ^^^^NO^^^^NO^^NO "BLD",1072,"QUES",0) ^9.62^^ "BLD",1072,"REQB",0) ^9.611^1^1 "BLD",1072,"REQB",1,0) XU*8.0*275^1 "BLD",1072,"REQB","B","XU*8.0*275",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^3051215^2970507^.5 "PKG",3,22,1,"PAH",1,0) 491^3080421 "PKG",3,22,1,"PAH",1,1,0) ^^5^5^3080421 "PKG",3,22,1,"PAH",1,1,1,0) Please see the patch description on FORUM, in the National "PKG",3,22,1,"PAH",1,1,2,0) Patch Module. "PKG",3,22,1,"PAH",1,1,3,0) "PKG",3,22,1,"PAH",1,1,4,0) "PKG",3,22,1,"PAH",1,1,5,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") 1 "RTN","XPDUTL") 0^1^B22402525^B19386445 "RTN","XPDUTL",1,0) XPDUTL ;SFISC/RSD - KIDS utilities ;03/25/2003 15:00 "RTN","XPDUTL",2,0) ;;8.0;KERNEL;**21,28,39,81,100,108,137,181,275,491**;Jul 10, 1995;Build 6 "RTN","XPDUTL",3,0) ;Per VHA Directive 10-93-142, this routine should not be modified. "RTN","XPDUTL",4,0) Q "RTN","XPDUTL",5,0) VERSION(X) ;Get current version from Package file, X=package name or "RTN","XPDUTL",6,0) ;package namespace "RTN","XPDUTL",7,0) N I "RTN","XPDUTL",8,0) S I=$O(^DIC(9.4,"C",X,0)) S:I'>0 I=$O(^DIC(9.4,"B",X,0)) "RTN","XPDUTL",9,0) Q $P($G(^DIC(9.4,+I,"VERSION")),"^") "RTN","XPDUTL",10,0) ; "RTN","XPDUTL",11,0) VER(X) ;returns version number from Build file, X=build name "RTN","XPDUTL",12,0) Q:X["*" $P(X,"*",2) "RTN","XPDUTL",13,0) Q $P(X," ",$L(X," ")) "RTN","XPDUTL",14,0) ; "RTN","XPDUTL",15,0) STATUS(IEN) ;returns build status from Install File, IEN=Build File IEN "RTN","XPDUTL",16,0) I '$D(^XPD(9.7,IEN,0)) Q -1 "RTN","XPDUTL",17,0) Q $P(^XPD(9.7,IEN,0),U,9) "RTN","XPDUTL",18,0) ; "RTN","XPDUTL",19,0) PKG(X) ;returns package name from Build file, X=build name "RTN","XPDUTL",20,0) Q $S(X["*":$P(X,"*"),1:$P(X," ",1,$L(X," ")-1)) "RTN","XPDUTL",21,0) ; "RTN","XPDUTL",22,0) LAST(PKG,VER) ;returns last patch applied for a Package, PATCH^DATE "RTN","XPDUTL",23,0) ; Patch includes Seq # if Released "RTN","XPDUTL",24,0) N PKGIEN,VERIEN,LATEST,PATCH,SUBIEN "RTN","XPDUTL",25,0) I $G(VER)="" S VER=$$VERSION^XPDUTL(PKG) Q:'VER -1 "RTN","XPDUTL",26,0) S PKGIEN=$O(^DIC(9.4,"B",PKG,"")) Q:'PKGIEN -1 "RTN","XPDUTL",27,0) S VERIEN=$O(^DIC(9.4,PKGIEN,22,"B",VER,"")) Q:'VERIEN -1 "RTN","XPDUTL",28,0) S LATEST=-1,PATCH=-1,SUBIEN=0 "RTN","XPDUTL",29,0) F S SUBIEN=$O(^DIC(9.4,PKGIEN,22,VERIEN,"PAH",SUBIEN)) Q:SUBIEN'>0 D "RTN","XPDUTL",30,0) . I $P(^DIC(9.4,PKGIEN,22,VERIEN,"PAH",SUBIEN,0),U,2)>LATEST S LATEST=$P(^(0),U,2),PATCH=$P(^(0),U) "RTN","XPDUTL",31,0) Q PATCH_U_LATEST "RTN","XPDUTL",32,0) ; "RTN","XPDUTL",33,0) PATCH(X) ;return 1 if patch X was installed, X=aaaa*nn.nn*nnn "RTN","XPDUTL",34,0) Q:X'?1.4UN1"*"1.2N1"."1.2N.1(1"V",1"T").2N1"*"1.3N 0 "RTN","XPDUTL",35,0) N %,I,J "RTN","XPDUTL",36,0) S I=$O(^DIC(9.4,"C",$P(X,"*"),0)) Q:'I 0 "RTN","XPDUTL",37,0) S J=$O(^DIC(9.4,I,22,"B",$P(X,"*",2),0)),X=$P(X,"*",3) Q:'J 0 "RTN","XPDUTL",38,0) ;check if patch is just a number "RTN","XPDUTL",39,0) Q:$O(^DIC(9.4,I,22,J,"PAH","B",X,0)) 1 "RTN","XPDUTL",40,0) S %=$O(^DIC(9.4,I,22,J,"PAH","B",X_" SEQ")) "RTN","XPDUTL",41,0) Q (X=+%) "RTN","XPDUTL",42,0) ; "RTN","XPDUTL",43,0) INSTALDT(INSTALL,RESULT) ;returns number of installs, 0 if not installed or doesn't exist "RTN","XPDUTL",44,0) ;input: INSTALL=required, Install name; RESULT=required, passed by reference "RTN","XPDUTL",45,0) ;output: RESULT=number in RESULT array; RESULT(FM date/time)=TEST# ^ SEQ# "RTN","XPDUTL",46,0) N CNT,DATE,IEN "RTN","XPDUTL",47,0) K RESULT "RTN","XPDUTL",48,0) S (IEN,CNT,RESULT)=0 "RTN","XPDUTL",49,0) I $G(INSTALL)="" Q 0 "RTN","XPDUTL",50,0) F S IEN=$O(^XPD(9.7,"B",INSTALL,IEN)) Q:'IEN D "RTN","XPDUTL",51,0) .S DATE=$P($G(^XPD(9.7,IEN,1)),U,3) Q:'DATE "RTN","XPDUTL",52,0) .S RESULT(DATE)=$G(^XPD(9.7,IEN,6)),CNT=CNT+1 "RTN","XPDUTL",53,0) S RESULT=CNT "RTN","XPDUTL",54,0) Q CNT "RTN","XPDUTL",55,0) ; "RTN","XPDUTL",56,0) NEWCP(XPD,XPDC,XPDP) ;create new check point, returns 0=error or ien "RTN","XPDUTL",57,0) ;XPD=name, XPDC=call back, XPDP=parameters "RTN","XPDUTL",58,0) Q:$G(XPD)="" 0 "RTN","XPDUTL",59,0) N %,XPDI,XPDJ,XPDF,XPDY "RTN","XPDUTL",60,0) ;XPDCP="INI"=Pre-init, "INIT"=Post-init "RTN","XPDUTL",61,0) S XPDI=$S(XPDCP="INIT":9.716,1:9.713) "RTN","XPDUTL",62,0) S %=$$FIND1^DIC(XPDI,","_XPDA_",","X",XPD) Q:% % "RTN","XPDUTL",63,0) S XPDF="+1,"_XPDA_",",XPDJ(XPDI,XPDF,.01)=XPD "RTN","XPDUTL",64,0) S:$D(XPDC) XPDJ(XPDI,XPDF,2)=XPDC "RTN","XPDUTL",65,0) S:$D(XPDP) XPDJ(XPDI,XPDF,3)=XPDP "RTN","XPDUTL",66,0) D UPDATE^DIE("","XPDJ","XPDY") "RTN","XPDUTL",67,0) Q $G(XPDY(1)) "RTN","XPDUTL",68,0) ; "RTN","XPDUTL",69,0) UPCP(XPD,XPDP) ;update check point, returns 0=error or ien "RTN","XPDUTL",70,0) ;XPD=name, XPDP=parameters "RTN","XPDUTL",71,0) N XPDI,XPDJ,XPDF,XPDY "RTN","XPDUTL",72,0) ;XPDCP="INI"=Pre-init, "INIT"=Post-init "RTN","XPDUTL",73,0) S XPDI=$S(XPDCP="INIT":9.716,1:9.713),XPDY=$$DICCP($G(XPD)) "RTN","XPDUTL",74,0) Q:'XPDY 0 "RTN","XPDUTL",75,0) S XPDF=XPDY_","_XPDA_"," "RTN","XPDUTL",76,0) S:$D(XPDP) XPDJ(XPDI,XPDF,3)=XPDP "RTN","XPDUTL",77,0) D FILE^DIE("","XPDJ") "RTN","XPDUTL",78,0) Q XPDY "RTN","XPDUTL",79,0) ; "RTN","XPDUTL",80,0) COMCP(XPD) ;complete check point, returns 0=error or date/time "RTN","XPDUTL",81,0) ;XPD=name "RTN","XPDUTL",82,0) N XPDD,XPDI,XPDJ,XPDY "RTN","XPDUTL",83,0) S XPDI=$S(XPDCP="INIT":9.716,1:9.713),XPDY=$$DICCP($G(XPD)) "RTN","XPDUTL",84,0) Q:'XPDY 0 "RTN","XPDUTL",85,0) S XPDD=$$NOW^XLFDT,XPDJ(XPDI,XPDY_","_XPDA_",",1)=XPDD "RTN","XPDUTL",86,0) D FILE^DIE("","XPDJ") "RTN","XPDUTL",87,0) Q XPDD "RTN","XPDUTL",88,0) ; "RTN","XPDUTL",89,0) VERCP(XPD) ;verify check point, returns 1=completed, 0=not "RTN","XPDUTL",90,0) ;-1=doesn't exist "RTN","XPDUTL",91,0) ;XPD=name "RTN","XPDUTL",92,0) N XPDI,XPDY "RTN","XPDUTL",93,0) S XPDI=$S(XPDCP="INIT":9.716,1:9.713),XPDY=$$DICCP($G(XPD)) "RTN","XPDUTL",94,0) Q:'XPDY -1 "RTN","XPDUTL",95,0) Q ''$$GET1^DIQ(XPDI,XPDY_","_XPDA_",",1,"I") "RTN","XPDUTL",96,0) ; "RTN","XPDUTL",97,0) PARCP(XPD,XPDF) ;returns parameters of check point "RTN","XPDUTL",98,0) ;XPD=name, XPDF="PRE" "RTN","XPDUTL",99,0) N XPDI,XPDY "RTN","XPDUTL",100,0) I $G(XPDF)="PRE" N XPDCP S XPDCP="INI" "RTN","XPDUTL",101,0) S XPDI=$S(XPDCP="INIT":9.716,1:9.713),XPDY=$$DICCP($G(XPD)) "RTN","XPDUTL",102,0) Q:'XPDY 0 "RTN","XPDUTL",103,0) Q $$GET1^DIQ(XPDI,XPDY_","_XPDA_",",3,"I") "RTN","XPDUTL",104,0) ; "RTN","XPDUTL",105,0) CURCP(XPDF) ;returns current check point "RTN","XPDUTL",106,0) ;XPDF flag - 0=externel, 1=internal "RTN","XPDUTL",107,0) Q $S($G(XPDF):XPDCHECK,1:XPDCHECK(0)) "RTN","XPDUTL",108,0) ; "RTN","XPDUTL",109,0) WP(X) ;X=global ref "RTN","XPDUTL",110,0) N % "RTN","XPDUTL",111,0) Q:'$D(@X) "RTN","XPDUTL",112,0) F %=1:1 Q:'$D(@X@(%)) W !,@X@(%) "RTN","XPDUTL",113,0) Q:'$G(XPDA) D WP^DIE(9.7,XPDA_",",20,"A",X) "RTN","XPDUTL",114,0) Q "RTN","XPDUTL",115,0) MES(X) ;record message, X=message or an array passed by reference "RTN","XPDUTL",116,0) N % "RTN","XPDUTL",117,0) I $D(X)#2 S %=X K X S X(1)=% "RTN","XPDUTL",118,0) ;write message "RTN","XPDUTL",119,0) F %=1:1 Q:'$D(X(%)) W !,X(%) "RTN","XPDUTL",120,0) Q:'$G(XPDA) D WP^DIE(9.7,XPDA_",",20,"A","X") "RTN","XPDUTL",121,0) Q "RTN","XPDUTL",122,0) BMES(X) ;add blank line before message "RTN","XPDUTL",123,0) N % "RTN","XPDUTL",124,0) I $D(X)#2 S %=X K X S X(1)=" ",X(2)=% "RTN","XPDUTL",125,0) D MES(.X) "RTN","XPDUTL",126,0) Q "RTN","XPDUTL",127,0) RTNUP(X,Y) ;update routine action, X=routine, Y=action "RTN","XPDUTL",128,0) ;actions: 1=delete, 2=skip "RTN","XPDUTL",129,0) N % "RTN","XPDUTL",130,0) ;set action to Y "RTN","XPDUTL",131,0) Q:'$G(Y)!'$D(^XTMP("XPDI",$G(XPDA),"RTN",X)) 0 S $P(^(X),U)=+Y "RTN","XPDUTL",132,0) Q 1 "RTN","XPDUTL",133,0) ;get Build ien "RTN","XPDUTL",134,0) S Y=$O(^XTMP("XPDI",XPDA,"BLD",0)) "RTN","XPDUTL",135,0) ;remove checksum when updating action, since action can only be "RTN","XPDUTL",136,0) ;delete or skip, not sure if we want to do this "RTN","XPDUTL",137,0) S:$P(%,U,2) $P(^XTMP("XPDI",XPDA,"BLD",Y,"KRN",9.8,"NM",$P(%,U,2),0),U,4)="" "RTN","XPDUTL",138,0) Q 1 "RTN","XPDUTL",139,0) ; "RTN","XPDUTL",140,0) RTNLOG(X) ;Enter/Update routine in the Routine File "RTN","XPDUTL",141,0) N Y,FDA,IEN "RTN","XPDUTL",142,0) S Y=$O(^DIC(9.8,"B",X,0)) "RTN","XPDUTL",143,0) I Y'>0 S IEN="?+1,",FDA(9.8,IEN,1)="R" "RTN","XPDUTL",144,0) I Y>0 S IEN=(+Y)_"," "RTN","XPDUTL",145,0) S FDA(9.8,IEN,.01)=X,FDA(9.8,IEN,7.4)=$$NOW^XLFDT "RTN","XPDUTL",146,0) D UPDATE^DIE("","FDA","IEN") "RTN","XPDUTL",147,0) Q "RTN","XPDUTL",148,0) ; "RTN","XPDUTL",149,0) DICCP(X) ;lookup check point, returns ien or 0 "RTN","XPDUTL",150,0) Q:$G(X)="" 0 "RTN","XPDUTL",151,0) ;if they pass ien, fail if can't find "RTN","XPDUTL",152,0) I X=+X S Y=X Q:'$D(^XPD(9.7,XPDA,XPDCP,Y,0)) 0 "RTN","XPDUTL",153,0) E S Y=$$FIND1^DIC(XPDI,","_XPDA_",","X",X) "RTN","XPDUTL",154,0) Q Y "RTN","XPDUTL",155,0) ; "RTN","XPDUTL",156,0) PRODE(XPDN,XPD) ;enable/disable protocols, return 1 for success "RTN","XPDUTL",157,0) ;XPDN=protocol name, XPD=1-enable, 0-disable "RTN","XPDUTL",158,0) Q:$G(XPDN)="" 0 "RTN","XPDUTL",159,0) S XPD=+$G(XPD) "RTN","XPDUTL",160,0) D KIDS^XQOO1($P(XPDSET,U,2),101,XPDN,.XPD) "RTN","XPDUTL",161,0) Q $S(XPD<0:0,1:1) "RTN","XPDUTL",162,0) ; "RTN","XPDUTL",163,0) OPTDE(XPDN,XPD) ;enable/disable options, return 1 for success "RTN","XPDUTL",164,0) ;XPDN=protocol name, XPD=1-enable, 0-disable "RTN","XPDUTL",165,0) Q:$G(XPDN)="" 0 "RTN","XPDUTL",166,0) S XPD=+$G(XPD) "RTN","XPDUTL",167,0) D KIDS^XQOO1($P(XPDSET,U,2),19,XPDN,.XPD) "RTN","XPDUTL",168,0) Q $S(XPD<0:0,1:1) "RTN","XPDUTL",169,0) ; "RTN","XPDUTL",170,0) BUILD(XPDN,XPD) ;check if a build exists, return 1 for success "RTN","XPDUTL",171,0) ;XPDN=build name, XPD=1-exist, 0-been removed "RTN","XPDUTL",172,0) S XPD=$D(XPDT("NM",XPDN)) "RTN","XPDUTL",173,0) Q XPD "RTN","XPDUTL",174,0) ; "RTN","XPDUTL",175,0) MAILGRP(X) ;Return mail group for package, X=package name or namespace "RTN","XPDUTL",176,0) N XD,DIC,DR,DA,DIQ "RTN","XPDUTL",177,0) S DA=$O(^DIC(9.4,"C",X,0)) S:DA'>0 DA=$O(^DIC(9.4,"B",X,0)) Q:'DA "" "RTN","XPDUTL",178,0) S DIC="^DIC(9.4,",DR=1938,DIQ="XD" D EN^DIQ1 "RTN","XPDUTL",179,0) Q $S($G(XD(9.4,DA,1938))="":"",1:"G."_XD(9.4,DA,1938)) "VER") 8.0^22.0 "BLD",1072,6) ^406 **END** **END**