- LRBLQST ; IHS/DIR/AAB - SINGLE UNIT STATUS 8/1/95 08:46 ;
- ;;5.2;LR;**1002**;JUN 01, 1998
- ;;5.2;LAB SERVICE;**72**;Sep 27, 1994
- D V^LRU S IOP="HOME" D ^%ZIS
- W !!?20,"Current status of a unit in inventory file" S LRC=$P(^DD(65,4.1,0),U,3),LRT=$P(^DD(65,8.1,0),U,3),LRD=$P(^DD(65,8.3,0),U,3)
- ASK W !! S DIC=65,DIC(0)="AEQMZ" D ^DIC K DIC G:Y<1 END W !,"Is this the unit " S %=1 D YN^LRU G:%'=1 ASK S LRA=+Y
- W @IOF,"Unit #:",$P(Y(0),"^"),?25,"Component:" S X=$P(Y(0),"^",4) W $S('X:"??",$D(^LAB(66,X,0)):$P(^(0),"^"),1:"??") W:$P($G(^LAB(69.9,1,8.1,+DUZ(2),0)),U,6) !,$P($G(^DIC(4,+$P(Y(0),U,16),0)),U)
- W !!,"Expiration date:" S Y=$P(Y(0),"^",6) D D^LRU W Y,?40,"ABO:",$P(Y(0),"^",7),?50,"Rh:",$P(Y(0),"^",8)
- I $D(^LRD(65,LRA,4)) S LRB=^(4),X=$P(LRB,"^") I X]"" S Y=$P(LRB,"^",2) D D^LRU W !!,"Disposition date:",Y,?40,"Disposition:",$P($P(LRC,X_":",2),";")
- I $D(^LRD(65,LRA,8)) S X=^(8),Y=+X,W(2)=$P(X,"^",2),W(3)=$P(X,"^",3) D:Y AU I W(2)]""!(W(3)]"") W ! W:W(2)]"" "Positive screening tests:",$P($P(LRT,W(2)_":",2),";") W:W(3)]"" ?40,"Donation type:",$P($P(LRD,W(3)_":",2),";")
- ;W !! F X=0:0 S X=$O(^LRD(65,LRA,2,X)) Q:'X S Z=^(X,0) I $P(Z,"^",2) S V=^LR(+Z,0),(LRDPF,W)=$P(V,"^",2),Y=$P(V,"^",3),W=^DIC(W,0,"GL"),W=@(W_Y_",0)"),Y=$P(Z,"^",2) D D^LRU,W
- W !! F X=0:0 S X=$O(^LRD(65,LRA,2,X)) Q:'X S Z=^(X,0) I $P(Z,"^",2) S V=^LR(+Z,0),(LRDPF,W)=$P(V,"^",2),(DFN,Y)=$P(V,"^",3),W=^DIC(W,0,"GL"),W=@(W_Y_",0)"),Y=$P(Z,"^",2) D D^LRU,W ;IHS/ANMC/CLS 11/1/95
- S X=$O(^LRD(65,LRA,3,0)) I X S L=^LRD(65,LRA,3,X,0),Y=+L D D^LRU W !!,"Current location:",$P(L,"^",4),!,"Date last located:",Y
- G ASK
- W S SSN=$P(W,"^",9) D SSN^LRU
- ;W !,"Patient:",$P(W,"^")," ",SSN,!?8,"Date assigned:",Y Q
- W !,"Patient:",$P(W,"^")," ",HRCN,!?8,"Date assigned:",Y Q ;IHS/ANMC/CLS 11/1/95
- ;
- AU ;S X=^LR(Y,0),Y=$P(X,"^",3),(LRDPF,X)=$P(X,"^",2),X=^DIC(X,0,"GL"),Y=@(X_Y_",0)") S SSN=$P(Y,"^",9) D SSN^LRU W !,"Restricted for: ",$P(Y,"^")," ",SSN Q
- S X=^LR(Y,0),(DFN,Y)=$P(X,"^",3),(LRDPF,X)=$P(X,"^",2),X=^DIC(X,0,"GL"),Y=@(X_Y_",0)") S SSN=$P(Y,"^",9) D SSN^LRU W !,"Restricted for: ",$P(Y,"^")," ",HRCN Q ;IHS/ANMC/CLS 11/1/95
- END D V^LRU Q
- LRBLQST ; IHS/DIR/AAB - SINGLE UNIT STATUS 8/1/95 08:46 ;
- +1 ;;5.2;LR;**1002**;JUN 01, 1998
- +2 ;;5.2;LAB SERVICE;**72**;Sep 27, 1994
- +3 DO V^LRU
- SET IOP="HOME"
- DO ^%ZIS
- +4 WRITE !!?20,"Current status of a unit in inventory file"
- SET LRC=$PIECE(^DD(65,4.1,0),U,3)
- SET LRT=$PIECE(^DD(65,8.1,0),U,3)
- SET LRD=$PIECE(^DD(65,8.3,0),U,3)
- ASK WRITE !!
- SET DIC=65
- SET DIC(0)="AEQMZ"
- DO ^DIC
- KILL DIC
- IF Y<1
- GOTO END
- WRITE !,"Is this the unit "
- SET %=1
- DO YN^LRU
- IF %'=1
- GOTO ASK
- SET LRA=+Y
- +1 WRITE @IOF,"Unit #:",$PIECE(Y(0),"^"),?25,"Component:"
- SET X=$PIECE(Y(0),"^",4)
- WRITE $SELECT('X:"??",$DATA(^LAB(66,X,0)):$PIECE(^(0),"^"),1:"??")
- IF $PIECE($GET(^LAB(69.9,1,8.1,+DUZ(2),0)),U,6)
- WRITE !,$PIECE($GET(^DIC(4,+$PIECE(Y(0),U,16),0)),U)
- +2 WRITE !!,"Expiration date:"
- SET Y=$PIECE(Y(0),"^",6)
- DO D^LRU
- WRITE Y,?40,"ABO:",$PIECE(Y(0),"^",7),?50,"Rh:",$PIECE(Y(0),"^",8)
- +3 IF $DATA(^LRD(65,LRA,4))
- SET LRB=^(4)
- SET X=$PIECE(LRB,"^")
- IF X]""
- SET Y=$PIECE(LRB,"^",2)
- DO D^LRU
- WRITE !!,"Disposition date:",Y,?40,"Disposition:",$PIECE($PIECE(LRC,X_":",2),";")
- +4 IF $DATA(^LRD(65,LRA,8))
- SET X=^(8)
- SET Y=+X
- SET W(2)=$PIECE(X,"^",2)
- SET W(3)=$PIECE(X,"^",3)
- IF Y
- DO AU
- IF W(2)]""!(W(3)]"")
- WRITE !
- IF W(2)]""
- WRITE "Positive screening tests:",$PIECE($PIECE(LRT,W(2)_":",2),";")
- IF W(3)]""
- WRITE ?40,"Donation type:",$PIECE($PIECE(LRD,W(3)_":",2),";")
- +5 ;W !! F X=0:0 S X=$O(^LRD(65,LRA,2,X)) Q:'X S Z=^(X,0) I $P(Z,"^",2) S V=^LR(+Z,0),(LRDPF,W)=$P(V,"^",2),Y=$P(V,"^",3),W=^DIC(W,0,"GL"),W=@(W_Y_",0)"),Y=$P(Z,"^",2) D D^LRU,W
- +6 ;IHS/ANMC/CLS 11/1/95
- WRITE !!
- FOR X=0:0
- SET X=$ORDER(^LRD(65,LRA,2,X))
- IF 'X
- QUIT
- SET Z=^(X,0)
- IF $PIECE(Z,"^",2)
- SET V=^LR(+Z,0)
- SET (LRDPF,W)=$PIECE(V,"^",2)
- SET (DFN,Y)=$PIECE(V,"^",3)
- SET W=^DIC(W,0,"GL")
- SET W=@(W_Y_",0)")
- SET Y=$PIECE(Z,"^",2)
- DO D^LRU
- DO W
- +7 SET X=$ORDER(^LRD(65,LRA,3,0))
- IF X
- SET L=^LRD(65,LRA,3,X,0)
- SET Y=+L
- DO D^LRU
- WRITE !!,"Current location:",$PIECE(L,"^",4),!,"Date last located:",Y
- +8 GOTO ASK
- W SET SSN=$PIECE(W,"^",9)
- DO SSN^LRU
- +1 ;W !,"Patient:",$P(W,"^")," ",SSN,!?8,"Date assigned:",Y Q
- +2 ;IHS/ANMC/CLS 11/1/95
- WRITE !,"Patient:",$PIECE(W,"^")," ",HRCN,!?8,"Date assigned:",Y
- QUIT
- +3 ;
- AU ;S X=^LR(Y,0),Y=$P(X,"^",3),(LRDPF,X)=$P(X,"^",2),X=^DIC(X,0,"GL"),Y=@(X_Y_",0)") S SSN=$P(Y,"^",9) D SSN^LRU W !,"Restricted for: ",$P(Y,"^")," ",SSN Q
- +1 ;IHS/ANMC/CLS 11/1/95
- SET X=^LR(Y,0)
- SET (DFN,Y)=$PIECE(X,"^",3)
- SET (LRDPF,X)=$PIECE(X,"^",2)
- SET X=^DIC(X,0,"GL")
- SET Y=@(X_Y_",0)")
- SET SSN=$PIECE(Y,"^",9)
- DO SSN^LRU
- WRITE !,"Restricted for: ",$PIECE(Y,"^")," ",HRCN
- QUIT
- END DO V^LRU
- QUIT