LRDIST1 ;DALOI/CJS/JMC/RLM-DATA DISTRIBUTION ;2/5/91 13:00 [ 04/14/2003 7:39 AM ]
;;5.2T9;LR;**1001,1018**;Nov 17, 2004
;;5.2;LAB SERVICE;**108,126,272**;Sep 27, 1994
Q2A 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))
S LRSPC=$S('LRCTRL:$P(^LR(LRDFN,LRSS,LRIDT,0),U,5),1:"") I LRSPEC'=-1 G:LRSPEC'=LRSPC Q2A
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
I LRSDNORM&LRCTRL,R1,LRVAL>LRLOW,LRVAL<LRHIGH S LRSX=LRSX+LRVAL,LRSSX=LRSSX+(LRVAL*LRVAL),LRNC=LRNC+1
I 'LRSDNORM!'LRCTRL!(LRCTRL&'R1) S LRSX=LRSX+LRVAL,LRSSX=LRSSX+(LRVAL*LRVAL),LRNC=LRNC+1
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
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
G Q2A:LRCOUNT<LRNSET
Q2C 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
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)
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
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
I LRFLAG G ENTD^LRDIST2
IF LRSDNORM=1 W !,"No reference range is available"
LRSTEPS S LRSTEPS=(LRHIGH-LRLOW)/4,LRNEX=LRLOW,LRSTS=LRSTEPS/10,LRLM1=LRLOW-LRSTEPS,LRLM2=LRHIGH+LRSTEPS,LRLM1F=LRLM1+LRSTEPS,LRLM2F=LRLM2-LRSTEPS,N=LRCOUNT
;W !,LRCHM,?19," ",PNM,?49," ",SSN,?69," ",LRDT0
;----- BEGIN IHS MODIFICATIONS LR*5.2*1018
W !,LRCHM,?19," ",PNM,?49," ",HRCN,?69," ",LRDT0 ;IHS/ANMC/CLS 08/18/96
;----- END IHS MODIFICATIONS
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)
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)
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)
W !,"DATE VALUE ",$S(LRCTRL:"-3SD",1:"LOW") F LRIY=1:1:5 W $J(LRNEX,10,3) S LRNEX=LRNEX+LRSTEPS
W " ",$S(LRCTRL:"+3SD",1:"HIGH") D DASH^LRX
K LRFOOT S LRFOOT=0 F LRII=1:1:LRCOUNT D Q3^LRDIST3
D DASH^LRX
Q4 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)
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.",!!
I LRCTRL S LRLF=IOSL-$Y-LRFOOT-5 I LRLF>0 F I=1:1:LRLF W !
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
I LRCTRL W !!,"Reviewed by: ____________________________ Date: __________"
WAIT 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
Q
EX S J=0 F S J=$O(^TMP("LR",$J,"X",LRFOOT(I),4,J)) Q:J<1 W !?12,^(J)
Q
LRDIST1 ;DALOI/CJS/JMC/RLM-DATA DISTRIBUTION ;2/5/91 13:00 [ 04/14/2003 7:39 AM ]
+1 ;;5.2T9;LR;**1001,1018**;Nov 17, 2004
+2 ;;5.2;LAB SERVICE;**108,126,272**;Sep 27, 1994
Q2A SET LRIDT=$ORDER(^LR(LRDFN,LRSS,LRIDT))
IF LRIDT<1!(LRIDT>LAST)
GOTO Q2C
IF '$DATA(^LR(LRDFN,LRSS,LRIDT,0))!'$LENGTH($PIECE(^(0),U,3))!'$DATA(^(LRSB))
GOTO Q2A
+1 SET LRSPC=$SELECT('LRCTRL:$PIECE(^LR(LRDFN,LRSS,LRIDT,0),U,5),1:"")
IF LRSPEC'=-1
IF LRSPEC'=LRSPC
GOTO Q2A
+2 ;G:'LRVAL&($P(^(LRSB),U,1)'=0) Q2A
SET LRVAL=+$PIECE(^LR(LRDFN,LRSS,LRIDT,LRSB),U,1)
IF 'LRVAL
IF $PIECE(^(LRSB),U,1)'=0
IF $PIECE(^(LRSB),U,1)'?1."0"1"."1."0"
GOTO Q2A
+3 IF LRSDNORM&LRCTRL
IF R1
IF LRVAL>LRLOW
IF LRVAL<LRHIGH
SET LRSX=LRSX+LRVAL
SET LRSSX=LRSSX+(LRVAL*LRVAL)
SET LRNC=LRNC+1
+4 IF 'LRSDNORM!'LRCTRL!(LRCTRL&'R1)
SET LRSX=LRSX+LRVAL
SET LRSSX=LRSSX+(LRVAL*LRVAL)
SET LRNC=LRNC+1
+5 SET LRCOUNT=LRCOUNT+1
SET ^TMP("LR",$JOB,"X",LRCOUNT,1)=$PIECE(^LR(LRDFN,LRSS,LRIDT,0),U,1)
SET ^TMP("LR",$JOB,"X",LRCOUNT,4)=$PIECE(^LR(LRDFN,LRSS,LRIDT,0),U,6)
SET ^TMP("LR",$JOB,"X",LRCOUNT,2)=LRVAL
SET ^TMP("LR",$JOB,"X",LRCOUNT,3)=LRSPC
+6 SET I=0
FOR
SET I=$ORDER(^LR(LRDFN,LRSS,LRIDT,1,I))
IF I<1
QUIT
SET X=^(I,0)
SET ^TMP("LR",$JOB,"X",LRCOUNT,4,I)=X
+7 IF LRCOUNT<LRNSET
GOTO Q2A
Q2C IF LRCOUNT=0
WRITE !,"Nothing to plot for ",LRCHM
IF LRFLAG&(LRCOUNT=0)
DO LREND^LRDIST2
IF LRCOUNT=0
QUIT
IF LRNC<2
IF '$DATA(LRLOW)
SET LRLOW=LRVAL-2
SET LRHIGH=LRVAL+2
+1 IF LRNC>1
SET N=LRNC
DO LRSD^LRDIST2
SET LRSDD=LRSD
IF LRSD=0
SET LRSDD=1
SET LRLOW=%X-(2*LRSDD)
SET LRHIGH=%X+(2*LRSDD)
+2 IF LRSDNORM=1&LRCTRL
SET T=$ORDER(^LAB(62.3,DFN,1,"B",+LRTEST(LRTN),0))
IF T>0
SET T=^LAB(62.3,DFN,1,T,0)
SET X=$PIECE(T,U,2)
SET Y=(2*$PIECE(T,U,3))
SET LRLOW=X-Y
SET LRHIGH=X+Y
IF 'LRFLAG
GOTO LRSTEPS
IF LRFLAG
GOTO ENTD^LRDIST2
+3 IF LRSDNORM=1
IF $DATA(^LAB(60,+LRTEST(LRTN),1,LRSPEC,0))
IF $LENGTH($PIECE(^(0),U,2))
IF $LENGTH($PIECE(^(0),U,3))
SET @("LOW="_$PIECE(^(0),U,2))
SET @("HIGH="_$PIECE(^(0),U,3))
IF 'LRFLAG
GOTO LRSTEPS
IF LRFLAG
GOTO ENTD^LRDIST2
+4 IF LRFLAG
GOTO ENTD^LRDIST2
+5 IF LRSDNORM=1
WRITE !,"No reference range is available"
LRSTEPS SET LRSTEPS=(LRHIGH-LRLOW)/4
SET LRNEX=LRLOW
SET LRSTS=LRSTEPS/10
SET LRLM1=LRLOW-LRSTEPS
SET LRLM2=LRHIGH+LRSTEPS
SET LRLM1F=LRLM1+LRSTEPS
SET LRLM2F=LRLM2-LRSTEPS
SET N=LRCOUNT
+1 ;W !,LRCHM,?19," ",PNM,?49," ",SSN,?69," ",LRDT0
+2 ;----- BEGIN IHS MODIFICATIONS LR*5.2*1018
+3 ;IHS/ANMC/CLS 08/18/96
WRITE !,LRCHM,?19," ",PNM,?49," ",HRCN,?69," ",LRDT0
+4 ;----- END IHS MODIFICATIONS
+5 SET X=$SELECT($DATA(^LAB(60,+LRTEST(LRTN),1,LRSPEC,0)):^(0),1:"")
IF LRSPEC>0
WRITE !,"SITE/SPECIMEN: ",$PIECE(^LAB(61,LRSPEC,0),U,1)
IF $LENGTH($PIECE(X,U,2))
WRITE ?30,"REFERENCE LOW: ",@$PIECE(X,U,2)
IF $LENGTH($PIECE(X,U,3))
WRITE ?55,"REFERENCE HIGH: ",@$PIECE(X,U,3)
+6 IF $LENGTH($PIECE(X,U,11))
WRITE ?30,"THERAPEUTIC LOW: ",@$PIECE(X,U,11)
IF $LENGTH($PIECE(X,U,12))
WRITE ?55,"THERAPEUTIC HIGH: ",@$PIECE(X,U,12)
+7 WRITE !
IF $LENGTH($PIECE(X,U,7))
WRITE "UNITS: ",$PIECE(X,U,7)
IF $LENGTH($PIECE(X,U,4))
WRITE ?30,"CRITICAL LOW: ",@$PIECE(X,U,4)
IF $LENGTH($PIECE(X,U,5))
WRITE ?55,"CRITICAL HIGH: ",@$PIECE(X,U,5)
+8 WRITE !,"DATE VALUE ",$SELECT(LRCTRL:"-3SD",1:"LOW")
FOR LRIY=1:1:5
WRITE $JUSTIFY(LRNEX,10,3)
SET LRNEX=LRNEX+LRSTEPS
+9 WRITE " ",$SELECT(LRCTRL:"+3SD",1:"HIGH")
DO DASH^LRX
+10 KILL LRFOOT
SET LRFOOT=0
FOR LRII=1:1:LRCOUNT
DO Q3^LRDIST3
+11 DO DASH^LRX
Q4 IF LRCTRL&LRSDNORM
IF R1
SET LREM=$PIECE(T,U,2)
SET LRESD=$PIECE(T,U,3)
SET LRECV=""
IF LREM
SET LRECV=LRESD/LREM*100
WRITE !,"Target: mean=",$JUSTIFY(LREM,6,3)," 1 SD=",$JUSTIFY(LRESD,6,3)," 1 CV=",$JUSTIFY(LRECV,6,3)
+1 IF LRSDNORM=0!LRCTRL&(LRNC>1)
SET LRCV=0
IF %X'=0
SET LRCV=LRSD/%X*100
WRITE !,"Actual: mean=",$JUSTIFY(%X,6,3)," 1 SD=",$JUSTIFY(LRSD,6,3)," 1 CV=",$JUSTIFY(LRCV,6,3),!,"N=",LRNC,!,"CAUTION: Time scale is sequential, not proportional.",!!
+2 IF LRCTRL
SET LRLF=IOSL-$Y-LRFOOT-5
IF LRLF>0
FOR I=1:1:LRLF
WRITE !
+3 IF LRFOOT
WRITE !,"FLAG ACCESSION VALUE OUTSIDE 2SD",?46,"3SD"
SET I=0
FOR
SET I=$ORDER(LRFOOT(I))
IF I<1
QUIT
WRITE !,I,?7,^TMP("LR",$JOB,"X",LRFOOT(I),4)
SET X=^(2)
WRITE ?$SELECT(X>LRLM2!(X<LRLM1):45,1:34),X
DO EX
+4 IF LRCTRL
WRITE !!,"Reviewed by: ____________________________ Date: __________"
WAIT IF $EXTRACT(IOST,1,2)="P-"
WRITE @IOF
IF $EXTRACT(IOST,1,2)'="C-"
QUIT
READ !,"PRESS '^' TO STOP ",X:DTIME
IF X=""
SET X=1
SET LREND=".^"[X
QUIT
+1 QUIT
EX SET J=0
FOR
SET J=$ORDER(^TMP("LR",$JOB,"X",LRFOOT(I),4,J))
IF J<1
QUIT
WRITE !?12,^(J)
+1 QUIT
