LRFIXAU.m

LRFIXAU ; IHS/DIR/AAB - CLEAN UP ^LR("AAUA",YR,LRAN,LRDFN) NODES ;  [ 07/22/2002  1:19 PM ]

 ;;5.2;LR;**1002,1013**;JUL 15, 2002

 ;;5.2;LAB SERVICE;**134**;Sep 27, 1994

 ;

 N LRDFN,NODE,YR,ACC,LRAN

 ;I '$D(^LRO(68,"VR")) D BMES^XPDUTL("You MUST have LR*5.2*72 Installed BEFORE this patch") Q  ;IHS/DIR TUC/AAB 05/19/98

 S LRDFN=0 F  S LRDFN=$O(^LR(LRDFN)) Q:'LRDFN  D

 . I '$D(^LR(LRDFN,"AU")) Q

 . S NODE=^LR(LRDFN,"AU")

 . S YR=$E(NODE,1,3)

 . S ACC=$P(NODE,U,6),LRAN=$P(ACC," ",3)

 . I YR,LRAN D

 .. I $D(^LR("AAUA",YR,LRAN,LRDFN)) K ^LR("AAUA",YR,LRAN,LRDFN)

LRFIXAU   ; IHS/DIR/AAB - CLEAN UP ^LR("AAUA",YR,LRAN,LRDFN) NODES ;  [ 07/22/2002  1:19 PM ]

 +1       ;;5.2;LR;**1002,1013**;JUL 15, 2002

 +2       ;;5.2;LAB SERVICE;**134**;Sep 27, 1994

 +3       ;

 +4        NEW LRDFN,NODE,YR,ACC,LRAN

 +5       ;I '$D(^LRO(68,"VR")) D BMES^XPDUTL("You MUST have LR*5.2*72 Installed BEFORE this patch") Q  ;IHS/DIR TUC/AAB 05/19/98

 +6        SET LRDFN=0

           FOR 

               SET LRDFN=$ORDER(^LR(LRDFN))

               IF 'LRDFN

                   QUIT 

               Begin DoDot:1

 +7                IF '$DATA(^LR(LRDFN,"AU"))

                       QUIT 

 +8                SET NODE=^LR(LRDFN,"AU")

 +9                SET YR=$EXTRACT(NODE,1,3)

 +10               SET ACC=$PIECE(NODE,U,6)

                   SET LRAN=$PIECE(ACC," ",3)

 +11               IF YR

                       IF LRAN

                           Begin DoDot:2

 +12                           IF $DATA(^LR("AAUA",YR,LRAN,LRDFN))

                                   KILL ^LR("AAUA",YR,LRAN,LRDFN)

                           End DoDot:2

               End DoDot:1