source: FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LRDIST1.m@ 677

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

initial load of FOIAVistA 6/30/08 version

File size: 3.4 KB
Line 
1LRDIST1 ;DALOI/CJS/JMC/RLM-DATA DISTRIBUTION ;2/5/91 13:00
2 ;;5.2;LAB SERVICE;**108,126,272**;Sep 27, 1994
3Q2A S LRIDT=$O(^LR(LRDFN,LRSS,LRIDT)) G Q2C:LRIDT<1!(LRIDT>LAST),Q2A:'$D(^LR(LRDFN,LRSS,LRIDT,0))!'$L($P(^(0),U,3))!'$D(^(LRSB))
4 S LRSPC=$S('LRCTRL:$P(^LR(LRDFN,LRSS,LRIDT,0),U,5),1:"") I LRSPEC'=-1 G:LRSPEC'=LRSPC Q2A
5 S LRVAL=+$P(^LR(LRDFN,LRSS,LRIDT,LRSB),U,1) I 'LRVAL,$P(^(LRSB),U,1)'=0,$P(^(LRSB),U,1)'?1."0"1"."1."0" G Q2A ;G:'LRVAL&($P(^(LRSB),U,1)'=0) Q2A
6 I LRSDNORM&LRCTRL,R1,LRVAL>LRLOW,LRVAL<LRHIGH S LRSX=LRSX+LRVAL,LRSSX=LRSSX+(LRVAL*LRVAL),LRNC=LRNC+1
7 I 'LRSDNORM!'LRCTRL!(LRCTRL&'R1) S LRSX=LRSX+LRVAL,LRSSX=LRSSX+(LRVAL*LRVAL),LRNC=LRNC+1
8 S LRCOUNT=LRCOUNT+1,^TMP("LR",$J,"X",LRCOUNT,1)=$P(^LR(LRDFN,LRSS,LRIDT,0),U,1),^TMP("LR",$J,"X",LRCOUNT,4)=$P(^LR(LRDFN,LRSS,LRIDT,0),U,6),^TMP("LR",$J,"X",LRCOUNT,2)=LRVAL,^TMP("LR",$J,"X",LRCOUNT,3)=LRSPC
9 S I=0 F S I=$O(^LR(LRDFN,LRSS,LRIDT,1,I)) Q:I<1 S X=^(I,0),^TMP("LR",$J,"X",LRCOUNT,4,I)=X
10 G Q2A:LRCOUNT<LRNSET
11Q2C W:LRCOUNT=0 !,"Nothing to plot for ",LRCHM D LREND^LRDIST2:LRFLAG&(LRCOUNT=0) Q:LRCOUNT=0 I LRNC<2,'$D(LRLOW) S LRLOW=LRVAL-2,LRHIGH=LRVAL+2
12 I LRNC>1 S N=LRNC D LRSD^LRDIST2 S LRSDD=LRSD S:LRSD=0 LRSDD=1 S LRLOW=%X-(2*LRSDD),LRHIGH=%X+(2*LRSDD)
13 IF LRSDNORM=1&LRCTRL S T=$O(^LAB(62.3,DFN,1,"B",+LRTEST(LRTN),0)) I T>0 S T=^LAB(62.3,DFN,1,T,0),X=$P(T,U,2),Y=(2*$P(T,U,3)),LRLOW=X-Y,LRHIGH=X+Y G LRSTEPS:'LRFLAG,ENTD^LRDIST2:LRFLAG
14 IF LRSDNORM=1,$D(^LAB(60,+LRTEST(LRTN),1,LRSPEC,0)),$L($P(^(0),U,2)),$L($P(^(0),U,3)) S @("LOW="_$P(^(0),U,2)),@("HIGH="_$P(^(0),U,3)) G LRSTEPS:'LRFLAG,ENTD^LRDIST2:LRFLAG
15 I LRFLAG G ENTD^LRDIST2
16 IF LRSDNORM=1 W !,"No reference range is available"
17LRSTEPS S LRSTEPS=(LRHIGH-LRLOW)/4,LRNEX=LRLOW,LRSTS=LRSTEPS/10,LRLM1=LRLOW-LRSTEPS,LRLM2=LRHIGH+LRSTEPS,LRLM1F=LRLM1+LRSTEPS,LRLM2F=LRLM2-LRSTEPS,N=LRCOUNT
18 W !,LRCHM,?19," ",PNM,?49," ",SSN,?69," ",LRDT0
19 S X=$S($D(^LAB(60,+LRTEST(LRTN),1,LRSPEC,0)):^(0),1:"") W:LRSPEC>0 !,"SITE/SPECIMEN: ",$P(^LAB(61,LRSPEC,0),U,1) W:$L($P(X,U,2)) ?30,"REFERENCE LOW: ",@$P(X,U,2) W:$L($P(X,U,3)) ?55,"REFERENCE HIGH: ",@$P(X,U,3)
20 W:$L($P(X,U,11)) ?30,"THERAPEUTIC LOW: ",@$P(X,U,11) W:$L($P(X,U,12)) ?55,"THERAPEUTIC HIGH: ",@$P(X,U,12)
21 W ! W:$L($P(X,U,7)) "UNITS: ",$P(X,U,7) W:$L($P(X,U,4)) ?30,"CRITICAL LOW: ",@$P(X,U,4) W:$L($P(X,U,5)) ?55,"CRITICAL HIGH: ",@$P(X,U,5)
22 W !,"DATE VALUE ",$S(LRCTRL:"-3SD",1:"LOW") F LRIY=1:1:5 W $J(LRNEX,10,3) S LRNEX=LRNEX+LRSTEPS
23 W " ",$S(LRCTRL:"+3SD",1:"HIGH") D DASH^LRX
24 K LRFOOT S LRFOOT=0 F LRII=1:1:LRCOUNT D Q3^LRDIST3
25 D DASH^LRX
26Q4 I LRCTRL&LRSDNORM,R1 S LREM=$P(T,U,2),LRESD=$P(T,U,3),LRECV="" S:LREM LRECV=LRESD/LREM*100 W !,"Target: mean=",$J(LREM,6,3)," 1 SD=",$J(LRESD,6,3)," 1 CV=",$J(LRECV,6,3)
27 IF LRSDNORM=0!LRCTRL&(LRNC>1) S LRCV=0 S:%X'=0 LRCV=LRSD/%X*100 W !,"Actual: mean=",$J(%X,6,3)," 1 SD=",$J(LRSD,6,3)," 1 CV=",$J(LRCV,6,3),!,"N=",LRNC,!,"CAUTION: Time scale is sequential, not proportional.",!!
28 I LRCTRL S LRLF=IOSL-$Y-LRFOOT-5 I LRLF>0 F I=1:1:LRLF W !
29 I LRFOOT W !,"FLAG ACCESSION VALUE OUTSIDE 2SD",?46,"3SD" S I=0 F S I=$O(LRFOOT(I)) Q:I<1 W !,I,?7,^TMP("LR",$J,"X",LRFOOT(I),4) S X=^(2) W ?$S(X>LRLM2!(X<LRLM1):45,1:34),X D EX
30 I LRCTRL W !!,"Reviewed by: ____________________________ Date: __________"
31WAIT W:$E(IOST,1,2)="P-" @IOF Q:$E(IOST,1,2)'="C-" R !,"PRESS '^' TO STOP ",X:DTIME S:X="" X=1 S LREND=".^"[X Q
32 Q
33EX S J=0 F S J=$O(^TMP("LR",$J,"X",LRFOOT(I),4,J)) Q:J<1 W !?12,^(J)
34 Q
Note: See TracBrowser for help on using the repository browser.