IBDX961.m

IBDX961 ; ;11/29/04

 S X=DG(DQ),DIC=DIE

 S ^IBD(357.96,"AN",$E(X,1,30),DA)=""

 S X=DG(DQ),DIC=DIE

 S:+$P(^IBD(357.96,DA,0),"^",3)'="" ^IBD(357.96,"ADATNA",$P(^IBD(357.96,DA,0),"^",3),X,DA)=""

IBDX961   ; ;11/29/04

 +1        SET X=DG(DQ)

           SET DIC=DIE

 +2        SET ^IBD(357.96,"AN",$EXTRACT(X,1,30),DA)=""

 +3        SET X=DG(DQ)

           SET DIC=DIE

 +4        IF +$PIECE(^IBD(357.96,DA,0),"^",3)'=""

               SET ^IBD(357.96,"ADATNA",$PIECE(^IBD(357.96,DA,0),"^",3),X,DA)=""