- LRBLPUS2 ; IHS/DIR/AAB - PATIENT UNIT SELECTION 11/12/96 09:51 ;
- ;;5.2;LR;**1002**;JUN 01, 1998
- ;;5.2;LAB SERVICE;**139**;Sep 27, 1994
- S X=$P(F,"^",7)_"000" D H^%DTC S O(1)=%H,O(2)=$S(X'[".":0,1:$E(X,9,10)*60+$E(X,11,12))
- S X="N",%DT="T" D ^%DT K %DT S X=Y_"000" D H^%DTC S H(1)=%H,H(2)=$E(X,9,10)*60+$E(X,11,12)
- S L=O(1)-H(1) I 'O(2) W !,$P(F,"^",2)," EXPIRE" W:L>0 "S IN ",L,$S(L>1:" DAYS",1:" DAY") W:'L&'(O(2)) "S TODAY" I L<0 W $C(7),"D ",-1*L,$S(L=-1:" DAY",1:" DAYS")," AGO !",! Q
- I O(2) D T Q:'$D(L)
- S I=+F F A=0:0 S A=$O(^LRD(65,I,2,A)) Q:'A I $D(^LRD(65,"AP",A,I)) S X=^LR(A,0),Y=$P(X,U,3),X=$P(X,U,2),X=^DIC(X,0,"GL"),N=@(X_Y_",0)") W !,"Assigned/xmatched to ",$P(N,U,1)," ",$P(N,U,9)
- ;W !!,"UNIT OK for ",LRP," ",SSN," " S %=1 D YN^LRU Q:%'=1 L -^LRD(65,I)
- W !!,"UNIT OK for ",LRP," ",HRCN," " S %=1 D YN^LRU Q:%'=1 L -^LRD(65,I) ;IHS/ANMC/CLS 11/1/95
- S:$D(G(1)) LRI(1)=$O(^LRO(68,LRAA,1,G(1),1,G(3),4,0))
- I $D(G(1)),$S($D(^LRO(68,LRAA,1,G(1),1,G(3),4,LRI,0)):1,$D(^LRO(68,LRAA,1,G(1),1,G(3),4,+LRI(1),0)):1,1:0) S X=^(0),^(0)=$P(X,"^")_"^"_$P(X,"^",2)_"^"_$P(X,"^",3)_"^"_DUZ_"^"_DT,$P(^LR(LRDFN,LRSS,$P(G,"^",2),0),"^",3)=DT D ORD K G(1)
- L +^LRD(65,I,2) S:'$D(^LRD(65,I,2,0)) ^(0)="^65.01IA^^" I '$D(^(LRDFN,0)) S ^(0)=LRDFN,X=^LRD(65,I,2,0),^(0)="^65.01IA^"_LRDFN_"^"_($P(X,"^",4)+1)
- L -^LRD(65,I,2) I 'C(9)!(C(9)=2&('$D(G))) G END
- L +^LRD(65,I,2) S:'$D(^LRD(65,I,2,LRDFN,1,0)) ^(0)="^65.02DA^^" S X=$P(G,"^",2)
- I '$D(^LRD(65,I,2,LRDFN,1,X)) S ^(X,0)=+G_"^"_LRS_"^"_LRMD_"^^^"_$P(G,"^",3)_"^"_LRS(1)_"^"_LRMD(1),Y=^LRD(65,I,2,LRDFN,1,0),^(0)="^65.02DA^"_X_"^"_($P(Y,"^",4)+1),^LRD(65,I,2,LRDFN,1,"B",+G,X)=""
- L -^LRD(65,I,2) I C(9)'=1 G END
- L +^LR(LRDFN,1.8) S:'$D(^LR(LRDFN,1.8,0)) ^(0)="^63.084PA^^" I '$D(^LR(LRDFN,1.8,C,0)) S ^(0)=C,Y=^LR(LRDFN,1.8,0),^(0)="^63.084PA^"_C_"^"_($P(Y,"^",4)+1)
- S:'$D(^LR(LRDFN,1.8,C,1,0)) ^(0)="^63.0841PA^^" I '$D(^(I,0)) S ^(0)=I_"^"_X,Y=^LR(LRDFN,1.8,C,1,0),^(0)="^63.0841PA^"_I_"^"_($P(Y,"^",4)+1)
- L -^LR(LRDFN,1.8) Q
- ;
- T S M=O(2)-H(2) S:M<0 L=L-1,O(2)=O(2)+1440,M=O(2)-H(2) S H=M\60,M=M#60 W ! W:L>0 L," DAY",$S(L=1:" ",1:"S ")
- I L>-1 W:H>0 H," HOUR",$S(H=1:" ",1:"S ") W:M>0 M," MINUTE",$S(M=1:" ",1:"S ") W:(H+M)>0 " LEFT" Q
- W !,$C(7),"UNIT EXPIRED ",-1*L,$S(-1*L:" DAY(S) ",1:" "),H," HOUR(S) ",M," MINUTE(S) AGO" K L Q
- ;
- ORD S Y=^LRO(68,LRAA,1,G(1),1,G(3),0),Y(4)=$P(Y,"^",4),Y(5)=$P(Y,"^",5) I Y(4),Y(5),$D(^LRO(69,Y(4),1,Y(5),3)) S $P(^(3),"^",2)=DT
- Q
- ;
- END S DIE="^LRD(65,I,2,",DA=LRDFN,DA(1)=I,DR=".02///NOW;S X(1)=X" D ^DIE K DIE,DR,DA S X=^LRD(65,I,0),Y(7)=$P(X,"^",7),Y(8)=$P(X,"^",8),Y=X(1) D DT^LRU
- ;S Y(1)=$P(X,"^")_"^"_LRP_" "_SSN_"^"_"Patient "_LRPABO_" "_LRPRH_" "_Y_"^"_"Unit "_Y(7)_" "_Y(8)_" # "_$P(X,"^")_" "_LRWHO_"^"_"NO CROSSMATCH REQUIRED"
- S Y(1)=$P(X,"^")_"^"_LRP_" "_HRCN_"^"_"Patient "_LRPABO_" "_LRPRH_" "_Y_"^"_"Unit "_Y(7)_" "_Y(8)_" # "_$P(X,"^")_" "_LRWHO_"^"_"NO CROSSMATCH REQUIRED" ;IHS/ANMC/CLS 11/1/95
- D EN^LRBLPX Q
- LRBLPUS2 ; IHS/DIR/AAB - PATIENT UNIT SELECTION 11/12/96 09:51 ;
- +1 ;;5.2;LR;**1002**;JUN 01, 1998
- +2 ;;5.2;LAB SERVICE;**139**;Sep 27, 1994
- +3 SET X=$PIECE(F,"^",7)_"000"
- DO H^%DTC
- SET O(1)=%H
- SET O(2)=$SELECT(X'[".":0,1:$EXTRACT(X,9,10)*60+$EXTRACT(X,11,12))
- +4 SET X="N"
- SET %DT="T"
- DO ^%DT
- KILL %DT
- SET X=Y_"000"
- DO H^%DTC
- SET H(1)=%H
- SET H(2)=$EXTRACT(X,9,10)*60+$EXTRACT(X,11,12)
- +5 SET L=O(1)-H(1)
- IF 'O(2)
- WRITE !,$PIECE(F,"^",2)," EXPIRE"
- IF L>0
- WRITE "S IN ",L,$SELECT(L>1:" DAYS",1:" DAY")
- IF 'L&'(O(2))
- WRITE "S TODAY"
- IF L<0
- WRITE $CHAR(7),"D ",-1*L,$SELECT(L=-1:" DAY",1:" DAYS")," AGO !",!
- QUIT
- +6 IF O(2)
- DO T
- IF '$DATA(L)
- QUIT
- +7 SET I=+F
- FOR A=0:0
- SET A=$ORDER(^LRD(65,I,2,A))
- IF 'A
- QUIT
- IF $DATA(^LRD(65,"AP",A,I))
- SET X=^LR(A,0)
- SET Y=$PIECE(X,U,3)
- SET X=$PIECE(X,U,2)
- SET X=^DIC(X,0,"GL")
- SET N=@(X_Y_",0)")
- WRITE !,"Assigned/xmatched to ",$PIECE(N,U,1)," ",$PIECE(N,U,9)
- +8 ;W !!,"UNIT OK for ",LRP," ",SSN," " S %=1 D YN^LRU Q:%'=1 L -^LRD(65,I)
- +9 ;IHS/ANMC/CLS 11/1/95
- WRITE !!,"UNIT OK for ",LRP," ",HRCN," "
- SET %=1
- DO YN^LRU
- IF %'=1
- QUIT
- LOCK -^LRD(65,I)
- +10 IF $DATA(G(1))
- SET LRI(1)=$ORDER(^LRO(68,LRAA,1,G(1),1,G(3),4,0))
- +11 IF $DATA(G(1))
- IF $SELECT($DATA(^LRO(68,LRAA,1,G(1),1,G(3),4,LRI,0)):1,$DATA(^LRO(68,LRAA,1,G(1),1,G(3),4,+LRI(1),0)):1,1:0)
- SET X=^(0)
- SET ^(0)=$PIECE(X,"^")_"^"_$PIECE(X,"^",2)_"^"_$PIECE(X,"^",3)_"^"_DUZ_"^"_DT
- SET $PIECE(^LR(LRDFN,LRSS,$PIECE(G,"^",2),0),"^",3)=DT
- DO ORD
- KILL G(1)
- +12 LOCK +^LRD(65,I,2)
- IF '$DATA(^LRD(65,I,2,0))
- SET ^(0)="^65.01IA^^"
- IF '$DATA(^(LRDFN,0))
- SET ^(0)=LRDFN
- SET X=^LRD(65,I,2,0)
- SET ^(0)="^65.01IA^"_LRDFN_"^"_($PIECE(X,"^",4)+1)
- +13 LOCK -^LRD(65,I,2)
- IF 'C(9)!(C(9)=2&('$DATA(G)))
- GOTO END
- +14 LOCK +^LRD(65,I,2)
- IF '$DATA(^LRD(65,I,2,LRDFN,1,0))
- SET ^(0)="^65.02DA^^"
- SET X=$PIECE(G,"^",2)
- +15 IF '$DATA(^LRD(65,I,2,LRDFN,1,X))
- SET ^(X,0)=+G_"^"_LRS_"^"_LRMD_"^^^"_$PIECE(G,"^",3)_"^"_LRS(1)_"^"_LRMD(1)
- SET Y=^LRD(65,I,2,LRDFN,1,0)
- SET ^(0)="^65.02DA^"_X_"^"_($PIECE(Y,"^",4)+1)
- SET ^LRD(65,I,2,LRDFN,1,"B",+G,X)=""
- +16 LOCK -^LRD(65,I,2)
- IF C(9)'=1
- GOTO END
- +17 LOCK +^LR(LRDFN,1.8)
- IF '$DATA(^LR(LRDFN,1.8,0))
- SET ^(0)="^63.084PA^^"
- IF '$DATA(^LR(LRDFN,1.8,C,0))
- SET ^(0)=C
- SET Y=^LR(LRDFN,1.8,0)
- SET ^(0)="^63.084PA^"_C_"^"_($PIECE(Y,"^",4)+1)
- +18 IF '$DATA(^LR(LRDFN,1.8,C,1,0))
- SET ^(0)="^63.0841PA^^"
- IF '$DATA(^(I,0))
- SET ^(0)=I_"^"_X
- SET Y=^LR(LRDFN,1.8,C,1,0)
- SET ^(0)="^63.0841PA^"_I_"^"_($PIECE(Y,"^",4)+1)
- +19 LOCK -^LR(LRDFN,1.8)
- QUIT
- +20 ;
- T SET M=O(2)-H(2)
- IF M<0
- SET L=L-1
- SET O(2)=O(2)+1440
- SET M=O(2)-H(2)
- SET H=M\60
- SET M=M#60
- WRITE !
- IF L>0
- WRITE L," DAY",$SELECT(L=1:" ",1:"S ")
- +1 IF L>-1
- IF H>0
- WRITE H," HOUR",$SELECT(H=1:" ",1:"S ")
- IF M>0
- WRITE M," MINUTE",$SELECT(M=1:" ",1:"S ")
- IF (H+M)>0
- WRITE " LEFT"
- QUIT
- +2 WRITE !,$CHAR(7),"UNIT EXPIRED ",-1*L,$SELECT(-1*L:" DAY(S) ",1:" "),H," HOUR(S) ",M," MINUTE(S) AGO"
- KILL L
- QUIT
- +3 ;
- ORD SET Y=^LRO(68,LRAA,1,G(1),1,G(3),0)
- SET Y(4)=$PIECE(Y,"^",4)
- SET Y(5)=$PIECE(Y,"^",5)
- IF Y(4)
- IF Y(5)
- IF $DATA(^LRO(69,Y(4),1,Y(5),3))
- SET $PIECE(^(3),"^",2)=DT
- +1 QUIT
- +2 ;
- END SET DIE="^LRD(65,I,2,"
- SET DA=LRDFN
- SET DA(1)=I
- SET DR=".02///NOW;S X(1)=X"
- DO ^DIE
- KILL DIE,DR,DA
- SET X=^LRD(65,I,0)
- SET Y(7)=$PIECE(X,"^",7)
- SET Y(8)=$PIECE(X,"^",8)
- SET Y=X(1)
- DO DT^LRU
- +1 ;S Y(1)=$P(X,"^")_"^"_LRP_" "_SSN_"^"_"Patient "_LRPABO_" "_LRPRH_" "_Y_"^"_"Unit "_Y(7)_" "_Y(8)_" # "_$P(X,"^")_" "_LRWHO_"^"_"NO CROSSMATCH REQUIRED"
- +2 ;IHS/ANMC/CLS 11/1/95
- SET Y(1)=$PIECE(X,"^")_"^"_LRP_" "_HRCN_"^"_"Patient "_LRPABO_" "_LRPRH_" "_Y_"^"_"Unit "_Y(7)_" "_Y(8)_" # "_$PIECE(X,"^")_" "_LRWHO_"^"_"NO CROSSMATCH REQUIRED"
- +3 DO EN^LRBLPX
- QUIT
