XU8P511.m

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 ---XU8P511   520     printed  Apr 09, 2024@21:13:57                                                                                                                                                                                                      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