- 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 Jan 18, 2025@03:43:39 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