- LRBLTA1 ;AVAMC/REG - TRANSFUSION REACTION COUNTS ;10/7/90 10:54 ;
- ;;5.2;LAB SERVICE;**247**;Sep 27, 1994
- ;Per VHA Directive 97-033 this routine should not be modified. Medical Device # BK970021
- K ^TMP($J) D H Q:LR("Q")
- F LRDFN=0:0 S LRDFN=$O(^LR("AR",LRDFN)) Q:'LRDFN F LRR=0:0 S LRR=$O(^LR("AR",LRDFN,LRR)) Q:'LRR F LRI=LRLDT:0 S LRI=$O(^LR("AR",LRDFN,LRR,LRI)) Q:'LRI!(LRI>LRSDT) D S
- F LRR=0:0 S LRR=$O(^TMP($J,LRR)) Q:'LRR!(LR("Q")) D:$Y>(IOSL-6) H Q:LR("Q") S LRR(1)=$P(^LAB(65.4,LRR,0),U) W !!,LRR(1),?31,$J(^TMP($J,LRR),4) D:LRF B
- D END^LRUTL,END Q
- S S:'$D(^TMP($J,LRR)) ^(LRR)=0 S ^(LRR)=^(LRR)+1 S:LRF ^(LRR,LRDFN,LRI)="" Q
- B S LRDFN=0 F S LRDFN=$O(^TMP($J,LRR,LRDFN)) Q:'LRDFN!(LR("Q")) D N^LRBLTA,C
- Q
- C S LRI=0 F S LRI=$O(^TMP($J,LRR,LRDFN,LRI)) Q:'LRI!(LR("Q")) D:$Y>(IOSL-6) H1 Q:LR("Q") W !,SSN,?5,LRP,?36 S Y=+$G(^LR(LRDFN,1.9,LRI,0)) D DT^LRU W Y
- Q
- ;
- END D V^LRU Q
- ;
- H I $D(LR("F")),IOST?1"C".E D M^LRU Q:LR("Q")
- D F^LRU W !,"TRANSFUSION REACTION COUNTS NOT ASSOCIATE WITH SPECIFIC UNITS",!,"FROM ",LRSTR," TO ",LRLST,!,"REACTION",?31,"COUNT" W:LRF !,"SSN",?5,"Patient",?36,"Transfusion Reaction Date" W !,LR("%") Q
- H1 D H Q:LR("Q") W !,LRR(1) Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRBLTA1 1203 printed Jan 18, 2025@03:13:04 Page 2
- LRBLTA1 ;AVAMC/REG - TRANSFUSION REACTION COUNTS ;10/7/90 10:54 ;
- +1 ;;5.2;LAB SERVICE;**247**;Sep 27, 1994
- +2 ;Per VHA Directive 97-033 this routine should not be modified. Medical Device # BK970021
- +3 KILL ^TMP($JOB)
- DO H
- if LR("Q")
- QUIT
- +4 FOR LRDFN=0:0
- SET LRDFN=$ORDER(^LR("AR",LRDFN))
- if 'LRDFN
- QUIT
- FOR LRR=0:0
- SET LRR=$ORDER(^LR("AR",LRDFN,LRR))
- if 'LRR
- QUIT
- FOR LRI=LRLDT:0
- SET LRI=$ORDER(^LR("AR",LRDFN,LRR,LRI))
- if 'LRI!(LRI>LRSDT)
- QUIT
- DO S
- +5 FOR LRR=0:0
- SET LRR=$ORDER(^TMP($JOB,LRR))
- if 'LRR!(LR("Q"))
- QUIT
- if $Y>(IOSL-6)
- DO H
- if LR("Q")
- QUIT
- SET LRR(1)=$PIECE(^LAB(65.4,LRR,0),U)
- WRITE !!,LRR(1),?31,$JUSTIFY(^TMP($JOB,LRR),4)
- if LRF
- DO B
- +6 DO END^LRUTL
- DO END
- QUIT
- S if '$DATA(^TMP($JOB,LRR))
- SET ^(LRR)=0
- SET ^(LRR)=^(LRR)+1
- if LRF
- SET ^(LRR,LRDFN,LRI)=""
- QUIT
- B SET LRDFN=0
- FOR
- SET LRDFN=$ORDER(^TMP($JOB,LRR,LRDFN))
- if 'LRDFN!(LR("Q"))
- QUIT
- DO N^LRBLTA
- DO C
- +1 QUIT
- C SET LRI=0
- FOR
- SET LRI=$ORDER(^TMP($JOB,LRR,LRDFN,LRI))
- if 'LRI!(LR("Q"))
- QUIT
- if $Y>(IOSL-6)
- DO H1
- if LR("Q")
- QUIT
- WRITE !,SSN,?5,LRP,?36
- SET Y=+$GET(^LR(LRDFN,1.9,LRI,0))
- DO DT^LRU
- WRITE Y
- +1 QUIT
- +2 ;
- END DO V^LRU
- QUIT
- +1 ;
- H IF $DATA(LR("F"))
- IF IOST?1"C".E
- DO M^LRU
- if LR("Q")
- QUIT
- +1 DO F^LRU
- WRITE !,"TRANSFUSION REACTION COUNTS NOT ASSOCIATE WITH SPECIFIC UNITS",!,"FROM ",LRSTR," TO ",LRLST,!,"REACTION",?31,"COUNT"
- if LRF
- WRITE !,"SSN",?5,"Patient",?36,"Transfusion Reaction Date"
- WRITE !,LR("%")
- QUIT
- H1 DO H
- if LR("Q")
- QUIT
- WRITE !,LRR(1)
- QUIT