| 1 | LRAPSEM2 ;AVAMC/REG/CYM- SEARCH BY SNOMED CODE PRINT ;3/10/98 10:16 ;
|
|---|
| 2 | ;;5.2;LAB SERVICE;**72,201**;Sep 27, 1994
|
|---|
| 3 | D H S LR("F")=1,DIWF="W",DIWL=5,DIWR=IOM-5
|
|---|
| 4 | F LRY=0:0 S LRY=$O(^TMP("LR",$J,LRY)) Q:'LRY!(LR("Q")) F LRAN=0:0 S LRAN=$O(^TMP("LR",$J,LRY,LRAN)) Q:'LRAN!(LR("Q")) S LRW=^(LRAN) D:$Y>(IOSL-6) H Q:LR("Q") D Y
|
|---|
| 5 | Q
|
|---|
| 6 | Y S LRP=$E($P(LRW,"^",4),1,20),LRI=$P(LRW,"^",9),LRDFN=$P(LRW,"^",8),LRW(7)=$S($P(LRW,"^",7)=2:"",1:"#"),LRA=^LR(LRDFN,LRSS,LRI,0),LRA(1)=+LRA,LRA(8)=$E($P(LRA,"^",8),1,5),LRA(7)=$E($P($G(^VA(200,+$P(LRA,"^",7),0)),"^"),1,12)
|
|---|
| 7 | S LRA(2)=$E($P($G(^VA(200,+$P(LRA,"^",2),0)),"^"),1,13),LRW(1)=$P(LRW,"^"),LRW(2)=$P(LRW,"^",2) D A
|
|---|
| 8 | S A=0 F A(2)=0:1 S A=$O(^LR(LRDFN,LRSS,LRI,.1,A)) Q:'A!(LR("Q")) S A(1)=$P(^(A,0),"^") D:$Y>(IOSL-6) H1 Q:LR("Q") W ! W:'A(2) "Specimen(s):" W ?15,A(1)
|
|---|
| 9 | Q:LR("Q") K ^TMP($J) S LRZ=0 F LRZ(2)=0:1 S LRZ=$O(^LR(LRDFN,LRSS,LRI,1.1,LRZ)) Q:'LRZ!(LR("Q")) S LRZ(1)=^(LRZ,0) D:$Y>(IOSL-6) H1 Q:LR("Q") S X=LRZ(1) D ^DIWP
|
|---|
| 10 | Q:LR("Q") D:LRZ(2) ^DIWW
|
|---|
| 11 | Q:LR("Q") K ^TMP($J) S LRZ=0 F LRZ(2)=0:1 S LRZ=$O(^LR(LRDFN,LRSS,LRI,1.4,LRZ)) Q:'LRZ!(LR("Q")) S LRZ(1)=^(LRZ,0) D:$Y>(IOSL-6) H1 Q:LR("Q") S X=LRZ(1) D ^DIWP
|
|---|
| 12 | Q:LR("Q") D:LRZ(2) ^DIWW I 'LRD(2) W !,LR("%") Q
|
|---|
| 13 | F LRT=0:0 S LRT=$O(^LR(LRDFN,LRSS,LRI,2,LRT)) Q:'LRT!(LR("Q")) S X=$G(^LAB(61,+^(LRT,0),0)),LRT(1)=$P(X,"^"),LRT(2)=$P(X,"^",2) D S
|
|---|
| 14 | W !,LR("%") Q
|
|---|
| 15 | S D:$Y>(IOSL-6) H1 Q:LR("Q") W !?5,"T-",LRT(2)," ",LRT(1) F V=2,4,1,3 I $D(LRN(V)) D T
|
|---|
| 16 | Q:LR("Q") I LRD F LRM=0:0 S LRM=$O(^LR(LRDFN,LRSS,LRI,2,LRT,5,LRM)) Q:'LRM!(LR("Q")) S LRX=^(LRM,0) D:$Y>(IOSL-6) H4 Q:LR("Q") D G
|
|---|
| 17 | Q
|
|---|
| 18 | T F LRM=0:0 S LRM=$O(^LR(LRDFN,LRSS,LRI,2,LRT,V,LRM)) Q:'LRM!(LR("Q")) S X=^(LRM,0),LRX=+X,LRX(1)=$P(X,"^",2) D U
|
|---|
| 19 | Q
|
|---|
| 20 | G S X=LRX,Y=$P(X,"^",2),W=$P(X,"^",3),Z=$P(X,"^")_":",Z=$P($P(LR(LRSS),Z,2),";") D D^LRU W !?10,Z," ",W," Date: ",Y D B Q
|
|---|
| 21 | ;
|
|---|
| 22 | U Q:'$D(^LAB(+LRSN(V),LRX,0)) S X=^(0),LRM(1)=$P(X,"^"),LRM(2)=$P(X,"^",2) D:$Y>(IOSL-6) H4 Q:LR("Q") W !?10,$P(LRSN(V),"^",2),"-",LRM(2)," ",LRM(1) W:LRX(1)]"" " (",$S(LRX(1)=1:"Positive",LRX(1)=0:"Negative",1:"?"),")" D:V=2 E
|
|---|
| 23 | Q
|
|---|
| 24 | B K ^TMP($J) S LRZ=0 F LRZ(2)=0:0 S LRZ=$O(^LR(LRDFN,LRSS,LRI,2,LRT,5,LRM,1,LRZ)) Q:'LRZ!(LR("Q")) S LRZ(1)=^(LRZ,0) D:$Y>(IOSL-6) H4 Q:LR("Q") S X=LRZ(1) D ^DIWP
|
|---|
| 25 | D:LRZ(2) ^DIWW Q
|
|---|
| 26 | E F LRE=0:0 S LRE=$O(^LR(LRDFN,LRSS,LRI,2,LRT,2,LRM,1,LRE)) Q:'LRE!(LR("Q")) S LRX=+^(LRE,0) I $D(^LAB(61.2,LRX,0)) S X=^(0),LRX=$P(X,"^"),LRX(2)=$P(X,"^",2) D:$Y>(IOSL-6) H5 Q:LR("Q") W !?15,"E-",LRX(2)," ",LRX
|
|---|
| 27 | Q
|
|---|
| 28 | H I $D(LR("F")),IOST?1"C".E D M^LRU Q:LR("Q")
|
|---|
| 29 | D F^LRU W !,LRO(68)," (",LRABV,") SEARCH (",LRSTR,"-",LRLST,")" W !,"Date",?8,"# = Not VA patient",?35,"For:",LRJ(1)
|
|---|
| 30 | W !,"Taken",?11,"Patient",?30,"ID",?35,"Physician",?48,"LOC",?55,"Acc#",?67,"PATHOLOGIST",!,LR("%") Q
|
|---|
| 31 | H1 D H Q:LR("Q") D A S A(2)=0 Q
|
|---|
| 32 | H4 D H1 Q:LR("Q") W !?5,LRT(1) Q
|
|---|
| 33 | H5 D H4 Q:LR("Q") W !?10,LRM(1) Q
|
|---|
| 34 | A W !,$$Y2K^LRX(LRA(1),"5D"),?10,LRW(7),?11,LRP,?32,$P($P(LRW,"^",5),"-",3),?37,LRA(7),?50,LRA(8),?57,$P(LRA,"^",6),?69,LRA(2) Q
|
|---|
