LRMIEDZ4.m

LRMIEDZ4 ; IHS/HQT/MJL - CONTINU MICROBIOLOGY EDIT ;  [ 07/22/2002  1:24 PM ]

 ;;5.2;LR;**1010,1013**;JUL 15, 2002

 ;

 ;;5.2;LAB SERVICE;;Sep 27, 1994

 ;Formerly apart of LRMIEDZ2

EC K LRTX S LRAN=$P($P(LRBG0,U,6)," ",3),LRLLOC=$P(LRBG0,U,8)

 S LRODT=$P(^LRO(68,LRAA,1,LRAD,1,LRAN,0),U,4),LRSN=$P(^(0),U,5) I $D(^LRO(69,+LRODT,1,+LRSN,0)) S DIC="^LRO(69,"_LRODT_",1,",DA=LRSN,DR=6 D:DA>0 EN^DIQ S:$D(DTOUT)!($D(DUOUT)) LREND=1 Q:$G(LREND)

 K LRNPTP S N=0

 S LRI=0 F  S LRI=+$O(^LRO(68,LRAA,1,LRAD,1,+LRAN,4,LRI)) Q:LRI<.5  S N=N+1,LRTS(N)=+^(LRI,0) I LRTS(N) S LRTX(N)=$S($L($P(^LAB(60,LRTS(N),0),U,14)):^LAB(62.07,$P(^(0),U,14),.1),1:"W !,""EDIT CODE IN FILE 60 NOT DEFINED.""") I LRTS(N)=LRPTP S LRNPTP=N Q

 I '$D(LRNPTP),LRPTP>0 W !,"Nothing matches with the test you preselected." Q

 I $D(LRNPTP) S LRI=LRNPTP

 I '$D(LRNPTP),N>0 F J=1:1:N I LRTS(J) W !,?3,J,?8,$P(^LAB(60,LRTS(J),0),U) S Y=$P(^LRO(68,LRAA,1,LRAD,1,+LRAN,4,LRTS(J),0),U,5) D:Y>0 DD^LRX W:Y'="" " completed ",Y

 Q

LRMIEDZ4  ; IHS/HQT/MJL - CONTINU MICROBIOLOGY EDIT ;  [ 07/22/2002  1:24 PM ]

 +1       ;;5.2;LR;**1010,1013**;JUL 15, 2002

 +2       ;

 +3       ;;5.2;LAB SERVICE;;Sep 27, 1994

 +4       ;Formerly apart of LRMIEDZ2

EC         KILL LRTX

           SET LRAN=$PIECE($PIECE(LRBG0,U,6)," ",3)

           SET LRLLOC=$PIECE(LRBG0,U,8)

 +1        SET LRODT=$PIECE(^LRO(68,LRAA,1,LRAD,1,LRAN,0),U,4)

           SET LRSN=$PIECE(^(0),U,5)

           IF $DATA(^LRO(69,+LRODT,1,+LRSN,0))

               SET DIC="^LRO(69,"_LRODT_",1,"

               SET DA=LRSN

               SET DR=6

               IF DA>0

                   DO EN^DIQ

               IF $DATA(DTOUT)!($DATA(DUOUT))

                   SET LREND=1

               IF $GET(LREND)

                   QUIT 

 +2        KILL LRNPTP

           SET N=0

 +3        SET LRI=0

           FOR 

               SET LRI=+$ORDER(^LRO(68,LRAA,1,LRAD,1,+LRAN,4,LRI))

               IF LRI<.5

                   QUIT 

               SET N=N+1

               SET LRTS(N)=+^(LRI,0)

               IF LRTS(N)

                   SET LRTX(N)=$SELECT($LENGTH($PIECE(^LAB(60,LRTS(N),0),U,14)):^LAB(62.07,$PIECE(^(0),U,14),.1),1:"W !,""EDIT CODE IN FILE 60 NOT DEFINED.""")

                   IF LRTS(N)=LRPTP

                       SET LRNPTP=N

                       QUIT 

 +4        IF '$DATA(LRNPTP)

               IF LRPTP>0

                   WRITE !,"Nothing matches with the test you preselected."

                   QUIT 

 +5        IF $DATA(LRNPTP)

               SET LRI=LRNPTP

 +6        IF '$DATA(LRNPTP)

               IF N>0

                   FOR J=1:1:N

                       IF LRTS(J)

                           WRITE !,?3,J,?8,$PIECE(^LAB(60,LRTS(J),0),U)

                           SET Y=$PIECE(^LRO(68,LRAA,1,LRAD,1,+LRAN,4,LRTS(J),0),U,5)

                           IF Y>0

                               DO DD^LRX

                           IF Y'=""

                               WRITE " completed ",Y

 +7        QUIT