31 lines
2.0 KiB
Mathematica
31 lines
2.0 KiB
Mathematica
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
|