SROBLOD ;B'HAM ISC/MAM - SAFETY STRAP, REQUESTED BLOOD ; 30 DEC 1991 10:15 AM
;;3.0; Surgery ;**34,109**;24 Jun 93
S ^SRF(SRTN,42,0)="^130.065P^1^1",^SRF(SRTN,42,1,0)=1
K DR S DR=".13///SAFETY STRAP",DR(2,130.31)=.01,DIE=130,DA=SRTN D ^DIE K DR
S BLOOD="N",CROSSM=""
ASK W ! K DIR,SRT S DIR("A")="Request Blood Availability (Y/N)",DIR("B")="N",DIR(0)="130,38" D ^DIR I X="^"!$D(DTOUT) S:$D(DTOUT) SRT=1 S:$D(DUOUT) SRDUOUT=1 Q
S BLOOD=Y I BLOOD="N" D DIE Q
TYPE W ! K DIR S DIR("A")="Type and Crossmatch, Screen, or Autologous",DIR("B")="TYPE & CROSSMATCH",DIR(0)="130,40" D ^DIR I X="^"!$D(DTOUT) S:$D(DTOUT) SRT=1 S:$D(DUOUT) SRDUOUT=1 Q
I X["^" G TYPE
S CROSSM=Y D DIE I CROSSM'="T" Q
;S SRBLOOD=$P(^SRO(133,SRSITE,0),"^",9) I SRBLOOD'="" K DR S DR="1.05///"_$P(^LAB(66,$P(^SRO(133,SRSITE,0),"^",9),0),U),DR(2,130.14)=.01,DIE=130,DA=SRTN D ^DIE K DR,SRTDLB
;S SRBLOOD=$P($G(^SRO(133,SRSITE,7)),"^") I SRBLOOD'="" K DR S DR="1.05///"_SRBLOOD,DR(2,130.14)=.01,DIE=130,DA=SRTN D ^DIE K DR,SRTDLB ;RLM
S SRBLOOD=$P($G(^SRO(133,SRSITE,7)),"^")
I SRBLOOD'="" D
. N DO,DR,DA,DIC,X S DIC="^SRF("_SRTN_",11,",DA=SRTN,DIC(0)="L",X=SRBLOOD D FILE^DICN
K DR,DIE,DA S DIE=130,DA=SRTN,DR="1.05",DR(2,130.14)=".01T;1T" D ^DIE K DR,DIE,DA I $D(DTOUT)!$D(Y) S:$D(DTOUT) SRT=1 S:$D(Y) SRDUOUT=1
Q
DIE K DR,DA,DIE S DR="38////"_BLOOD_";40////"_CROSSM,DA=SRTN,DIE=130 D ^DIE K DA,DR,DIE
Q
PRINT ; print blood request on schedule
I '$D(S(0)) S S(0)=^SRF(SRTN,0)
I $O(^SRF(SRTN,11,0)) S $P(^SRF(SRTN,0),"^",6)="Y",$P(S(0),"^",6)="Y"
S BLOOD=$P(S(0),"^",6) I BLOOD'="Y" Q
S TYPE=$P(S(0),"^",13),TYPE=$S(TYPE="T":"TYPE & CROSSMATCH",TYPE="S":"SCREEN",TYPE="A":"AUTOLOGOUS",1:"")
W ?24,"REQUESTED BLOOD COMPONENTS: "_TYPE S BLOOD=0 F S BLOOD=$O(^SRF(SRTN,11,BLOOD)) Q:BLOOD="" D BLOOD
Q
BLOOD ; print blood kind & units
S (B,SRB)=$P(^SRF(SRTN,11,BLOOD,0),"^"),SRBU=$P(^(0),"^",2) ;,SRB=$P(^LAB(66,B,0),"^") ;RLM
S SRBU=$S(SRBU>1:SRBU_" UNITS",SRBU>0:SRBU_" UNIT",SRBU=0:SRBU_" UNITS",1:"UNITS NOT ENTERED") W !,?24,SRB_" - "_SRBU
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSROBLOD 2067 printed Dec 13, 2024@02:42:28 Page 2
SROBLOD ;B'HAM ISC/MAM - SAFETY STRAP, REQUESTED BLOOD ; 30 DEC 1991 10:15 AM
+1 ;;3.0; Surgery ;**34,109**;24 Jun 93
+2 SET ^SRF(SRTN,42,0)="^130.065P^1^1"
SET ^SRF(SRTN,42,1,0)=1
+3 KILL DR
SET DR=".13///SAFETY STRAP"
SET DR(2,130.31)=.01
SET DIE=130
SET DA=SRTN
DO ^DIE
KILL DR
+4 SET BLOOD="N"
SET CROSSM=""
ASK WRITE !
KILL DIR,SRT
SET DIR("A")="Request Blood Availability (Y/N)"
SET DIR("B")="N"
SET DIR(0)="130,38"
DO ^DIR
IF X="^"!$DATA(DTOUT)
if $DATA(DTOUT)
SET SRT=1
if $DATA(DUOUT)
SET SRDUOUT=1
QUIT
+1 SET BLOOD=Y
IF BLOOD="N"
DO DIE
QUIT
TYPE WRITE !
KILL DIR
SET DIR("A")="Type and Crossmatch, Screen, or Autologous"
SET DIR("B")="TYPE & CROSSMATCH"
SET DIR(0)="130,40"
DO ^DIR
IF X="^"!$DATA(DTOUT)
if $DATA(DTOUT)
SET SRT=1
if $DATA(DUOUT)
SET SRDUOUT=1
QUIT
+1 IF X["^"
GOTO TYPE
+2 SET CROSSM=Y
DO DIE
IF CROSSM'="T"
QUIT
+3 ;S SRBLOOD=$P(^SRO(133,SRSITE,0),"^",9) I SRBLOOD'="" K DR S DR="1.05///"_$P(^LAB(66,$P(^SRO(133,SRSITE,0),"^",9),0),U),DR(2,130.14)=.01,DIE=130,DA=SRTN D ^DIE K DR,SRTDLB
+4 ;S SRBLOOD=$P($G(^SRO(133,SRSITE,7)),"^") I SRBLOOD'="" K DR S DR="1.05///"_SRBLOOD,DR(2,130.14)=.01,DIE=130,DA=SRTN D ^DIE K DR,SRTDLB ;RLM
+5 SET SRBLOOD=$PIECE($GET(^SRO(133,SRSITE,7)),"^")
+6 IF SRBLOOD'=""
Begin DoDot:1
+7 NEW DO,DR,DA,DIC,X
SET DIC="^SRF("_SRTN_",11,"
SET DA=SRTN
SET DIC(0)="L"
SET X=SRBLOOD
DO FILE^DICN
End DoDot:1
+8 KILL DR,DIE,DA
SET DIE=130
SET DA=SRTN
SET DR="1.05"
SET DR(2,130.14)=".01T;1T"
DO ^DIE
KILL DR,DIE,DA
IF $DATA(DTOUT)!$DATA(Y)
if $DATA(DTOUT)
SET SRT=1
if $DATA(Y)
SET SRDUOUT=1
+9 QUIT
DIE KILL DR,DA,DIE
SET DR="38////"_BLOOD_";40////"_CROSSM
SET DA=SRTN
SET DIE=130
DO ^DIE
KILL DA,DR,DIE
+1 QUIT
PRINT ; print blood request on schedule
+1 IF '$DATA(S(0))
SET S(0)=^SRF(SRTN,0)
+2 IF $ORDER(^SRF(SRTN,11,0))
SET $PIECE(^SRF(SRTN,0),"^",6)="Y"
SET $PIECE(S(0),"^",6)="Y"
+3 SET BLOOD=$PIECE(S(0),"^",6)
IF BLOOD'="Y"
QUIT
+4 SET TYPE=$PIECE(S(0),"^",13)
SET TYPE=$SELECT(TYPE="T":"TYPE & CROSSMATCH",TYPE="S":"SCREEN",TYPE="A":"AUTOLOGOUS",1:"")
+5 WRITE ?24,"REQUESTED BLOOD COMPONENTS: "_TYPE
SET BLOOD=0
FOR
SET BLOOD=$ORDER(^SRF(SRTN,11,BLOOD))
if BLOOD=""
QUIT
DO BLOOD
+6 QUIT
BLOOD ; print blood kind & units
+1 ;,SRB=$P(^LAB(66,B,0),"^") ;RLM
SET (B,SRB)=$PIECE(^SRF(SRTN,11,BLOOD,0),"^")
SET SRBU=$PIECE(^(0),"^",2)
+2 SET SRBU=$SELECT(SRBU>1:SRBU_" UNITS",SRBU>0:SRBU_" UNIT",SRBU=0:SRBU_" UNITS",1:"UNITS NOT ENTERED")
WRITE !,?24,SRB_" - "_SRBU
+3 QUIT
