Routine: LRDIST2

LRDIST2 ;SLC/DM - WRITE SUMMARY OF LEVY-JENNINGS LRQC CHART ;2/5/91  13:06 ;

 ;;5.2;LAB SERVICE;**108,160,153**;Sep 27, 1994

 ;  REGION 5 ISC/SLC ;  DCM

EN W PNM,?35,"  ",SSN,?69,"  ",LRDT0,!!?18,"ACTUAL:",?39,"TARGET:",?65,"VALUE OUTSIDE:"

 W !?10,"+--------------------+",?35,"+------------+"

 W !?2,"TEST",?11,"MEAN",?19,"SD",?25,"CV",?30,"N",?36,"MEAN",?44,"SD",?50,"FL",?53,"ACCESSION",?69,"2SD",?75,"3SD"

 W !,"---------",?10,"------",?17,"------",?24,"----",?29,"---",?35,"------",?42,"-------",?50,"--",?53,"-------------",?68,"----",?74,"----",!

ENTD ;from LRDIST1

 K LRFOOT S LRFOOT=0 F LRII=1:1:LRCOUNT D WX

 W $E(LRCHM,1,9) I LRSDNORM=0!LRCTRL&(LRNC>1) S LRCV=0 S:%X'=0 LRCV=LRSD/%X*100 W ?10,$J(%X,6,3),?17,$J(LRSD,6,3),?24,$J(LRCV,4,1)

 I LRSDNORM=0!LRCTRL&(LRNC<2) W:LRNC>0 ?10,$J(LRVAL,6,3) W:LRNC<1 ?14,"**" W ?17,"    **  **"

 I LRCTRL&LRSDNORM S LREM=$P(T,U,2),LRESD=$P(T,U,3),LRECV="" S:LREM LRECV=LRESD/LREM*100 W ?29,$J(LRNC,3) W:LREM'=""&(LRESD'="") ?35,$J(LREM,6,3),?42,$J(LRESD,6,3)

 I LREM=""&(LRESD="") W ?35,"No reference range available" G LREND

 I LRFOOT S I=0 F  S I=$O(LRFOOT(I)) Q:I<1  W ?50,$J(I,2,0),?53,$E(^TMP("LR",$J,"X",LRFOOT(I),4),1,15) S X=^(2) W ?$S(X>LRLM2!(X<LRLM1):74,1:68),X W:$O(LRFOOT(I))>0 !

LREND ;from LRDIST1

 I (LRTN=LRNM)&($O(LRTEST(LRTN))<1) W:$E(IOST,1,2)'="C-" !!!!,"Reviewed by:  ___________________________________  Date: ____________" W:$E(IOST,1,2)="C-" ! Q

 W ! Q

WX S LRSTEPS=(LRHIGH-LRLOW)/4,LRLM1=LRLOW-LRSTEPS,LRLM2=LRHIGH+LRSTEPS,LRLM1F=LRLM1+LRSTEPS,LRLM2F=LRLM2-LRSTEPS,N=LRCOUNT

 S LRXF="X" I ^TMP("LR",$J,"X",LRII,2)<LRLM1F S LRFOOT=LRFOOT+1,LRFOOT(LRFOOT)=LRII,LRXF=LRFOOT

 I ^TMP("LR",$J,"X",LRII,2)>LRLM2F S LRFOOT=LRFOOT+1,LRFOOT(LRFOOT)=LRII,LRXF=LRFOOT

LRSD ;from LRDIST1

 S LRSD=-1,%X=-1 Q:N<2

 S %X=N*LRSSX-(LRSX*LRSX)/(N*(N-1)) D SQRT S LRSD=%Y,%X=LRSX/N Q

SQRT ;%Y=SQRT(%X)

 S %Y=0 Q:%X'>0  S %Y=%X+1/2

L S A9=%Y,%Y=%X/A9+A9/2 G L:%Y<A9

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRDIST2   1957     printed  Mar 13, 2025@21:18:18                                                                                                                                                                                                     Page 2

LRDIST2   ;SLC/DM - WRITE SUMMARY OF LEVY-JENNINGS LRQC CHART ;2/5/91  13:06 ;

 +1       ;;5.2;LAB SERVICE;**108,160,153**;Sep 27, 1994

 +2       ;  REGION 5 ISC/SLC ;  DCM

EN         WRITE PNM,?35,"  ",SSN,?69,"  ",LRDT0,!!?18,"ACTUAL:",?39,"TARGET:",?65,"VALUE OUTSIDE:"

 +1        WRITE !?10,"+--------------------+",?35,"+------------+"

 +2        WRITE !?2,"TEST",?11,"MEAN",?19,"SD",?25,"CV",?30,"N",?36,"MEAN",?44,"SD",?50,"FL",?53,"ACCESSION",?69,"2SD",?75,"3SD"

 +3        WRITE !,"---------",?10,"------",?17,"------",?24,"----",?29,"---",?35,"------",?42,"-------",?50,"--",?53,"-------------",?68,"----",?74,"----",!

 +4        QUIT

ENTD      ;from LRDIST1

 +1        KILL LRFOOT

           SET LRFOOT=0

           FOR LRII=1:1:LRCOUNT

               DO WX

 +2        WRITE $EXTRACT(LRCHM,1,9)

           IF LRSDNORM=0!LRCTRL&(LRNC>1)

               SET LRCV=0

               if %X'=0

                   SET LRCV=LRSD/%X*100

               WRITE ?10,$JUSTIFY(%X,6,3),?17,$JUSTIFY(LRSD,6,3),?24,$JUSTIFY(LRCV,4,1)

 +3        IF LRSDNORM=0!LRCTRL&(LRNC<2)

               if LRNC>0

                   WRITE ?10,$JUSTIFY(LRVAL,6,3)

               if LRNC<1

                   WRITE ?14,"**"

               WRITE ?17,"    **  **"

 +4        IF LRCTRL&LRSDNORM

               SET LREM=$PIECE(T,U,2)

               SET LRESD=$PIECE(T,U,3)

               SET LRECV=""

               if LREM

                   SET LRECV=LRESD/LREM*100

               WRITE ?29,$JUSTIFY(LRNC,3)

               if LREM'=""&(LRESD'="")

                   WRITE ?35,$JUSTIFY(LREM,6,3),?42,$JUSTIFY(LRESD,6,3)

 +5        IF LREM=""&(LRESD="")

               WRITE ?35,"No reference range available"

               GOTO LREND

 +6        IF LRFOOT

               SET I=0

FOR

                   SET I=$ORDER(LRFOOT(I))

                   if I<1

                       QUIT

                   WRITE ?50,$JUSTIFY(I,2,0),?53,$EXTRACT(^TMP("LR",$JOB,"X",LRFOOT(I),4),1,15)

                   SET X=^(2)

                   WRITE ?$SELECT(X>LRLM2!(X<LRLM1):74,1:68),X

                   if $ORDER(LRFOOT(I))>0

                       WRITE !

LREND     ;from LRDIST1

 +1        IF (LRTN=LRNM)&($ORDER(LRTEST(LRTN))<1)

               if $EXTRACT(IOST,1,2)'="C-"

                   WRITE !!!!,"Reviewed by:  ___________________________________  Date: ____________"

               if $EXTRACT(IOST,1,2)="C-"

                   WRITE !

               QUIT

 +2        WRITE !

           QUIT

WX         SET LRSTEPS=(LRHIGH-LRLOW)/4

           SET LRLM1=LRLOW-LRSTEPS

           SET LRLM2=LRHIGH+LRSTEPS

           SET LRLM1F=LRLM1+LRSTEPS

           SET LRLM2F=LRLM2-LRSTEPS

           SET N=LRCOUNT

 +1        SET LRXF="X"

           IF ^TMP("LR",$JOB,"X",LRII,2)<LRLM1F

               SET LRFOOT=LRFOOT+1

               SET LRFOOT(LRFOOT)=LRII

               SET LRXF=LRFOOT

 +2        IF ^TMP("LR",$JOB,"X",LRII,2)>LRLM2F

               SET LRFOOT=LRFOOT+1

               SET LRFOOT(LRFOOT)=LRII

               SET LRXF=LRFOOT

 +3        QUIT

LRSD      ;from LRDIST1

 +1        SET LRSD=-1

           SET %X=-1

           if N<2

               QUIT

 +2        SET %X=N*LRSSX-(LRSX*LRSX)/(N*(N-1))

           DO SQRT

           SET LRSD=%Y

           SET %X=LRSX/N

           QUIT

SQRT      ;%Y=SQRT(%X)

 +1        SET %Y=0

           if %X'>0

               QUIT

           SET %Y=%X+1/2

L          SET A9=%Y

           SET %Y=%X/A9+A9/2

           if %Y<A9

               GOTO L

 +1        QUIT

LRDIST2.m