1 | GMTSLRT ; SLC/JER,KER - Blood Bank Transfusion ; 11/26/2002
|
---|
2 | ;;2.7;Health Summary;**28,47,59**;Oct 20, 1995
|
---|
3 | ;
|
---|
4 | ; External References
|
---|
5 | ; DBIA 525 ^LR( all fields
|
---|
6 | ; DBIA 2056 $$GET1^DIQ (file 2)
|
---|
7 | ; DBIA 3176 TRAN^VBECA4
|
---|
8 | ;
|
---|
9 | MAIN ; Blood Transfusion
|
---|
10 | N GMA,GMI,GMR,IX,MAX,A,R,TD,BPN,LOC
|
---|
11 | S LOC="LRT",LRDFN=$$GET1^DIQ(2,+($G(DFN)),63,"I")
|
---|
12 | ;
|
---|
13 | ; Get Transfusion Records
|
---|
14 | ; Blood Bank Package TRANS^VBECA4
|
---|
15 | ; Lab Package ^GMTSLRTE
|
---|
16 | ;
|
---|
17 | D:+($$ROK^GMTSU("VBECA4"))>0 TRAN^VBECA4(DFN,LOC,GMTS1,GMTS2)
|
---|
18 | D:+($$ROK^GMTSU("VBECA4"))'>0 ^GMTSLRTE
|
---|
19 | Q:'$D(^TMP("LRT",$J))
|
---|
20 | S MAX=$S(+($G(GMTSNDM))>0:+($G(GMTSNDM)),1:999),IX=GMTS1
|
---|
21 | F GMI=1:1:MAX S IX=$O(^TMP("LRT",$J,IX)) Q:IX=""!(IX>GMTS2) D
|
---|
22 | . S GMR=^TMP("LRT",$J,IX) D PRSREC,WRT
|
---|
23 | I $O(^TMP("LRT",$J,"A"))'="" D
|
---|
24 | . D CKP^GMTSUP Q:$D(GMTSQIT) W !
|
---|
25 | . D CKP^GMTSUP Q:$D(GMTSQIT) W " Blood Product Key: "
|
---|
26 | S GMI="A" F S GMI=$O(^TMP("LRT",$J,GMI)) Q:GMI="" D
|
---|
27 | . D CKP^GMTSUP Q:$D(GMTSQIT)
|
---|
28 | . W ?21,GMI," = ",$G(^TMP("LRT",$J,GMI)),!
|
---|
29 | K ^TMP("LRT",$J)
|
---|
30 | Q
|
---|
31 | PRSREC ; Parses Record for presentation
|
---|
32 | N GMI,X S X=$P(GMR,U) D REGDT4^GMTSU S TD=X
|
---|
33 | S GMA(1)=$P(GMR,U,2),BPN=$L(GMA(1),";")
|
---|
34 | I $P(GMA(1),";",BPN)="" S BPN=BPN-1
|
---|
35 | F GMI=2:1:BPN S GMA(GMI)="("_$P($P(GMA(1),";",GMI),"\")_") "_$P($P(GMA(1),";",GMI),"\",2)
|
---|
36 | S GMA(1)="("_$P($P(GMA(1),";",1),"\")_") "_$P($P(GMA(1),";",1),"\",2)
|
---|
37 | Q
|
---|
38 | WRT ; Writes the Transfusion Record for each day
|
---|
39 | N GML,GMI1,GMI2,GMM,GMJ S GMM=$S(BPN#4:1,1:0),GML=BPN\4+GMM
|
---|
40 | D CKP^GMTSUP Q:$D(GMTSQIT) W TD
|
---|
41 | F GMI1=1:1:GML D Q:$D(GMTSQIT)
|
---|
42 | . F GMI2=1:1:($S((GMI1=GML)&(BPN#4):BPN#4,1:4)) D Q:$D(GMTSQIT)
|
---|
43 | . . S GMJ=((GMI1-1)*4)+GMI2 D CKP^GMTSUP Q:$D(GMTSQIT)
|
---|
44 | . . W ?(((GMI2-1)*15)+10),GMA(GMJ)
|
---|
45 | . . I $S(GMI2#4=0:1,GMI2=BPN:1,GMI2+(4*(GMI1-1))=BPN:1,1:0) W !
|
---|
46 | Q
|
---|