source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LRBLCMV.m@ 1006

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

initial load of WorldVistAEHR

File size: 1.9 KB
Line 
1LRBLCMV ;AVAMC/REG - UNIT PHENOTYPE BY ABO/RH ;9/13/89 19:30 ;
2 ;;5.2;LAB SERVICE;**247**;Sep 27, 1994
3 ;Per VHA Directive 97-033 this routine should not be modified. Medical Device # BK970021
4 D END W !!?20,"CMV ANTIBODY tested units" S:'$D(DTIME) DTIME=60 S C(9)="POSNEG"
5SEL W !!,"Select CMV ANTIBODY: NEG// " R X:DTIME G:X[U!'$T END S:X="" X="NEG"
6 I X'?1"N".U&(X'?1"P".U)!($L(X)>3)!(C(9)'[X) W $C(7),!,"Enter 'POS' for CMV ANTIBODY POSITIVE units",!,"Enter 'NEG' for CMV ANTIBODY NEGATIVE units." G SEL
7 S X(1)=$S($A(X)=80:"POS",1:"NEG") W $E(X(1),$L(X)+1,3)
8 S LRV=$S(X="NEG":0,1:1)
9 S DIC="^LAB(66,",DIC(0)="AEQM",DIC("A")="Select BLOOD COMPONENT: " D ^DIC K DIC G:X=""!(X[U) END S C=+Y,C(1)=$P(Y,U,2)
10ABO R !,"Select ABO group: ",C(7):DTIME Q:C(7)["^"!(C(7)="") I C(7)'="A"&(C(7)'="B")&(C(7)'="O")&(C(7)'="AB") W $C(7),!,"Enter A, B, AB or O" G ABO
11RH R !,"Select Rh type: ",X:DTIME Q:X=""!(X["^") I X'?1"N".U&(X'?1"P".U)!($L(X)>3)!(C(9)'[X) W $C(7)," Enter 'NEG' or 'POS'" G RH
12 S C(8)=$S($A(X)=80:"POS",1:"NEG") W $E(C(8),$L(X)+1,3)
13 S ZTRTN="QUE^LRBLCMV" D BEG^LRUTL G:POP!($D(ZTSK)) END
14QUE U IO D L^LRU,S^LRU S X="N",%DT="T",Z=0 D ^%DT S N=Y,H=$P(Y,".") D D^LRU S Z(1)=Y D H S LR("F")=1
15 S A=0 F B=0:1 S A=$O(^LRD(65,"AI",C,A)) Q:A=""!(LR("Q")) S Q=$O(^LRD(65,"AI",C,A,0)) Q:'Q D I
16 W:'Z !!,"No CMV ANTIBODY ",$S(LRV=0:"NEG",1:"POS")," ",C(7)," ",C(8)," ",C(1),"." D END,END^LRUTL Q
17 ;
18I I Q[".",Q<N K ^LRD(65,"AI",C,A,Q) Q
19 I Q<H K ^LRD(65,"AI",C,A,Q) Q
20 K F,J S V=+$O(^LRD(65,"AI",C,A,Q,0)) Q:'$D(^LRD(65,V,0)) S F=^(0) Q:$P(F,"^",15)'=LRV
21 Q:$P(F,"^",7)'=C(7)!($P(F,"^",8)'=C(8))
22 S Z=Z+1 D:$Y>(IOSL-6) H Q:LR("Q") W !,$J(Z,3),")",?5,$P(F,"^"),?20 S Y=$P(F,"^",6) D DT^LRU W Y
23 W !,LR("%") Q
24 ;
25H I $D(LR("F")),IOST?1"C".E D M^LRU Q:LR("Q")
26 D F^LRU W !,"LABORATORY SERVICE",!,C(1)," ",C(7)," ",C(8)," CMV ",$S(LRV:"POS",1:"NEG")," units"
27 W !?5,"Unit",?20,"Exp date",?40,!,LR("%") Q
28END D V^LRU Q
Note: See TracBrowser for help on using the repository browser.