source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRMIEDZ4.m@ 861

Last change on this file since 861 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 901 bytes
RevLine 
[613]1LRMIEDZ4 ;DALISC/FHS - CONTINU MICROBIOLOGY EDIT ;3/24/92
2 ;;5.2;LAB SERVICE;;Sep 27, 1994
3 ;Formerly apart of LRMIEDZ2
4EC K LRTX S LRAN=$P($P(LRBG0,U,6)," ",3),LRLLOC=$P(LRBG0,U,8)
5 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)
6 K LRNPTP S N=0
7 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),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
8 I '$D(LRNPTP),LRPTP>0 W !,"Nothing matches with the test you preselected." Q
9 I $D(LRNPTP) S LRI=LRNPTP
10 I '$D(LRNPTP),N>0 F J=1:1:N 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
11 Q
Note: See TracBrowser for help on using the repository browser.