XU8P511 ;ISF/RD - Patch XU*8*511 Post-init ;10/15/2008
;;8.0;KERNEL;**511**;Jul 10, 1995;Build 5
;Per VHA Directive 2004-038, this routine should not be modified.
Q
;
POST ; kill "C" & "C2" x-ref in Package file and re-index
N DIC,DIK,DA
S DIK="^DIC(9.4,",DIK(1)=1
K ^DIC(9.4,"C"),^("C2")
;re-index the PREFIX field, #1
D ENALL^DIK
;re-index the ADDITIONAL PREFIX field, #14
K DA,DIK
S DIK="^DIC(9.4,DA(1),14,",DIK(1)=".01^C2",DA(1)=0
F S DA(1)=$O(^DIC(9.4,DA(1))) Q:'DA(1) D ENALL^DIK
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXU8P511 520 printed Oct 16, 2024@18:08:48 Page 2
XU8P511 ;ISF/RD - Patch XU*8*511 Post-init ;10/15/2008
+1 ;;8.0;KERNEL;**511**;Jul 10, 1995;Build 5
+2 ;Per VHA Directive 2004-038, this routine should not be modified.
+3 QUIT
+4 ;
POST ; kill "C" & "C2" x-ref in Package file and re-index
+1 NEW DIC,DIK,DA
+2 SET DIK="^DIC(9.4,"
SET DIK(1)=1
+3 KILL ^DIC(9.4,"C"),^("C2")
+4 ;re-index the PREFIX field, #1
+5 DO ENALL^DIK
+6 ;re-index the ADDITIONAL PREFIX field, #14
+7 KILL DA,DIK
+8 SET DIK="^DIC(9.4,DA(1),14,"
SET DIK(1)=".01^C2"
SET DA(1)=0
+9 FOR
SET DA(1)=$ORDER(^DIC(9.4,DA(1)))
if 'DA(1)
QUIT
DO ENALL^DIK
+10 QUIT
