| 1 | LRUPAD1 ;AVAMC/REG/WTY - LAB ACCESSION LIST COND'T ;9/25/00
|
|---|
| 2 | ;;5.2;LAB SERVICE;**248**;Sep 27, 1994
|
|---|
| 3 | ;
|
|---|
| 4 | ;Reference to ^DIC( supported by IA #916
|
|---|
| 5 | ;Reference to ^VA(200 supported by IA #10060
|
|---|
| 6 | ;Reference to DIC supported by IA #10006
|
|---|
| 7 | ;
|
|---|
| 8 | S X=$S($D(^LRO(68,LRAA,1,I,1,N,5,1,0)):^(0),1:""),C(3)=+X
|
|---|
| 9 | S:'C(3) C(3)=LRU(1) S C(2)=$P(X,"^",2) S:'C(2) C(2)=LRU(1)
|
|---|
| 10 | I $D(C(1)),C(1)'=C(2) Q
|
|---|
| 11 | Q:'$D(^LRO(68,LRAA,1,I,1,N,3)) S X=^(3),LRI=$P(X,"^",5)
|
|---|
| 12 | S A(3)=$P(X,"^",3),X=^LRO(68,LRAA,1,I,1,N,0),LRIFN=+X
|
|---|
| 13 | S A(7)=$P(X,"^",7),A(8)=$P(X,"^",8) S:'A(3) A(3)=$P(X,"^",3)
|
|---|
| 14 | S A(3)=$E(A(3),4,5)_"/"_$E(A(3),6,7)
|
|---|
| 15 | S N(6)=$S($D(^LRO(68,LRAA,1,I,1,N,6)):^(6),1:"")
|
|---|
| 16 | Q:'$D(^LR(LRIFN,0)) S X=^(0),DA=$P(X,"^",3),(LRDPF,X)=$P(X,"^",2)
|
|---|
| 17 | S DIC="^DIC(",DIC(0)="Z" D ^DIC Q:Y=-1
|
|---|
| 18 | S P(0)=Y(0,0) K DIC,Y
|
|---|
| 19 | S DIC=^DIC(X,0,"GL"),DIC(0)="NZ",X=DA D ^DIC Q:Y=-1
|
|---|
| 20 | S SSN=$P(Y(0),"^",9),LRP=$P(Y(0),"^") K DIC,DA,Y
|
|---|
| 21 | D SSN^LRU
|
|---|
| 22 | S:LRSS="CY" Q(2)=Q(2)+N(6),Q(1)=Q(1)+$P(N(6),"^",2) D V
|
|---|
| 23 | W:$L(LRC(5)) !?4,LRC(5)
|
|---|
| 24 | Q
|
|---|
| 25 | V D:$Y>(IOSL-8) H Q:LR("Q") W !,$J(N,5)
|
|---|
| 26 | I LRSS'="AU",'$D(^LR(LRIFN,LRSS,LRI,0)) D Q
|
|---|
| 27 | .W ?8,$J(A(3),5),?14 W:P(0)'="PATIENT" "#"
|
|---|
| 28 | .W $E(LRP,1,20),?34,SSN(1)
|
|---|
| 29 | .W " Data NOT in lab results file #63 !!!"
|
|---|
| 30 | W ?8,$J(A(3),5),?14 W:P(0)'="PATIENT" "#"
|
|---|
| 31 | W $E(LRP,1,20),?34,SSN(1),?40,$E(A(7),1,5)
|
|---|
| 32 | I LRSS="AU" Q:'$D(^LR(LRIFN,"AU")) S X=^("AU") D Q
|
|---|
| 33 | .W ?45,$S('$P(X,"^",3):"%",1:"")
|
|---|
| 34 | .S Y=+X D:Y D^LRU W ?47,Y
|
|---|
| 35 | I $L(A(8)),"CYEMSP"[LRSS D
|
|---|
| 36 | .W ?46,$E($S($D(^VA(200,A(8),0)):$P(^(0),"^"),1:A(8)),1,10)
|
|---|
| 37 | I "CYEMSP"[LRSS D Q:"EMSP"[LRSS
|
|---|
| 38 | .S X=^LR(LRIFN,LRSS,LRI,0),C(6)=$S($P(X,"^",12):"*",1:"")
|
|---|
| 39 | .W:'$P(X,"^",3) ?57,"%"
|
|---|
| 40 | .S:$D(^LR(LRIFN,LRSS,LRI,99,1,0)) LRC(5)=^(0)
|
|---|
| 41 | .D O
|
|---|
| 42 | I LRSS="CY" W ?72,$J(+N(6),5) W:$P(N(6),"^",2) "b" W ?79,C(6) Q
|
|---|
| 43 | W ?46,$S(C(2)>0&(P(0)="STERILIZER"!(P(0)="ENVIRONMENTAL")):$E($P(^LAB(62,C(2),0),"^"),1,14),$D(^LAB(61,C(3),0)):$E($P(^LAB(61,C(3),0),"^"),1,13),1:"")
|
|---|
| 44 | W S Z(2)=$S($P(^LR(LRIFN,LRSS,LRI,0),"^",3):"",LRSS="MI":"",1:"%"),Z=0
|
|---|
| 45 | F A=0:1 S Z=$O(^LRO(68,LRAA,1,I,1,N,4,Z)) Q:'Z!(LR("Q")) D Q:LR("Q")
|
|---|
| 46 | .S Z(3)=$S($D(^LRO(68,LRAA,1,I,1,N,4,Z,0)):^(0),1:"")
|
|---|
| 47 | .D:+Z(3) L
|
|---|
| 48 | Q
|
|---|
| 49 | L W:A>0 !
|
|---|
| 50 | W ?61,Z(2),?62,$E($P(^LAB(60,+Z(3),0),"^"),1,13)
|
|---|
| 51 | S TECH=$P(Z(3),"^",4)
|
|---|
| 52 | S:TECH?1N.N TECH=$P($G(^VA(200,TECH,0)),"^",2)
|
|---|
| 53 | W ?76,$E(TECH,1,4)
|
|---|
| 54 | K TECH
|
|---|
| 55 | D:$Y>(IOSL-8) H Q:LR("Q")
|
|---|
| 56 | Q
|
|---|
| 57 | O S C(4)=0
|
|---|
| 58 | F E=0:1 S C(4)=$O(^LR(LRIFN,LRSS,LRI,2,C(4))) Q:'C(4)!(LR("Q")) D
|
|---|
| 59 | .S C(3)=+^LR(LRIFN,LRSS,LRI,2,C(4),0)
|
|---|
| 60 | .D T
|
|---|
| 61 | Q:LR("Q") W:E=0 ?58,"No SNOMED code" Q
|
|---|
| 62 | T D:$Y>(IOSL-8) H Q:LR("Q") W:E>0 !
|
|---|
| 63 | W ?58,$S($D(^LAB(61,C(3),0)):$E($P(^LAB(61,C(3),0),"^"),1,14),1:"")
|
|---|
| 64 | Q
|
|---|
| 65 | H D H^LRUPAD W !
|
|---|
| 66 | Q
|
|---|
