- 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 Feb 18, 2025@23:34:55 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
