source: FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LRAPSEM2.m@ 1783

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

initial load of FOIAVistA 6/30/08 version

File size: 2.9 KB
Line 
1LRAPSEM2 ;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
6Y 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
15S 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
18T 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
20G 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 ;
22U 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
24B 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
26E 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
28H 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
31H1 D H Q:LR("Q") D A S A(2)=0 Q
32H4 D H1 Q:LR("Q") W !?5,LRT(1) Q
33H5 D H4 Q:LR("Q") W !?10,LRM(1) Q
34A 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
Note: See TracBrowser for help on using the repository browser.