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