| [613] | 1 | GMTSLRTE ; SLC/JER,KER - Transfusion Record Extract Routine ; 01/06/2003
|
|---|
| 2 | ;;2.7;Health Summary;**56,58**;Oct 20, 1995
|
|---|
| 3 | ;
|
|---|
| 4 | ; External References
|
|---|
| 5 | ; DBIA 10035 ^DPT(
|
|---|
| 6 | ; DBIA 528 ^LAB(66
|
|---|
| 7 | ; DBIA 525 ^LR(
|
|---|
| 8 | ;
|
|---|
| 9 | XTRCT ; Extract Transfusion Records
|
|---|
| 10 | N LRDFN,IDT,CNTR,TR,PN,PRODUCT
|
|---|
| 11 | S:'$D(GMTS1) GMTS1=6666666 S:'$D(GMTS2) GMTS2=9999999
|
|---|
| 12 | K ^TMP("LRT",$J)
|
|---|
| 13 | Q:'$D(^DPT(DFN,"LR")) S LRDFN=+^DPT(DFN,"LR"),IDT=GMTS1-1
|
|---|
| 14 | I '$D(^LR(LRDFN)) Q
|
|---|
| 15 | S IDT=GMTS1-1 F S IDT=$O(^LR(LRDFN,1.6,IDT)) Q:+IDT'>0!(IDT>GMTS2) D
|
|---|
| 16 | . S TR=$G(^LR(LRDFN,1.6,IDT,0)) D SET
|
|---|
| 17 | S IDT=0 F S IDT=$O(CNTR(IDT)) Q:+IDT'>0 D
|
|---|
| 18 | . S ^TMP("LRT",$J,IDT)=9999999-IDT_U
|
|---|
| 19 | . S PN=0 F S PN=$O(CNTR(IDT,PN)) Q:PN'>0 D
|
|---|
| 20 | . . S PRODUCT=$G(^LAB(66,+PN,0)),^TMP("LRT",$J,$P(PRODUCT,U,2))=$P(PRODUCT,U)
|
|---|
| 21 | . . S ^TMP("LRT",$J,IDT)=^TMP("LRT",$J,IDT)_CNTR(IDT,PN)_"\"_$P(PRODUCT,U,2)_";"
|
|---|
| 22 | Q
|
|---|
| 23 | SET ; Save Appropriate Data
|
|---|
| 24 | N COMP,UNITS,TDT,ITDT S TDT=9999999-IDT,ITDT=9999999-$P(TDT,".")
|
|---|
| 25 | S UNITS=+$P(TR,U,7) S:UNITS'>0 UNITS=1
|
|---|
| 26 | S CNTR(ITDT,+$P(TR,U,2))=+$G(CNTR(ITDT,+$P(TR,U,2)))+UNITS
|
|---|
| 27 | Q
|
|---|
