source: WorldVistAEHR/trunk/r/SURGERY-SR/SROBLOD.m@ 1036

Last change on this file since 1036 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.0 KB
Line 
1SROBLOD ;B'HAM ISC/MAM - SAFETY STRAP, REQUESTED BLOOD ; 30 DEC 1991 10:15 AM
2 ;;3.0; Surgery ;**34,109**;24 Jun 93
3 S ^SRF(SRTN,42,0)="^130.065P^1^1",^SRF(SRTN,42,1,0)=1
4 K DR S DR=".13///SAFETY STRAP",DR(2,130.31)=.01,DIE=130,DA=SRTN D ^DIE K DR
5 S BLOOD="N",CROSSM=""
6ASK 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
7 S BLOOD=Y I BLOOD="N" D DIE Q
8TYPE 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
9 I X["^" G TYPE
10 S CROSSM=Y D DIE I CROSSM'="T" Q
11 ;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
12 ;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
13 S SRBLOOD=$P($G(^SRO(133,SRSITE,7)),"^")
14 I SRBLOOD'="" D
15 . N DO,DR,DA,DIC,X S DIC="^SRF("_SRTN_",11,",DA=SRTN,DIC(0)="L",X=SRBLOOD D FILE^DICN
16 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
17 Q
18DIE K DR,DA,DIE S DR="38////"_BLOOD_";40////"_CROSSM,DA=SRTN,DIE=130 D ^DIE K DA,DR,DIE
19 Q
20PRINT ; print blood request on schedule
21 I '$D(S(0)) S S(0)=^SRF(SRTN,0)
22 I $O(^SRF(SRTN,11,0)) S $P(^SRF(SRTN,0),"^",6)="Y",$P(S(0),"^",6)="Y"
23 S BLOOD=$P(S(0),"^",6) I BLOOD'="Y" Q
24 S TYPE=$P(S(0),"^",13),TYPE=$S(TYPE="T":"TYPE & CROSSMATCH",TYPE="S":"SCREEN",TYPE="A":"AUTOLOGOUS",1:"")
25 W ?24,"REQUESTED BLOOD COMPONENTS: "_TYPE S BLOOD=0 F S BLOOD=$O(^SRF(SRTN,11,BLOOD)) Q:BLOOD="" D BLOOD
26 Q
27BLOOD ; print blood kind & units
28 S (B,SRB)=$P(^SRF(SRTN,11,BLOOD,0),"^"),SRBU=$P(^(0),"^",2) ;,SRB=$P(^LAB(66,B,0),"^") ;RLM
29 S SRBU=$S(SRBU>1:SRBU_" UNITS",SRBU>0:SRBU_" UNIT",SRBU=0:SRBU_" UNITS",1:"UNITS NOT ENTERED") W !,?24,SRB_" - "_SRBU
30 Q
Note: See TracBrowser for help on using the repository browser.