XU8P672 ;SFIRMFO/MAF -POST-install;04/22/2015 14:20
;;8.0;KERNEL;**672**;APR 22, 2015;Build 28
;Per VHA Directive 2004-038, this routine should not be modified.
D BMES^XPDUTL(" *** Running post-init for patch XU*8.0*672 ***")
N XUPKGID,XUPKGFL,DA,X,XUFLG
S XUPKGID=$O(^DIC(9.4,"B","KERNEL",0)) I $D(^DIC(9.4,+XUPKGID,0)) D
.D BMES^XPDUTL("Checking system for package file entry for KERNEL that is associated")
.D MES^XPDUTL("with patient merge - delete entry")
.S X=0,XUFLG=0
.F X=0:0 S X=$O(^DIC(9.4,XUPKGID,20,X)) Q:X'>0 I $D(^DIC(9.4,XUPKGID,20,X,0)),$P($G(^DIC(9.4,XUPKGID,20,X,0)),"^",1)=2 S XUPKGFL=X D
. .S DA(1)=XUPKGID,DA=XUPKGFL S DIK="^DIC(9.4,"_DA(1)_",20,"
. .D ^DIK D BMES^XPDUTL("*** Entry found and deleted!") S XUFLG=1
. .K DIK,DA
. . Q
.Q
I 'XUFLG D BMES^XPDUTL("*** No entry found!")
D BMES^XPDUTL(" ")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXU8P672 880 printed Dec 13, 2024@02:08:29 Page 2
XU8P672 ;SFIRMFO/MAF -POST-install;04/22/2015 14:20
+1 ;;8.0;KERNEL;**672**;APR 22, 2015;Build 28
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 DO BMES^XPDUTL(" *** Running post-init for patch XU*8.0*672 ***")
+4 NEW XUPKGID,XUPKGFL,DA,X,XUFLG
+5 SET XUPKGID=$ORDER(^DIC(9.4,"B","KERNEL",0))
IF $DATA(^DIC(9.4,+XUPKGID,0))
Begin DoDot:1
+6 DO BMES^XPDUTL("Checking system for package file entry for KERNEL that is associated")
+7 DO MES^XPDUTL("with patient merge - delete entry")
+8 SET X=0
SET XUFLG=0
+9 FOR X=0:0
SET X=$ORDER(^DIC(9.4,XUPKGID,20,X))
if X'>0
QUIT
IF $DATA(^DIC(9.4,XUPKGID,20,X,0))
IF $PIECE($GET(^DIC(9.4,XUPKGID,20,X,0)),"^",1)=2
SET XUPKGFL=X
Begin DoDot:2
+10 SET DA(1)=XUPKGID
SET DA=XUPKGFL
SET DIK="^DIC(9.4,"_DA(1)_",20,"
+11 DO ^DIK
DO BMES^XPDUTL("*** Entry found and deleted!")
SET XUFLG=1
+12 KILL DIK,DA
+13 QUIT
End DoDot:2
+14 QUIT
End DoDot:1
+15 IF 'XUFLG
DO BMES^XPDUTL("*** No entry found!")
+16 DO BMES^XPDUTL(" ")
+17 QUIT
