BCH10P9.m

BCH10P9 ;IHS/CMI/LAB - IHS CHR patch 9 [ 02/06/00  10:40 AM ]

 ;;1.0;IHS RPMS CHR SYSTEM;**9**;OCT 28, 1996

 ;

 ;reindex tribe trigger

 ;delete bad nodes in chr pov global

POV ;

 S BCHX=0 F  S BCHX=$O(^BCHRPROB(BCHX)) Q:BCHX'=+BCHX  D

 .S BCHY=0 F  S BCHY=$O(^BCHRPROB(BCHX,BCHY)) Q:BCHY=""  K ^BCHRPROB(BCHX,BCHY)

 .Q

 ;reindex trigger

 S DIK="^BCHR(",DIK(1)=".04^8" D ENALL^DIK

 K BCHX,BCHY

 Q

BCH10P9   ;IHS/CMI/LAB - IHS CHR patch 9 [ 02/06/00  10:40 AM ]

 +1       ;;1.0;IHS RPMS CHR SYSTEM;**9**;OCT 28, 1996

 +2       ;

 +3       ;reindex tribe trigger

 +4       ;delete bad nodes in chr pov global

POV       ;

 +1        SET BCHX=0

           FOR 

               SET BCHX=$ORDER(^BCHRPROB(BCHX))

               IF BCHX'=+BCHX

                   QUIT 

               Begin DoDot:1

 +2                SET BCHY=0

                   FOR 

                       SET BCHY=$ORDER(^BCHRPROB(BCHX,BCHY))

                       IF BCHY=""

                           QUIT 

                       KILL ^BCHRPROB(BCHX,BCHY)

 +3                QUIT 

               End DoDot:1

 +4       ;reindex trigger

 +5        SET DIK="^BCHR("

           SET DIK(1)=".04^8"

           DO ENALL^DIK

 +6        KILL BCHX,BCHY

 +7        QUIT