LRBLAGG ;AVAMC/REG - BLOOD BANK AGGLUTINATION STRENGTH ;3/9/94 10:29 ;
;;5.2;LAB SERVICE;**247**;Sep 27, 1994
;Per VHA Directive 97-033 this routine should not be modified. Medical Device # BK970021
I X'?.ANP!($L(X)<1)!($L(X)>5) K X Q
S Y=$O(^LAB(62.55,"B",X,0)) I Y,$D(^LAB(62.55,Y,0)) S X(2)=^(0),X=$P(X(2),"^") W " ",X," ",$P(X(2),"^",2) Q
S:$D(DIC) LRTDIC=DIC S:$D(DIC(0)) LRTDIC(0)=DIC(0)
S DIC="^LAB(62.55,",DIC(0)="EQMZ" D ^DIC K DIC S:Y'=-1 X=$P(Y(0),"^") I Y=-1!(X["^") K X
END S:$D(LRTDIC) DIC=LRTDIC S:$D(LRTDIC(0)) DIC(0)=LRTDIC(0) K LRTDIC,LRTDIC(0) Q
OUT S %Y="",X=$O(^LAB(62.55,"B",Y,0)) Q:'X I $D(^LAB(62.55,X,0)) S %Y="("_$P(^(0),"^",2)_")" Q
LST ;
W "CHOOSE FROM:" S X=0 F A=0:0 S X=$O(^LAB(62.55,"B",X)) Q:X="" F Y=0:0 S Y=$O(^LAB(62.55,"B",X,Y)) Q:'Y I $D(^LAB(62.55,Y,0)) W !,X," ",$P(^(0),U,2) I $Y#21=0 R !,"'^' TO STOP: ",%Y:DTIME G:%Y[U END D STOP
Q
STOP W $C(13),$J("",15),$C(13) Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRBLAGG 935 printed Dec 13, 2024@02:10:13 Page 2
LRBLAGG ;AVAMC/REG - BLOOD BANK AGGLUTINATION STRENGTH ;3/9/94 10:29 ;
+1 ;;5.2;LAB SERVICE;**247**;Sep 27, 1994
+2 ;Per VHA Directive 97-033 this routine should not be modified. Medical Device # BK970021
+3 IF X'?.ANP!($LENGTH(X)<1)!($LENGTH(X)>5)
KILL X
QUIT
+4 SET Y=$ORDER(^LAB(62.55,"B",X,0))
IF Y
IF $DATA(^LAB(62.55,Y,0))
SET X(2)=^(0)
SET X=$PIECE(X(2),"^")
WRITE " ",X," ",$PIECE(X(2),"^",2)
QUIT
+5 if $DATA(DIC)
SET LRTDIC=DIC
if $DATA(DIC(0))
SET LRTDIC(0)=DIC(0)
+6 SET DIC="^LAB(62.55,"
SET DIC(0)="EQMZ"
DO ^DIC
KILL DIC
if Y'=-1
SET X=$PIECE(Y(0),"^")
IF Y=-1!(X["^")
KILL X
END if $DATA(LRTDIC)
SET DIC=LRTDIC
if $DATA(LRTDIC(0))
SET DIC(0)=LRTDIC(0)
KILL LRTDIC,LRTDIC(0)
QUIT
OUT SET %Y=""
SET X=$ORDER(^LAB(62.55,"B",Y,0))
if 'X
QUIT
IF $DATA(^LAB(62.55,X,0))
SET %Y="("_$PIECE(^(0),"^",2)_")"
QUIT
LST ;
+1 WRITE "CHOOSE FROM:"
SET X=0
FOR A=0:0
SET X=$ORDER(^LAB(62.55,"B",X))
if X=""
QUIT
FOR Y=0:0
SET Y=$ORDER(^LAB(62.55,"B",X,Y))
if 'Y
QUIT
IF $DATA(^LAB(62.55,Y,0))
WRITE !,X," ",$PIECE(^(0),U,2)
IF $Y#21=0
READ !,"'^' TO STOP: ",%Y:DTIME
if %Y[U
GOTO END
DO STOP
+2 QUIT
STOP WRITE $CHAR(13),$JUSTIFY("",15),$CHAR(13)
QUIT
