BGUCU.m

BGUCU ; IHS/OIT/MJL - CLEAN UP BGU TRACE ENTRIES ;

 ;;1.5;BGU;;MAY 26, 2005

TSK ;

 S U="^",DIK="^BGUTRACE(",BGUSP=$G(^BGUSP(1,0)),BGUNDTK=$P(BGUSP,U,7)\1 D NOW^%DTC S X1=X,X2=-(BGUNDTK) D C^%DTC S BGUTDJ=X

 S BGUENT=0 F  S BGUENT=$O(^BGUTRACE(BGUENT)) Q:'BGUENT  S BGUDJ=$P(^BGUTRACE(BGUENT,0),U,4) I BGUTDJ>BGUDJ S DA=BGUENT D ^DIK

 K BGUDJ,BGUENT,BGUNDTK,BGUSP,BGUTDJ,DA,DIK,X,X1,X2

 Q

BGUCU     ; IHS/OIT/MJL - CLEAN UP BGU TRACE ENTRIES ;

 +1       ;;1.5;BGU;;MAY 26, 2005

TSK       ;

 +1        SET U="^"

           SET DIK="^BGUTRACE("

           SET BGUSP=$GET(^BGUSP(1,0))

           SET BGUNDTK=$PIECE(BGUSP,U,7)\1

           DO NOW^%DTC

           SET X1=X

           SET X2=-(BGUNDTK)

           DO C^%DTC

           SET BGUTDJ=X

 +2        SET BGUENT=0

           FOR 

               SET BGUENT=$ORDER(^BGUTRACE(BGUENT))

               IF 'BGUENT

                   QUIT 

               SET BGUDJ=$PIECE(^BGUTRACE(BGUENT,0),U,4)

               IF BGUTDJ>BGUDJ

                   SET DA=BGUENT

                   DO ^DIK

 +3        KILL BGUDJ,BGUENT,BGUNDTK,BGUSP,BGUTDJ,DA,DIK,X,X1,X2

 +4        QUIT