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
|
---|