source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRAPSEM1.m@ 1000

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

initial load of WorldVistAEHR
File size: 3.3 KB
RevLine 
[613]1LRAPSEM1 ;AVAMC/REG - SEARCH BY SNOMED CODE PRINT ;8/15/95 10:51 ;
2 ;;5.2;LAB SERVICE;**72**;Sep 27, 1994
3 S LRP=0,LRJ(1)=$S($D(^VA(200,DUZ,0)):$P(^(0),U),1:"") D S^LRU I LRD(1) D ^LRAPSEM2,F Q
4 D H1 S LR("F")=1
5 F LRB=0:1 S LRP=$O(^TMP("LR",$J,"B",LRP)) Q:LRP=""!(LR("Q")) S X=$O(^(LRP,0)),Y=$O(^(X,0)),LRW=^TMP("LR",$J,X,Y) D:$Y>(IOSL-6) H1 Q:LR("Q") W ! W:$P(LRW,"^",7)'=2 "#" W LRP,?32,$P(LRW,"^",5),?46,$P(LRW,"^",3) D Y
6 Q:LR("Q") S LRY=1 D H2 Q:LR("Q") D L,F Q
7 ;
8Y S LRY=0 F B=0:0 S LRY=$O(^TMP("LR",$J,"B",LRP,LRY)) Q:'LRY!(LR("Q")) D A
9 Q:LR("Q") W !,LR("%") Q
10A S (LRC,LRAN)=0 F S LRAN=$O(^TMP("LR",$J,"B",LRP,LRY,LRAN)) Q:'LRAN!(LR("Q")) S LRC=LRC+1 W:LRC>1 ! D P
11 Q
12P S LRW=^TMP("LR",$J,LRY,LRAN),LRW(2)=$P(LRW,"^",2),LRW(1)=$P(LRW,"^")
13 S LRDFN=$P(LRW,"^",8),LRI=$P(LRW,"^",9),LRT=0 F LRG=0:1 S LRT=$O(^LR(LRDFN,LRSS,LRI,2,LRT)) Q:'LRT!(LR("Q")) S LRT(1)=$P(^LAB(61,+^(LRT,0),0),"^") D S
14 Q
15S D:$Y>(IOSL-6) H3 Q:LR("Q") W !?5,LRT(1) W:'LRG ?50,LRW(2),?58,$J(LRW(1),7) F V=2,4,1,3 I $D(LRN(V)) D T
16 Q
17T 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
18 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
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 Q
21 Q
22U Q:'$D(^LAB(+LRSN(V),LRX,0)) S LRM(1)=$P(^(0),"^") D:$Y>(IOSL-6) H4 Q:LR("Q") W !?10,LRM(1) W:LRX(1)]"" " (",$S(LRX(1)=1:"Positive",LRX(1)=0:"Negative",1:"?"),")" D:V=2 E
23 Q
24E 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 LRX=$P(^(0),"^") D:$Y>(IOSL-6) H5 Q:LR("Q") W !?15,LRX
25 Q
26L F B=0:1 S LRY=$O(^TMP("LR",$J,LRY)) Q:'LRY!(LR("Q")) D W
27 Q
28W S LRAN=0 F C=0:1 S LRAN=$O(^TMP("LR",$J,LRY,LRAN)) Q:'LRAN!(LR("Q")) D B
29 Q
30B D:$Y>(IOSL-6) H2 Q:LR("Q")
31 S LRW=^TMP("LR",$J,LRY,LRAN) W !,$P(LRW,U),?12 W:$P(LRW,"^",7)'=2 "#" W $P(LRW,"^",4),?40,$P(LRW,"^",5),?53,$P(LRW,"^",3),?56,$J($P(LRW,"^",2),3),?60,$J($P(LRW,"^",6),5)
32 Q
33H I $D(LR("F")),IOST?1"C".E D M^LRU Q:LR("Q")
34 D F^LRU W !,LRO(68)," SEARCH (",LRSTR,"-",LRLST,")"
35 W !,"# = Not VA patient",?25,"SNOMED FIELDS",?45,"For:",LRJ(1) W:LRH]"" !,"Comment: ",LRH Q
36H1 D H Q:LR("Q") W !?8,"NAME",?36,"ID",?45,"SEX",?49,"AGE",?60,"ACC #",!,LR("%") Q
37H2 D H Q:LR("Q") W !,"ACC #",?11,"NAME",?44,"ID",?52,"SEX",?56,"AGE",?60,"MO/DA",!,LR("%") Q
38H3 D H1 Q:LR("Q") W !,LRP,?32,$P(LRW,"^",5),?46,$P(LRW,"^",3) Q
39H4 D H3 Q:LR("Q") W !?5,LRT(1),?50,$P(LRW,"^",2),?58,$J($P(LRW,"^"),7) Q
40H5 D H4 Q:LR("Q") W !?10,LRM(1) Q
41F D H Q:LR("Q") W !,LR("%"),!?5,"RESULT OF ",LRO(68)," (",LRABV,") SEARCH: "
42 W !,LRAA(1)," PATIENTS WITHIN PERIOD SEARCHED: ",LR(2) W:LRSS'="AU" !,LRO(68)," ACCESSIONS WITHIN PERIOD SEARCHED: ",LR(3)
43 I LR W !,LRO(68)," ORGAN/TISSUE SPECIMENS WITHIN PERIOD SEARCHED: ",LR
44 I 'LRD(0),LR(2) W !!,$J(LRB,5)," OF ",$J(LR(2),5)," ",LRAA(1)," PATIENTS(",$J(LRB*100/LR(2),5,2),"%) FOUND"
45 W !!,"The following fields were used for the search :",!?5,"TOPOGRAPHY FIELD: ",S(2)
46 F V=2,4,1,3 I $D(LRN(V)) D C
47 Q
48C S A=-1 F F=0:0 S A=$O(LRN(V,A)) Q:A="" W !?10,$O(^DD(+LRSN(V),0,"NM",0)),?26,": ",$S(A'="Z":A,1:"ALL") D:V=2 D
49 Q
50D S B=-1 F G=0:0 S B=$O(LRN(2,A,B)) Q:B="" W !?15,"ETIOLOGY FIELD: ",$S(B'="Z":B,1:"ALL")
51 Q
Note: See TracBrowser for help on using the repository browser.