BLRSQUE.m

BLRSQUE ; IHS/DIR/FJE - SET IHS LAB TRANS. IN THE QUE ; [ 07/30/2002  8:44 AM ]

 ;;5.2;LR;**1013**;JUL 30, 2002

 S BLRDH=+$H,U="^",BLRSITE=$P(^AUTTSITE(1,0),U,1)

 S BLRLAST=$P(^BLRTXLOG(0),U,3)

 S %H=BLRDH D YX^%DTC S BLRFIDT=X

 F BLRI=1:1:BLRLAST S ^BLRSITE(BLRSITE,21,BLRDH,BLRI)=BLRI

 S ^BLRSITE(BLRSITE,21,BLRDH,0)=BLRFIDT_U_BLRLAST_U_0

 S $P(^BLRSITE(BLRSITE,0),U,6)=BLRDH

 K BLRDH,BLRFIDT,BLRLAST,BLRSITE

 Q

BLRSQUE   ; IHS/DIR/FJE - SET IHS LAB TRANS. IN THE QUE ; [ 07/30/2002  8:44 AM ]

 +1       ;;5.2;LR;**1013**;JUL 30, 2002

 +2        SET BLRDH=+$HOROLOG

           SET U="^"

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

 +3        SET BLRLAST=$PIECE(^BLRTXLOG(0),U,3)

 +4        SET %H=BLRDH

           DO YX^%DTC

           SET BLRFIDT=X

 +5        FOR BLRI=1:1:BLRLAST

               SET ^BLRSITE(BLRSITE,21,BLRDH,BLRI)=BLRI

 +6        SET ^BLRSITE(BLRSITE,21,BLRDH,0)=BLRFIDT_U_BLRLAST_U_0

 +7        SET $PIECE(^BLRSITE(BLRSITE,0),U,6)=BLRDH

 +8        KILL BLRDH,BLRFIDT,BLRLAST,BLRSITE

 +9        QUIT