XUPRE247.m

XUPRE247 ;ISC-SF.BP/BDT - DELETE "AF" X-REF; [ 01/14/2004  4:54 PM ]

 ;;8.0;KERNEL;**247,255,1010**;Jul 31, 2002

 ;

 Q

 ;

PRE ;Delete AF x-ref

 I $G(^DD(200,.01,1,3,0))="200^AF^MUMPS" D DELIX^DDMOD(200,.01,3,"K")

 ;

 Q

 ;end of PRE

POST255 ;Re-index "B" and "G" x-refs for the Person Class file

 D  ;JUST TO SET TOP LEVEL

 .D  ;KILL OFF B-XREF

 ..N DIK,DA

 ..S DIK="^USC(8932.1,"

 ..S DIK(1)=".01^B"

 ..D ENALL2^DIK

 .D  ;REINDEX THE B-XREF

 ..N DIK,DA

 ..S DIK="^USC(8932.1,"

 ..S DIK(1)=".01^B"

 ..D ENALL^DIK

 .D  ;INDEX THE G-XREF

 ..N DIK,DA

 ..S DIK="^USC(8932.1,"

 ..S DIK(1)="6^G"

 ..D ENALL^DIK

 ;

 Q

XUPRE247  ;ISC-SF.BP/BDT - DELETE "AF" X-REF; [ 01/14/2004  4:54 PM ]

 +1       ;;8.0;KERNEL;**247,255,1010**;Jul 31, 2002

 +2       ;

 +3        QUIT 

 +4       ;

PRE       ;Delete AF x-ref

 +1        IF $GET(^DD(200,.01,1,3,0))="200^AF^MUMPS"

               DO DELIX^DDMOD(200,.01,3,"K")

 +2       ;

 +3        QUIT 

 +4       ;end of PRE

POST255   ;Re-index "B" and "G" x-refs for the Person Class file

 +1       ;JUST TO SET TOP LEVEL

           Begin DoDot:1

 +2       ;KILL OFF B-XREF

               Begin DoDot:2

 +3                NEW DIK,DA

 +4                SET DIK="^USC(8932.1,"

 +5                SET DIK(1)=".01^B"

 +6                DO ENALL2^DIK

               End DoDot:2

 +7       ;REINDEX THE B-XREF

               Begin DoDot:2

 +8                NEW DIK,DA

 +9                SET DIK="^USC(8932.1,"

 +10               SET DIK(1)=".01^B"

 +11               DO ENALL^DIK

               End DoDot:2

 +12      ;INDEX THE G-XREF

               Begin DoDot:2

 +13               NEW DIK,DA

 +14               SET DIK="^USC(8932.1,"

 +15               SET DIK(1)="6^G"

 +16               DO ENALL^DIK

               End DoDot:2

           End DoDot:1

 +17      ;

 +18       QUIT