SROBLOD.m

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

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