- LRBLJTS ; IHS/DIR/FJE - TRANSFUSION STATISTICS 4/12/93 15:19 ;
- ;;5.2;LR;;NOV 01, 1997
- ;
- ;;5.2;LAB SERVICE;;Sep 27, 1994
- D END S X="BLOOD BANK" D ^LRUTL G:Y=-1 END
- W !!?10,"Transfusion by treating specialty/physician",!
- A R !!,"Start with TREATING SPECIALTY: FIRST// ",X:DTIME G:'$T!(X[U) END I X="" S LRA="/" G B
- S DIC="^DIC(45.7,",DIC(0)="EQM" D ^DIC K DIC G:Y<1 A S X=$P(Y,"^",2),A=$A(X,$L(X))-1,A=$C(A),LRA=$E(X,1,$L(X)-1)_A_"z"
- B R !,"Go to TREATING SPECIALTY: LAST// ",X:DTIME G:'$T!(X[U) END I X="" S LRB="{" G C
- S DIC="^DIC(45.7,",DIC(0)="EQM" D ^DIC K DIC G:Y<1 B S LRB=$P(Y,"^",2)
- C R !!,"Within TREATING SPECIALTY Start with BLOOD COMPONENT: FIRST// ",X:DTIME G:'$T!(X[U) END I X="" S LRC="/" G D
- S DIC="^LAB(66,",DIC(0)="EQM" D ^DIC K DIC G:Y<1 C S X=$P(Y,"^",2),A=$A($E(X,$L(X)))-1,A=$C(A),LRC=$E(X,1,$L(X)-1)_A_"z"
- D R !,"Within TREATING SPECIALTY Go to BLOOD COMPONENT: LAST// ",X:DTIME G:'$T!(X[U) END I X="" S LRE="{" G E
- S DIC="^LAB(66,",DIC(0)="EQM" D ^DIC K DIC G:Y<1 D S LRE=$P(Y,"^",2)
- E W !! D B^LRU Q:Y<0 S X=LRSDT,Y=LRLDT,LRQ(1)="("_+$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3)_"-"_+$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(X,2,3)_")"
- S ZTRTN="QUE^LRBLJTS" D BEG^LRUTL G:POP!($D(ZTSK)) END
- QUE U IO K ^TMP($J) S LRF("?")="?",LRSDT=LRSDT-.0001,LRLDT=LRLDT+.9999,X=$P(^DD(66,.26,0),U,3) F A=1:1 S B=$P(X,";",A) Q:B="" S LRF($P(B,":"))=$P(B,":",2)
- D L^LRU,S^LRU,^LRBLJTS1
- D END^LRUTL,END Q
- ;
- END D V^LRU Q
- LRBLJTS ; IHS/DIR/FJE - TRANSFUSION STATISTICS 4/12/93 15:19 ;
- +1 ;;5.2;LR;;NOV 01, 1997
- +2 ;
- +3 ;;5.2;LAB SERVICE;;Sep 27, 1994
- +4 DO END
- SET X="BLOOD BANK"
- DO ^LRUTL
- IF Y=-1
- GOTO END
- +5 WRITE !!?10,"Transfusion by treating specialty/physician",!
- A READ !!,"Start with TREATING SPECIALTY: FIRST// ",X:DTIME
- IF '$TEST!(X[U)
- GOTO END
- IF X=""
- SET LRA="/"
- GOTO B
- +1 SET DIC="^DIC(45.7,"
- SET DIC(0)="EQM"
- DO ^DIC
- KILL DIC
- IF Y<1
- GOTO A
- SET X=$PIECE(Y,"^",2)
- SET A=$ASCII(X,$LENGTH(X))-1
- SET A=$CHAR(A)
- SET LRA=$EXTRACT(X,1,$LENGTH(X)-1)_A_"z"
- B READ !,"Go to TREATING SPECIALTY: LAST// ",X:DTIME
- IF '$TEST!(X[U)
- GOTO END
- IF X=""
- SET LRB="{"
- GOTO C
- +1 SET DIC="^DIC(45.7,"
- SET DIC(0)="EQM"
- DO ^DIC
- KILL DIC
- IF Y<1
- GOTO B
- SET LRB=$PIECE(Y,"^",2)
- C READ !!,"Within TREATING SPECIALTY Start with BLOOD COMPONENT: FIRST// ",X:DTIME
- IF '$TEST!(X[U)
- GOTO END
- IF X=""
- SET LRC="/"
- GOTO D
- +1 SET DIC="^LAB(66,"
- SET DIC(0)="EQM"
- DO ^DIC
- KILL DIC
- IF Y<1
- GOTO C
- SET X=$PIECE(Y,"^",2)
- SET A=$ASCII($EXTRACT(X,$LENGTH(X)))-1
- SET A=$CHAR(A)
- SET LRC=$EXTRACT(X,1,$LENGTH(X)-1)_A_"z"
- D READ !,"Within TREATING SPECIALTY Go to BLOOD COMPONENT: LAST// ",X:DTIME
- IF '$TEST!(X[U)
- GOTO END
- IF X=""
- SET LRE="{"
- GOTO E
- +1 SET DIC="^LAB(66,"
- SET DIC(0)="EQM"
- DO ^DIC
- KILL DIC
- IF Y<1
- GOTO D
- SET LRE=$PIECE(Y,"^",2)
- E WRITE !!
- DO B^LRU
- IF Y<0
- QUIT
- SET X=LRSDT
- SET Y=LRLDT
- SET LRQ(1)="("_+$EXTRACT(X,4,5)_"/"_$EXTRACT(X,6,7)_"/"_$EXTRACT(X,2,3)_"-"_+$EXTRACT(Y,4,5)_"/"_$EXTRACT(Y,6,7)_"/"_$EXTRACT(X,2,3)_")"
- +1 SET ZTRTN="QUE^LRBLJTS"
- DO BEG^LRUTL
- IF POP!($DATA(ZTSK))
- GOTO END
- QUE USE IO
- KILL ^TMP($JOB)
- SET LRF("?")="?"
- SET LRSDT=LRSDT-.0001
- SET LRLDT=LRLDT+.9999
- SET X=$PIECE(^DD(66,.26,0),U,3)
- FOR A=1:1
- SET B=$PIECE(X,";",A)
- IF B=""
- QUIT
- SET LRF($PIECE(B,":"))=$PIECE(B,":",2)
- +1 DO L^LRU
- DO S^LRU
- DO ^LRBLJTS1
- +2 DO END^LRUTL
- DO END
- QUIT
- +3 ;
- END DO V^LRU
- QUIT
