Routine: BLRCU

BLRCU ; IHS/HQT/MJL - CLEAN UP TRANSACTION LOG ; [ 04/09/2001  1:37 PM ]

 ;;5.2;LR;**1011**;MAY 01, 2001

TSK ;EP for task operation

 S U="^",BLRCANDS=$G(^BLRSITE($P(^AUTTSITE(1,0),U,1),0)),BLRSTOP=$P(BLRCANDS,U,9),BLRCANDS=$P(BLRCANDS,U,8)

 I BLRSTOP K %H,BLRCANDS,BLREDJ,BLREDT,BLRDJ,BLRHCNT,BLRKDJ,BLRKDT,BLRSITE,BLRSTOP,BLRTN,DA,DIK Q

 S:'BLRCANDS BLRCANDS=90

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

 .S BLRKDJ=$H-1,BLREDJ=$P(^BLRSITE(BLRSITE,0),U,7)

 .S BLRDJ="" F  S BLRDJ=$O(^BLRSITE(BLRSITE,20,BLRDJ)) Q:BLRDJ=""  Q:BLRDJ=BLREDJ  Q:BLRDJ'<BLRKDJ  K ^BLRSITE(BLRSITE,20,BLRDJ)

 .S BLRKDJ=$H-BLRCANDS

 .S BLRDJ=BLRKDJ F  S BLRDJ=$O(^BLRSITE(BLRSITE,21,BLRDJ),-1) Q:BLRDJ=""  K ^BLRSITE(BLRSITE,21,BLRDJ)

 S %H=BLRKDJ D YMD^%DTC S BLRKDT=X,DIK="^BLRTXLOG("

 S BLRTN=0 F  S BLRTN=$O(^BLRTXLOG(BLRTN)) Q:'BLRTN  D

 .S BLREDT=$P($G(^BLRTXLOG(BLRTN,1)),U,3)

 .D:BLREDT<BLRKDT

 ..I BLREDT="" L +^BLRTXLOG(BLRTN):0 L -^BLRTXLOG(BLRTN) Q:'$T

 ..S DA=BLRTN D ^DIK

 I '$D(^BLRTXLOG(1)),$O(^BLRTXLOG(1))>10000 L +^BLRTXLOG("SEQ") S ^BLRTXLOG("SEQ")=0 L -^BLRTXLOG("SEQ")

 K %H,BLRCANDS,BLREDJ,BLREDT,BLRDJ,BLRHCNT,BLRKDJ,BLRKDT,BLRSITE,BLRSTOP,BLRTN,DA,DIK

BLRCU     ; IHS/HQT/MJL - CLEAN UP TRANSACTION LOG ; [ 04/09/2001  1:37 PM ]

 +1       ;;5.2;LR;**1011**;MAY 01, 2001

 +2       ;

TSK       ;EP for task operation

 +1        SET U="^"

           SET BLRCANDS=$GET(^BLRSITE($PIECE(^AUTTSITE(1,0),U,1),0))

           SET BLRSTOP=$PIECE(BLRCANDS,U,9)

           SET BLRCANDS=$PIECE(BLRCANDS,U,8)

 +2        IF BLRSTOP

               KILL %H,BLRCANDS,BLREDJ,BLREDT,BLRDJ,BLRHCNT,BLRKDJ,BLRKDT,BLRSITE,BLRSTOP,BLRTN,DA,DIK

               QUIT

 +3        IF 'BLRCANDS

               SET BLRCANDS=90

 +4        SET BLRSITE=0

FOR

               SET BLRSITE=$ORDER(^BLRSITE(BLRSITE))

               IF 'BLRSITE

                   QUIT

               Begin DoDot:1

 +5                SET BLRKDJ=$HOROLOG-1

                   SET BLREDJ=$PIECE(^BLRSITE(BLRSITE,0),U,7)

 +6                SET BLRDJ=""

FOR

                       SET BLRDJ=$ORDER(^BLRSITE(BLRSITE,20,BLRDJ))

                       IF BLRDJ=""

                           QUIT

                       IF BLRDJ=BLREDJ

                           QUIT

                       IF BLRDJ'<BLRKDJ

                           QUIT

                       KILL ^BLRSITE(BLRSITE,20,BLRDJ)

 +7                SET BLRKDJ=$HOROLOG-BLRCANDS

 +8                SET BLRDJ=BLRKDJ

FOR

                       SET BLRDJ=$ORDER(^BLRSITE(BLRSITE,21,BLRDJ),-1)

                       IF BLRDJ=""

                           QUIT

                       KILL ^BLRSITE(BLRSITE,21,BLRDJ)

               End DoDot:1

 +9        SET %H=BLRKDJ

           DO YMD^%DTC

           SET BLRKDT=X

           SET DIK="^BLRTXLOG("

 +10       SET BLRTN=0

FOR

               SET BLRTN=$ORDER(^BLRTXLOG(BLRTN))

               IF 'BLRTN

                   QUIT

               Begin DoDot:1

 +11               SET BLREDT=$PIECE($GET(^BLRTXLOG(BLRTN,1)),U,3)

 +12               IF BLREDT<BLRKDT

                       Begin DoDot:2

 +13                       IF BLREDT=""

                               LOCK +^BLRTXLOG(BLRTN):0

                               LOCK -^BLRTXLOG(BLRTN)

                               IF '$TEST

                                   QUIT

 +14                       SET DA=BLRTN

                           DO ^DIK

                       End DoDot:2

               End DoDot:1

 +15       IF '$DATA(^BLRTXLOG(1))

               IF $ORDER(^BLRTXLOG(1))>10000

                   LOCK +^BLRTXLOG("SEQ")

                   SET ^BLRTXLOG("SEQ")=0

                   LOCK -^BLRTXLOG("SEQ")

 +16       KILL %H,BLRCANDS,BLREDJ,BLREDT,BLRDJ,BLRHCNT,BLRKDJ,BLRKDT,BLRSITE,BLRSTOP,BLRTN,DA,DIK

 +17       QUIT

BLRCU.m