41 lines
3.2 KiB
Mathematica
41 lines
3.2 KiB
Mathematica
|
LRAPSM1 ;AVAMC/REG/CYM - SEARCH BY SNOMED CODE PRINT ;8/13/97 09:58 ;
|
||
|
|
;;5.2;LAB SERVICE;**72,173**;Sep 27, 1994
|
||
|
|
S (LR(13),N)=0,T="," S:LRN="" LRN="MANY" D H S LR("F")=1 D H1
|
||
|
|
F A=0:1 S N=$O(^TMP($J,"B",N)) Q:N=""!(LR("Q")) S LRYA=$O(^(N,0)),LRAX=$O(^(LRYA,0)),LR(11)=^TMP($J,LRYA,LRAX) D:$Y>(IOSL-6) H,H1 Q:LR("Q") D Y
|
||
|
|
S H(2)=1 D H,H2 Q:LR("Q") D L
|
||
|
|
D H Q:LR("Q") W !,?21,"RESULT OF ",LRO(68)," SEARCH: "
|
||
|
|
W !,LRAA(1)," PATIENTS WITHIN PERIOD SEARCHED: ",LR(2) W:LRSS'="AU" !,LRO(68)," ACCESSIONS WITHIN PERIOD SEARCHED: ",LR(3)
|
||
|
|
I LR(2) W !!,$J(A,5)," OF ",$J(LR(2),5)," PATIENTS(",$J(A*100/LR(2),5,2),"%)"
|
||
|
|
I LR(1) W !,$J(LR(13),5)," OF ",$J(LR(1),5)," SNOMED CODE ",S(2)," SPECIMENS(",$J(LR(13)*100/LR(1),5,2),"%)"
|
||
|
|
I LR W !,$J(LR,14)," ORGAN/TISSUE SPECIMENS WITHIN PERIOD SEARCHED",!?15,"(SNOMED TOPOGRAPHY CODE ",S(2)," IS ",$J(LR(1)*100/LR,5,2),"%)"
|
||
|
|
Q
|
||
|
|
Y W ! W:$P(LR(11),"^",7)'=2 "#" W $E(N,1,17),?19,$P(LR(11),"^",5),?25,$P(LR(11),"^",3) S H(2)=0 F B=0:1 S H(2)=$O(^TMP($J,"B",N,H(2))) Q:'H(2)!(LR("Q")) W:B ! D ABC
|
||
|
|
Q
|
||
|
|
ABC S LRAN=0 F C=0:1 S LRAN=$O(^TMP($J,"B",N,H(2),LRAN)) Q:'LRAN!(LR("Q")) D PRT
|
||
|
|
Q
|
||
|
|
PRT S LR(11)=^TMP($J,H(2),LRAN) W:C>0 ! W ?27,$P(LR(11),"^",2) W ?31,$J($P(LR(11),"^"),7)
|
||
|
|
S LR(7)=0 F E=1:1 S LR(7)=$O(^TMP($J,H(2),LRAN,LR(7))) Q:'LR(7)!(LR("Q")) S LR(5)=^(LR(7),0),LR(13)=LR(13)+1 D:$Y>(IOSL-6) H3 Q:LR("Q") W:E>1 ! W ?46,$E(LR(5),1,15) D M1
|
||
|
|
Q
|
||
|
|
M1 S M=0 F Z=1:1 S M=$O(^TMP($J,H(2),LRAN,LR(7),M)) Q:M=""!(LR("Q")) S LR(6)=^(M) D:$Y>(IOSL-6) H5 Q:LR("Q") W:Z>1 ! S X=$P(LR(6),"^",2),Y=$S(X]"":16,1:80) W ?62,$E($P(LR(6),"^"),1,Y) W:X]"" ?80,$S(X=0:"Neg",X=1:"Pos",1:"?")
|
||
|
|
Q
|
||
|
|
L F B=0:1 S H(2)=$O(^TMP($J,H(2))) Q:'H(2)!(LR("Q")) D W
|
||
|
|
Q
|
||
|
|
W S LRAN=0 F C=0:1 S LRAN=$O(^TMP($J,H(2),LRAN)) Q:'LRAN!(LR("Q")) D PT
|
||
|
|
Q
|
||
|
|
PT D:$Y>(IOSL-6) H,H2 Q:LR("Q")
|
||
|
|
S LR(11)=^TMP($J,H(2),LRAN) W !,$P(LR(11),"^"),?16 W:$P(LR(11),"^",7)'=2 "#" W $E($P(LR(11),"^",4),1,15),?33,$P(LR(11),"^",5),?38,$P(LR(11),"^",3),?41,$J($P(LR(11),"^",2),3),?45,$J($P(LR(11),"^",6),5)
|
||
|
|
S LR(7)=0 F E=1:1 S LR(7)=$O(^TMP($J,H(2),LRAN,LR(7))) Q:'LR(7)!(LR("Q")) S LR(5)=^(LR(7),0) D:$Y>(IOSL-6) H4 Q:LR("Q") W:E>1 ! W ?52,$E(LR(5),1,15) D M
|
||
|
|
Q
|
||
|
|
M S M=0 F Z=1:1 S M=$O(^TMP($J,H(2),LRAN,LR(7),M)) Q:M=""!(LR("Q")) S LR(6)=^(M) D:$Y>(IOSL-6) H6 Q:LR("Q") W:Z>1 ! S X=$P(LR(6),"^",2),Y=$S(X]"":11,1:80) W ?69,$E($P(LR(6),"^"),1,Y) W:Y=11 ?86,$S(X=0:"Neg",X=1:"Pos",1:"?")
|
||
|
|
Q
|
||
|
|
H I $D(LR("F")),$E(IOST,1,2)="C-" D M^LRU Q:LR("Q")
|
||
|
|
D F^LRU W !,LRO(68)," (",LRABV,") SEARCH(",LRSTR,"=>",LRLST,")"
|
||
|
|
W !,"# = Not VA patient",!,"SNOMED TOPOGRAPHY CODE: ",S(2)_$E("-----",1,5-$L(S(2))),?46,"SNOMED ",S(7)," CODE: ",LRN_$E("-----",1,5-$L(LRN))
|
||
|
|
W !,LR("%") Q
|
||
|
|
H1 Q:LR("Q") W !!,?8,"NAME",?19,"ID",?23,"SEX",?27,"AGE",?32,"ACC #",?43,"ORGAN/TISSUE",?62,S(7) W !! Q
|
||
|
|
H2 Q:LR("Q") W !!,"ACC #",?16,"NAME",?33,"ID",?37,"SEX",?41,"AGE",?45,"MO/DA",?52,"ORGAN/TISSUE",?69,S(7) Q
|
||
|
|
H3 D H,H1 Q:LR("Q") W !,$E(N,1,18),?19,$P(LR(11),"^",5),?25,$P(LR(11),"^",3),?27,$P(LR(11),"^",2),?31,$J($P(LR(11),"^"),7) Q
|
||
|
|
H4 D H,H2 Q:LR("Q") W !,$P(LR(11),"^"),?16,$E($P(LR(11),"^",4),1,15),?33,$P(LR(11),"^",5),?38,$P(LR(11),"^",3),?41,$J($P(LR(11),"^",2),3),?45,$J($P(LR(11),"^",6),5) Q
|
||
|
|
H5 D H3 Q:LR("Q") W ?43,$E(LR(5),1,15) Q
|
||
|
|
H6 D H4 Q:LR("Q") W ?55,$E(LR(5),1,15) Q
|