XU8P706.m

XU8P706 ;OAK_BP/BDT - POST ROUTINE 706 REINDEX THE LOC1 X-REF; 2/07/19

 ;;8.0;KERNEL;**706**;Jul 10, 1995;Build 2

 ;;Per VHA Directive 6402, this routine should not be modified.

 ; 

 Q

 ;

PRE ; Delete x-ref

 I $G(^DD(4,720,1,1,0))="4^LOC1^MUMPS" D DELIX^DDMOD(4,720,1,"K")

 Q

 ;

POST ; Re-index the LOC nodes

 D DEL,BUILD

 Q

DEL ;

 N DIK

 S DIK="^DIC(4,"

 S DIK(1)=720

 D ENALL2^DIK

 Q

BUILD ;

 N DIK

 S DIK="^DIC(4,"

 S DIK(1)=720

 D ENALL^DIK

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---XU8P706   473     printed  Apr 09, 2024@21:06:08                                                                                                                                                                                                      Page 2

XU8P706   ;OAK_BP/BDT - POST ROUTINE 706 REINDEX THE LOC1 X-REF; 2/07/19

 +1       ;;8.0;KERNEL;**706**;Jul 10, 1995;Build 2

 +2       ;;Per VHA Directive 6402, this routine should not be modified.

 +3       ; 

 +4        QUIT 

 +5       ;

PRE       ; Delete x-ref

 +1        IF $GET(^DD(4,720,1,1,0))="4^LOC1^MUMPS"

               DO DELIX^DDMOD(4,720,1,"K")

 +2        QUIT 

 +3       ;

POST      ; Re-index the LOC nodes

 +1        DO DEL

           DO BUILD

 +2        QUIT 

DEL       ;

 +1        NEW DIK

 +2        SET DIK="^DIC(4,"

 +3        SET DIK(1)=720

 +4        DO ENALL2^DIK

 +5        QUIT 

BUILD     ;

 +1        NEW DIK

 +2        SET DIK="^DIC(4,"

 +3        SET DIK(1)=720

 +4        DO ENALL^DIK

 +5        QUIT