Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SROBLOD

SROBLOD.m

Go to the documentation of this file.
  1. SROBLOD ;B'HAM ISC/MAM - SAFETY STRAP, REQUESTED BLOOD ; 30 DEC 1991 10:15 AM
  1. ;;3.0; Surgery ;**34,109**;24 Jun 93
  1. S ^SRF(SRTN,42,0)="^130.065P^1^1",^SRF(SRTN,42,1,0)=1
  1. K DR S DR=".13///SAFETY STRAP",DR(2,130.31)=.01,DIE=130,DA=SRTN D ^DIE K DR
  1. S BLOOD="N",CROSSM=""
  1. 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
  1. S BLOOD=Y I BLOOD="N" D DIE Q
  1. 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
  1. I X["^" G TYPE
  1. S CROSSM=Y D DIE I CROSSM'="T" Q
  1. ;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
  1. ;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
  1. S SRBLOOD=$P($G(^SRO(133,SRSITE,7)),"^")
  1. I SRBLOOD'="" D
  1. . N DO,DR,DA,DIC,X S DIC="^SRF("_SRTN_",11,",DA=SRTN,DIC(0)="L",X=SRBLOOD D FILE^DICN
  1. 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
  1. Q
  1. DIE K DR,DA,DIE S DR="38////"_BLOOD_";40////"_CROSSM,DA=SRTN,DIE=130 D ^DIE K DA,DR,DIE
  1. Q
  1. PRINT ; print blood request on schedule
  1. I '$D(S(0)) S S(0)=^SRF(SRTN,0)
  1. I $O(^SRF(SRTN,11,0)) S $P(^SRF(SRTN,0),"^",6)="Y",$P(S(0),"^",6)="Y"
  1. S BLOOD=$P(S(0),"^",6) I BLOOD'="Y" Q
  1. S TYPE=$P(S(0),"^",13),TYPE=$S(TYPE="T":"TYPE & CROSSMATCH",TYPE="S":"SCREEN",TYPE="A":"AUTOLOGOUS",1:"")
  1. W ?24,"REQUESTED BLOOD COMPONENTS: "_TYPE S BLOOD=0 F S BLOOD=$O(^SRF(SRTN,11,BLOOD)) Q:BLOOD="" D BLOOD
  1. Q
  1. BLOOD ; print blood kind & units
  1. S (B,SRB)=$P(^SRF(SRTN,11,BLOOD,0),"^"),SRBU=$P(^(0),"^",2) ;,SRB=$P(^LAB(66,B,0),"^") ;RLM
  1. S SRBU=$S(SRBU>1:SRBU_" UNITS",SRBU>0:SRBU_" UNIT",SRBU=0:SRBU_" UNITS",1:"UNITS NOT ENTERED") W !,?24,SRB_" - "_SRBU
  1. Q