source: FOIAVistA/trunk/r/LAB_SERVICE-LR-LS/LRQCC.m@ 811

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

initial load of FOIAVistA 6/30/08 version

File size: 3.2 KB
Line 
1LRQCC ;SLC/CJS - QUALITY CONTROL FOR BULL ALGORITHM ;2/6/91 14:28 ;
2 ;;5.2;LAB SERVICE;;Sep 27, 1994
3 S DIC="^LRO(68,",DIC(0)="AEOQ" D ^DIC Q:Y<1 S LRAA=+Y
4 S %DT="AE" W !,"START FROM" D ^%DT Q:Y<0 S LRSDT=Y-1
5C2 S DIC("A")="Select INSTRUMENT: ",DIC("S")="I $D(^(5))",DIC="^LAB(62.4," D ^DIC K DIC Q:Y<1 S LRMACH=+Y,LRMC=^LAB(62.4,LRMACH,5)
6 I '$P(^LAB(62.4,LRMACH,5),U,2)!('$P(^(5),U,3))!('$P(^(5),U,4)) W " ??",$C(7),!,"Mean data values are missing in the AUTO INSTRUMENT file for this instrument." G LREND
7 S %ZIS="Q" D ^%ZIS G LREND:POP
8 I $D(IO("Q")) S ZTRTN="DQ^LRQCC" F I="LRMACH","LRMC","LRSDT","LRAA" S ZTSAVE(I)=""
9 I $D(IO("Q")) K IO("Q") D ^%ZTLOAD W:$D(ZTSK) !,"REQUEST QUEUED" G END
10DQ U IO D LIST D ^%ZISC
11END K %,A,DIC,I,K,N,X,Y,Z,LRMACH,LRMC,LRSDT,LRAA,DIC,%ZIS,ZTRTN,ZTIO,ZTDESC,ZTSAVE,ZTSK Q
12LABULL Q:'$D(LRBULL) K LRBULL Q:'$D(LRMACH) Q:'$D(^LAB(62.4,LRMACH,5))
13 L +^LRO(68,LRAA,1,DT,3,LRMACH)
14 S N=20,U="^",LRTODAY=DT,X1=DT,X2=-1 D C^%DTC S LRSDT=X
15 IF $D(^LRO(68,LRAA,1,LRTODAY,3,LRMACH,0)) G C4
16 S %DT="",X="T-1" D ^%DT IF '$D(^LRO(68,LRAA,1,Y,3,LRMACH,0)) G C3
17 S LRNS=1+$P(^LRO(68,LRAA,1,Y,3,LRMACH,1,0),U,4) IF +^(LRNS,0)'=N S ^LRO(68,LRAA,1,LRTODAY,3,LRMACH,1,1,0)=^LRO(68,LRAA,1,Y,3,LRMACH,1,LRNS,0) K ^LRO(68,LRAA,1,Y,3,LRMACH,1,LRNS,0) G C3A
18 ;;now set 'count' and 'previous x' = ""
19C3 S ^LRO(68,LRAA,1,LRTODAY,3,LRMACH,1,1,0)=""
20C3A S ^LRO(68,LRAA,1,LRTODAY,3,LRMACH,0)=^LAB(62.4,LRMACH,5),^LRO(68,LRAA,1,LRTODAY,3,0)="^68.07PA^",^(LRMACH,1,0)="^68.08A^"
21C4 S LRMC=^LRO(68,LRAA,1,LRTODAY,3,LRMACH,0),B=1+$P(^(1,0),U,4) G LREND:'$D(^(B,0))!'$D(^LR(LRDFN,"CH",LRIDT,388))
22 ;;now set x = 'previous x' + ($S(val<0:-1,1:1) * SQRT(val - grand mean))
23 S LREND=0 F I=2:1:4 S LRMP=386+I,LRSI=1 S:'$D(^LR(LRDFN,"CH",LRIDT,LRMP)) LREND=1 Q:LREND S X=$P(^(LRMP),U,1)-$P(LRMC,U,I) S:X<0 LRSI=-1,X=-X D SQRT S LRMM(I)=$J($P(^LRO(68,LRAA,1,LRTODAY,3,LRMACH,1,B,0),U,I)+(LRSI*Y),0,6)
24 ;;now set count = 1 + count and store calculated values
25 G LREND:LREND S ^(0)=(1+^LRO(68,LRAA,1,LRTODAY,3,LRMACH,1,B,0))_U_LRMM(2)_U_LRMM(3)_U_LRMM(4)
26 ;;if count is less than 20, done for now
27 I +^LRO(68,LRAA,1,LRTODAY,3,LRMACH,1,B,0)<N G LREND
28 ;;set mean = grand mean + $S(x<0:-1,1:1) * ((x/20)**2)
29 F I=2:1:4 S LRSI=1 S:$P(^LRO(68,LRAA,1,LRTODAY,3,LRMACH,1,B,0),U,I)<0 LRSI=-1 S LRMM(I)=$P(LRMC,U,I)+(LRSI*($P(^(0),U,I)/N)*($P(^(0),U,I)/N))
30 S LRNEW=B F I=2:1:4 S LRNEW=LRNEW_U_$J(LRMM(I),4,1)
31 ;;back to initial conditions, x and count = ""
32 S ^LRO(68,LRAA,1,LRTODAY,3,LRMACH,1,0)="^68.08A^"_B_U_B,^(B,0)=LRNEW,^LRO(68,LRAA,1,LRTODAY,3,LRMACH,1,B+1,0)=""
33LIST W !,"DATE",?18,"MCV",?40,"MCH",?62,"MCHC",!,?12 F I=1:1:3 W "# DELTA % "
34C5 S LRSDT=$O(^LRO(68,LRAA,1,LRSDT)),N=20,U="^" G:LRSDT<1 LREND
35 G:'$D(^LRO(68,LRAA,1,LRSDT,3,LRMACH,0)) C5 S N=+$P(^LRO(68,LRAA,1,LRSDT,3,LRMACH,1,0),U,4)
36 F I=1:1:N S LROLD=^LRO(68,LRAA,1,LRSDT,3,LRMACH,1,I,0) W !,$E(LRSDT,2,7) F J=2:1:4 W ?((J-2)*22+12),$P(LROLD,U,J),?((J-2)*22+18),$J($P(LROLD,U,J)-$P(LRMC,U,J),4,1),?((J-2)*22+24),$J($P(LROLD,U,J)-$P(LRMC,U,J)/$P(LRMC,U,J)*100,5,1)
37 G C5
38SQRT ;Y=SQRT(X)
39 S Y=0 Q:X'>0 S Y=X+1/2
40L S T=Y,Y=X/T+T/2 G L:Y<T
41 Q
42LREND LOCK -^LRO(68,LRAA,1,DT,3,LRMACH)
43 K %,A,DIC,I,K,N,X,Y,Z,LRMM,LRMC,LRSI,T,LRSDT,LROLD,LRTODAY
44 K %DT,%H,%ZA,%ZB,%ZC,B,LRMP,LRNEW,LRNS,POP,X1,X2,ZTSAVE,ZTSK
45 Q
Note: See TracBrowser for help on using the repository browser.