LAMIAUT5.m

LAMIAUT5 ; IHS/DIR/FJE - DELETE MICRO AUTOMATED DATA UTILITY ;

 ;;5.2;LA;;NOV 01, 1997

 ;;5.2;AUTOMATED LAB INSTRUMENTS;;Sep 27, 1994

DEL ;Delete tranfered data

 W $C(7),!?10,"Removing Transfered Patient Data ",!

 F I=0:0 S I=$O(^LAH(LRLL,1,LRIFN,3,I)) Q:I=""  I $D(^(I,0))#2 S LRORGD=+^(0) I $D(LRMOVE(I)) K:LRMOVE(I)="A" LRMOVE(I),^LR(LRDFN,"MI",LRIDT,3,I) I $D(LRMOVE(I)) D DEL1

 Q

DEL1 Q:$S('$D(^LR(LRDFN,"MI",LRIDT,3,I,0))#2:1,+^(0)'=LRORGD:1,1:0)  S $P(^(0),U,2)="" D DEL2 F LRD=2:0 S LRD=$O(^LAH(LRLL,1,LRIFN,3,I,LRD)) Q:LRD=""  K ^LR(LRDFN,"MI",LRIDT,3,I,LRD)

 Q

DEL2 Q:'$O(^LAH(LRLL,1,LRIFN,3,I,1,0))  F A=0:0 S A=$O(^LAH(LRLL,1,LRIFN,3,I,1,A)) Q:A<1  K ^LR(LRDFN,"MI",LRIDT,3,II,1,A) S $P(^LR(LRDFN,"MI",LRIDT,3,II,1,0),U,4)=$P(^(0),U,4)-1,$P(^(0),U,3)=$P(^(0),U,4)

 Q

TST ;

 K DIC,LREND S DIC("A")="Verify Test ",DIC("S")="I $P(^(0),U,2)<50"

 S DA=LRAN,DA(1)=LRAD,DA(2)=LRAA,DIC="^LRO(68,"_LRAA_",1,"_LRAD_",1,"_LRAN_",4,",DIC(0)="AQEN" D ^DIC S:Y<1 LREND=1

 S LRTS=+Y

 Q

LAMIAUT5  ; IHS/DIR/FJE - DELETE MICRO AUTOMATED DATA UTILITY ;

 +1       ;;5.2;LA;;NOV 01, 1997

 +2       ;;5.2;AUTOMATED LAB INSTRUMENTS;;Sep 27, 1994

DEL       ;Delete tranfered data

 +1        WRITE $CHAR(7),!?10,"Removing Transfered Patient Data ",!

 +2        FOR I=0:0

               SET I=$ORDER(^LAH(LRLL,1,LRIFN,3,I))

               IF I=""

                   QUIT 

               IF $DATA(^(I,0))#2

                   SET LRORGD=+^(0)

                   IF $DATA(LRMOVE(I))

                       IF LRMOVE(I)="A"

                           KILL LRMOVE(I),^LR(LRDFN,"MI",LRIDT,3,I)

                       IF $DATA(LRMOVE(I))

                           DO DEL1

 +3        QUIT 

DEL1       IF $SELECT('$DATA(^LR(LRDFN,"MI",LRIDT,3,I,0))#2

               QUIT 

           SET $PIECE(^(0),U,2)=""

           DO DEL2

           FOR LRD=2:0

               SET LRD=$ORDER(^LAH(LRLL,1,LRIFN,3,I,LRD))

               IF LRD=""

                   QUIT 

               KILL ^LR(LRDFN,"MI",LRIDT,3,I,LRD)

 +1        QUIT 

DEL2       IF '$ORDER(^LAH(LRLL,1,LRIFN,3,I,1,0))

               QUIT 

           FOR A=0:0

               SET A=$ORDER(^LAH(LRLL,1,LRIFN,3,I,1,A))

               IF A<1

                   QUIT 

               KILL ^LR(LRDFN,"MI",LRIDT,3,II,1,A)

               SET $PIECE(^LR(LRDFN,"MI",LRIDT,3,II,1,0),U,4)=$PIECE(^(0),U,4)-1

               SET $PIECE(^(0),U,3)=$PIECE(^(0),U,4)

 +1        QUIT 

TST       ;

 +1        KILL DIC,LREND

           SET DIC("A")="Verify Test "

           SET DIC("S")="I $P(^(0),U,2)<50"

 +2        SET DA=LRAN

           SET DA(1)=LRAD

           SET DA(2)=LRAA

           SET DIC="^LRO(68,"_LRAA_",1,"_LRAD_",1,"_LRAN_",4,"

           SET DIC(0)="AQEN"

           DO ^DIC

           IF Y<1

               SET LREND=1

 +3        SET LRTS=+Y

 +4        QUIT