GMTSLRT ; SLC/JER,KER - Blood Bank Transfusion ; 11/26/2002
;;2.7;Health Summary;**28,47,59**;Oct 20, 1995
;
; External References
; DBIA 525 ^LR( all fields
; DBIA 2056 $$GET1^DIQ (file 2)
; DBIA 3176 TRAN^VBECA4
;
MAIN ; Blood Transfusion
N GMA,GMI,GMR,IX,MAX,A,R,TD,BPN,LOC
S LOC="LRT",LRDFN=$$GET1^DIQ(2,+($G(DFN)),63,"I")
;
; Get Transfusion Records
; Blood Bank Package TRANS^VBECA4
; Lab Package ^GMTSLRTE
;
D:+($$ROK^GMTSU("VBECA4"))>0 TRAN^VBECA4(DFN,LOC,GMTS1,GMTS2)
D:+($$ROK^GMTSU("VBECA4"))'>0 ^GMTSLRTE
Q:'$D(^TMP("LRT",$J))
S MAX=$S(+($G(GMTSNDM))>0:+($G(GMTSNDM)),1:999),IX=GMTS1
F GMI=1:1:MAX S IX=$O(^TMP("LRT",$J,IX)) Q:IX=""!(IX>GMTS2) D
. S GMR=^TMP("LRT",$J,IX) D PRSREC,WRT
I $O(^TMP("LRT",$J,"A"))'="" D
. D CKP^GMTSUP Q:$D(GMTSQIT) W !
. D CKP^GMTSUP Q:$D(GMTSQIT) W " Blood Product Key: "
S GMI="A" F S GMI=$O(^TMP("LRT",$J,GMI)) Q:GMI="" D
. D CKP^GMTSUP Q:$D(GMTSQIT)
. W ?21,GMI," = ",$G(^TMP("LRT",$J,GMI)),!
K ^TMP("LRT",$J)
Q
PRSREC ; Parses Record for presentation
N GMI,X S X=$P(GMR,U) D REGDT4^GMTSU S TD=X
S GMA(1)=$P(GMR,U,2),BPN=$L(GMA(1),";")
I $P(GMA(1),";",BPN)="" S BPN=BPN-1
F GMI=2:1:BPN S GMA(GMI)="("_$P($P(GMA(1),";",GMI),"\")_") "_$P($P(GMA(1),";",GMI),"\",2)
S GMA(1)="("_$P($P(GMA(1),";",1),"\")_") "_$P($P(GMA(1),";",1),"\",2)
Q
WRT ; Writes the Transfusion Record for each day
N GML,GMI1,GMI2,GMM,GMJ S GMM=$S(BPN#4:1,1:0),GML=BPN\4+GMM
D CKP^GMTSUP Q:$D(GMTSQIT) W TD
F GMI1=1:1:GML D Q:$D(GMTSQIT)
. F GMI2=1:1:($S((GMI1=GML)&(BPN#4):BPN#4,1:4)) D Q:$D(GMTSQIT)
. . S GMJ=((GMI1-1)*4)+GMI2 D CKP^GMTSUP Q:$D(GMTSQIT)
. . W ?(((GMI2-1)*15)+10),GMA(GMJ)
. . I $S(GMI2#4=0:1,GMI2=BPN:1,GMI2+(4*(GMI1-1))=BPN:1,1:0) W !
Q
GMTSLRT ; SLC/JER,KER - Blood Bank Transfusion ; 11/26/2002
+1 ;;2.7;Health Summary;**28,47,59**;Oct 20, 1995
+2 ;
+3 ; External References
+4 ; DBIA 525 ^LR( all fields
+5 ; DBIA 2056 $$GET1^DIQ (file 2)
+6 ; DBIA 3176 TRAN^VBECA4
+7 ;
MAIN ; Blood Transfusion
+1 NEW GMA,GMI,GMR,IX,MAX,A,R,TD,BPN,LOC
+2 SET LOC="LRT"
SET LRDFN=$$GET1^DIQ(2,+($GET(DFN)),63,"I")
+3 ;
+4 ; Get Transfusion Records
+5 ; Blood Bank Package TRANS^VBECA4
+6 ; Lab Package ^GMTSLRTE
+7 ;
+8 IF +($$ROK^GMTSU("VBECA4"))>0
DO TRAN^VBECA4(DFN,LOC,GMTS1,GMTS2)
+9 IF +($$ROK^GMTSU("VBECA4"))'>0
DO ^GMTSLRTE
+10 IF '$DATA(^TMP("LRT",$JOB))
QUIT
+11 SET MAX=$SELECT(+($GET(GMTSNDM))>0:+($GET(GMTSNDM)),1:999)
SET IX=GMTS1
+12 FOR GMI=1:1:MAX
SET IX=$ORDER(^TMP("LRT",$JOB,IX))
IF IX=""!(IX>GMTS2)
QUIT
Begin DoDot:1
+13 SET GMR=^TMP("LRT",$JOB,IX)
DO PRSREC
DO WRT
End DoDot:1
+14 IF $ORDER(^TMP("LRT",$JOB,"A"))'=""
Begin DoDot:1
+15 DO CKP^GMTSUP
IF $DATA(GMTSQIT)
QUIT
WRITE !
+16 DO CKP^GMTSUP
IF $DATA(GMTSQIT)
QUIT
WRITE " Blood Product Key: "
End DoDot:1
+17 SET GMI="A"
FOR
SET GMI=$ORDER(^TMP("LRT",$JOB,GMI))
IF GMI=""
QUIT
Begin DoDot:1
+18 DO CKP^GMTSUP
IF $DATA(GMTSQIT)
QUIT
+19 WRITE ?21,GMI," = ",$GET(^TMP("LRT",$JOB,GMI)),!
End DoDot:1
+20 KILL ^TMP("LRT",$JOB)
+21 QUIT
PRSREC ; Parses Record for presentation
+1 NEW GMI,X
SET X=$PIECE(GMR,U)
DO REGDT4^GMTSU
SET TD=X
+2 SET GMA(1)=$PIECE(GMR,U,2)
SET BPN=$LENGTH(GMA(1),";")
+3 IF $PIECE(GMA(1),";",BPN)=""
SET BPN=BPN-1
+4 FOR GMI=2:1:BPN
SET GMA(GMI)="("_$PIECE($PIECE(GMA(1),";",GMI),"\")_") "_$PIECE($PIECE(GMA(1),";",GMI),"\",2)
+5 SET GMA(1)="("_$PIECE($PIECE(GMA(1),";",1),"\")_") "_$PIECE($PIECE(GMA(1),";",1),"\",2)
+6 QUIT
WRT ; Writes the Transfusion Record for each day
+1 NEW GML,GMI1,GMI2,GMM,GMJ
SET GMM=$SELECT(BPN#4:1,1:0)
SET GML=BPN\4+GMM
+2 DO CKP^GMTSUP
IF $DATA(GMTSQIT)
QUIT
WRITE TD
+3 FOR GMI1=1:1:GML
Begin DoDot:1
+4 FOR GMI2=1:1:($SELECT((GMI1=GML)&(BPN#4):BPN#4,1:4))
Begin DoDot:2
+5 SET GMJ=((GMI1-1)*4)+GMI2
DO CKP^GMTSUP
IF $DATA(GMTSQIT)
QUIT
+6 WRITE ?(((GMI2-1)*15)+10),GMA(GMJ)
+7 IF $SELECT(GMI2#4=0:1,GMI2=BPN:1,GMI2+(4*(GMI1-1))=BPN:1,1:0)
WRITE !
End DoDot:2
IF $DATA(GMTSQIT)
QUIT
End DoDot:1
IF $DATA(GMTSQIT)
QUIT
+8 QUIT
