- LRBLPED1 ; IHS/DIR/FJE - PEDIATRIC UNIT PREPARATION 2/6/91 09:18 ;
- ;;5.2;LR;;NOV 01, 1997
- ;
- ;;5.2;LAB SERVICE;;Sep 27, 1994
- I $P(LRF,"^",12)=0 W $C(7),!,$P(LRF,"^",2)," Cannot use this unit. Volume=0",!,"Please enter DISGARD in disposition field." Q
- VOL I '$P(LRF,"^",12) S $P(LRF,"^",12)=LRV,$P(^LRD(65,+LRF,0),"^",11)=LRV
- S LRV(2)=$P(LRF,"^",12),X=LRV(2)*LRS,Y=$P(X,".",2)_"000",Z=$P(X,"."),LRG=$S($E(Y,1,3)>499:Z+1,1:Z),(DA,LRX)=+LRF
- W !!,$P(LRF,"^",2),?20,$J($P(LRF,"^",8),2)," ",$P(LRF,"^",9) S Y=$P(LRF,"^",7) D DT^LRU W ?28,Y," Vol(ml): ",LRV(2)," Wt(gm): ",LRG
- A W !?3,"VOL('W' to edit weight, 'V' to edit volume): ",LRV(2),"ml// " R X:DTIME Q:X[U!'$T G:X="" PREP
- I X'="W"&(X'="V") W $C(7),!!,"To change the weight enter an 'E' or to change the volume enter a 'V'",!,"Press 'RETURN' or 'ENTER' key to accept default volume.",! G VOL
- D @X G VOL
- ;
- PREP I LRV(2)<LRV(.6) W !!,$C(7),"Volume of unit is below ",LRV(.6)," ml.",!,"Do you still want to use it " S %=2 D YN^LRU Q:%'=1
- R !!,"Enter volume(ml) for pediatric unit: ",X:DTIME Q:X=""!(X[U) I X<1!(X>LRV(.4))!(X[".")!(X>LRV(2)) W $C(7),!!,"Volume must be whole number from 1 to ",$S(X>LRV(2):LRV(2),1:LRV(.4)) G PREP
- S LRV(1)=X,A=$P(LRF,"^",2)_"P" F B=65:1:91 S LRI=A_$C(B) Q:'$D(^LRD(65,"B",LRI)) S Z=1 D CK Q:Z
- I B=91 W $C(7),"Sorry, the limit is 26 pediatric units from ",$P(LRF,"^",2),"." Q
- S LRABO=$P(LRF,"^",8),LRRH=$P(LRF,"^",9) W !!,LRI," ",LRABO," ",LRRH," vol(ml):",LRV(1)
- DATE S %DT="AETX",%DT("A")="Expiration date: ",%DT(0)="N" D ^%DT K %DT Q:Y<1 I Y>LRE W $C(7),!?3,"Cannot exceed expiration date of selected unit." G DATE
- S LRE(1)=Y I LR(66,.135) S %DT="T",X="N" D ^%DT S (LRO(2),X1)=Y,X2=LR(66,.135) D C^%DTC I X>LRO(2),LRE(1)>X W $C(7),!?3,"Exceeds allowable expiration date" G DATE
- W !!,"OK to process pediatric unit " S %=2 D YN^LRU Q:%'=1
- D DT^LRBLU G ^LRBLPED2
- CK F C=0:0 S C=$O(^LRD(65,"B",LRI,C)) Q:'C I $P(^LRD(65,C,0),"^",4)=LRP S Z=0 Q
- Q
- W R !,"Enter corrected weight in grams: ",X:DTIME Q:X=""!(X[U) I X<1!(X>500)!(X[".") W !,$C(7),"Enter a whole number from 1 to 500" G W
- S X=X/LRS,Y=$P(X,".",2)_"000",Z=$P(X,"."),X=$S($E(Y,1,3)>499:Z+1,1:Z)
- S LRV=X,$P(LRF,"^",12)="" I X'=LRV(2) S O=LRV(2),Z="65,.11" D EN^LRUD
- Q
- V R !,"Enter corrected volume in ml: ",X:DTIME Q:X=""!(X[U) I X<1!(X>500)!(X[".") W !,$C(7),"Enter a whole number from 1 to 500" G V
- S LRV=X,$P(LRF,"^",12)="" I X'=LRV(2) S O=LRV(2),Z="65,.11" D EN^LRUD
- Q
- LRBLPED1 ; IHS/DIR/FJE - PEDIATRIC UNIT PREPARATION 2/6/91 09:18 ;
- +1 ;;5.2;LR;;NOV 01, 1997
- +2 ;
- +3 ;;5.2;LAB SERVICE;;Sep 27, 1994
- +4 IF $PIECE(LRF,"^",12)=0
- WRITE $CHAR(7),!,$PIECE(LRF,"^",2)," Cannot use this unit. Volume=0",!,"Please enter DISGARD in disposition field."
- QUIT
- VOL IF '$PIECE(LRF,"^",12)
- SET $PIECE(LRF,"^",12)=LRV
- SET $PIECE(^LRD(65,+LRF,0),"^",11)=LRV
- +1 SET LRV(2)=$PIECE(LRF,"^",12)
- SET X=LRV(2)*LRS
- SET Y=$PIECE(X,".",2)_"000"
- SET Z=$PIECE(X,".")
- SET LRG=$SELECT($EXTRACT(Y,1,3)>499:Z+1,1:Z)
- SET (DA,LRX)=+LRF
- +2 WRITE !!,$PIECE(LRF,"^",2),?20,$JUSTIFY($PIECE(LRF,"^",8),2)," ",$PIECE(LRF,"^",9)
- SET Y=$PIECE(LRF,"^",7)
- DO DT^LRU
- WRITE ?28,Y," Vol(ml): ",LRV(2)," Wt(gm): ",LRG
- A WRITE !?3,"VOL('W' to edit weight, 'V' to edit volume): ",LRV(2),"ml// "
- READ X:DTIME
- IF X[U!'$TEST
- QUIT
- IF X=""
- GOTO PREP
- +1 IF X'="W"&(X'="V")
- WRITE $CHAR(7),!!,"To change the weight enter an 'E' or to change the volume enter a 'V'",!,"Press 'RETURN' or 'ENTER' key to accept default volume.",!
- GOTO VOL
- +2 DO @X
- GOTO VOL
- +3 ;
- PREP IF LRV(2)<LRV(.6)
- WRITE !!,$CHAR(7),"Volume of unit is below ",LRV(.6)," ml.",!,"Do you still want to use it "
- SET %=2
- DO YN^LRU
- IF %'=1
- QUIT
- +1 READ !!,"Enter volume(ml) for pediatric unit: ",X:DTIME
- IF X=""!(X[U)
- QUIT
- IF X<1!(X>LRV(.4))!(X[".")!(X>LRV(2))
- WRITE $CHAR(7),!!,"Volume must be whole number from 1 to ",$SELECT(X>LRV(2):LRV(2),1:LRV(.4))
- GOTO PREP
- +2 SET LRV(1)=X
- SET A=$PIECE(LRF,"^",2)_"P"
- FOR B=65:1:91
- SET LRI=A_$CHAR(B)
- IF '$DATA(^LRD(65,"B",LRI))
- QUIT
- SET Z=1
- DO CK
- IF Z
- QUIT
- +3 IF B=91
- WRITE $CHAR(7),"Sorry, the limit is 26 pediatric units from ",$PIECE(LRF,"^",2),"."
- QUIT
- +4 SET LRABO=$PIECE(LRF,"^",8)
- SET LRRH=$PIECE(LRF,"^",9)
- WRITE !!,LRI," ",LRABO," ",LRRH," vol(ml):",LRV(1)
- DATE SET %DT="AETX"
- SET %DT("A")="Expiration date: "
- SET %DT(0)="N"
- DO ^%DT
- KILL %DT
- IF Y<1
- QUIT
- IF Y>LRE
- WRITE $CHAR(7),!?3,"Cannot exceed expiration date of selected unit."
- GOTO DATE
- +1 SET LRE(1)=Y
- IF LR(66,.135)
- SET %DT="T"
- SET X="N"
- DO ^%DT
- SET (LRO(2),X1)=Y
- SET X2=LR(66,.135)
- DO C^%DTC
- IF X>LRO(2)
- IF LRE(1)>X
- WRITE $CHAR(7),!?3,"Exceeds allowable expiration date"
- GOTO DATE
- +2 WRITE !!,"OK to process pediatric unit "
- SET %=2
- DO YN^LRU
- IF %'=1
- QUIT
- +3 DO DT^LRBLU
- GOTO ^LRBLPED2
- CK FOR C=0:0
- SET C=$ORDER(^LRD(65,"B",LRI,C))
- IF 'C
- QUIT
- IF $PIECE(^LRD(65,C,0),"^",4)=LRP
- SET Z=0
- QUIT
- +1 QUIT
- W READ !,"Enter corrected weight in grams: ",X:DTIME
- IF X=""!(X[U)
- QUIT
- IF X<1!(X>500)!(X[".")
- WRITE !,$CHAR(7),"Enter a whole number from 1 to 500"
- GOTO W
- +1 SET X=X/LRS
- SET Y=$PIECE(X,".",2)_"000"
- SET Z=$PIECE(X,".")
- SET X=$SELECT($EXTRACT(Y,1,3)>499:Z+1,1:Z)
- +2 SET LRV=X
- SET $PIECE(LRF,"^",12)=""
- IF X'=LRV(2)
- SET O=LRV(2)
- SET Z="65,.11"
- DO EN^LRUD
- +3 QUIT
- V READ !,"Enter corrected volume in ml: ",X:DTIME
- IF X=""!(X[U)
- QUIT
- IF X<1!(X>500)!(X[".")
- WRITE !,$CHAR(7),"Enter a whole number from 1 to 500"
- GOTO V
- +1 SET LRV=X
- SET $PIECE(LRF,"^",12)=""
- IF X'=LRV(2)
- SET O=LRV(2)
- SET Z="65,.11"
- DO EN^LRUD
- +2 QUIT
