LRFIXAU.m

LRFIXAU ;DALISC/CYM  CLEAN UP ^LR("AAUA",YR,LRAN,LRDFN) NODES 9/20/96

 ;;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

 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)

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---LRFIXAU   488     printed  Apr 23, 2025@18:28:49                                                                                                                                                                                                      Page 2

LRFIXAU   ;DALISC/CYM  CLEAN UP ^LR("AAUA",YR,LRAN,LRDFN) NODES 9/20/96

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

 +2       ;

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

 +4        IF '$DATA(^LRO(68,"VR"))

               DO BMES^XPDUTL("You MUST have LR*5.2*72 Installed BEFORE this patch")

               QUIT 

 +5        SET LRDFN=0

           FOR 

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

               if 'LRDFN

                   QUIT 

               Begin DoDot:1

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

                       QUIT 

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

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

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

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

 +10               IF YR

                       IF LRAN

                           Begin DoDot:2

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

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

                           End DoDot:2

               End DoDot:1