GMTSLRB ; SLC/JER,KER - Blood Availability Component ; 11/26/2002
;;2.7;Health Summary;**17,47,59**;Oct 20, 1995
;
; External References
; DBIA 525 ^LR( all fields
; DBIA 2056 $$GET1^DIQ (file 2)
; DBIA 3177 AVUNIT^VBECA4() Blood Bank Pkg
;
MAIN ; Blood Availability
N GMI,MAX,LRDFN,IX,X,LOC
S MAX=$S(+($G(GMTSNDM))>0:+($G(GMTSNDM)),1:999),LOC="LRB"
S LRDFN=$$GET1^DIQ(2,+($G(DFN)),63,"I") Q:+LRDFN=0!('$D(^LR(+LRDFN)))
;
; Get Available Units
; Blood Bank Package AVUNIT^VBECA4
; Lab Package ^GMTSLRBE
;
D:+($$ROK^GMTSU("VBECA4"))>0 AVUNIT^VBECA4(DFN,LOC,GMTS1,GMTS2,MAX)
D:+($$ROK^GMTSU("VBECA4"))'>0 ^GMTSLRBE
Q:'$D(^TMP("LRB",$J))
D WRTBTYP
S IX=0 F S IX=$O(^TMP("LRB",$J,IX)) Q:IX="" D
. S X=^TMP("LRB",$J,IX) D WRT
K ^TMP("LRB",$J)
Q
WRTBTYP ; Writes Blood Type (Added 03/31/1994)
D CKP^GMTSUP Q:$D(GMTSQIT)
W ?1,"Patient Blood Type:",?22,$P(^TMP("LRB",$J,0),U,1)
W ?25,$P(^TMP("LRB",$J,0),U,2),!!
Q
WRT ; Writes Blood Availability Record
D CKP^GMTSUP Q:$D(GMTSQIT)
W $P(X,U),?2,$P(X,U,2),?11,$P(X,U,3),?22,$P(X,U,4)
W ?62,$J($P(X,U,6),2),?65,$P(X,U,7),?69,$P(X,U,8),!
D CKP^GMTSUP Q:$D(GMTSQIT)
W ?6,"Unit Location:"
W ?22,$S($L($P(X,U,10)):$P(X,U,10),1:"Blood Bank"),!
D CKP^GMTSUP Q:$D(GMTSQIT)
W ?6,"Unit Division:",?22,$P(X,U,9),!
I $L($P(X,U,8)) D CKP^GMTSUP Q:$D(GMTSQIT) D
. W ?6,"Donation Type:",?22,$P(X,U,8),!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSLRB 1541 printed Nov 22, 2024@17:07:48 Page 2
GMTSLRB ; SLC/JER,KER - Blood Availability Component ; 11/26/2002
+1 ;;2.7;Health Summary;**17,47,59**;Oct 20, 1995
+2 ;
+3 ; External References
+4 ; DBIA 525 ^LR( all fields
+5 ; DBIA 2056 $$GET1^DIQ (file 2)
+6 ; DBIA 3177 AVUNIT^VBECA4() Blood Bank Pkg
+7 ;
MAIN ; Blood Availability
+1 NEW GMI,MAX,LRDFN,IX,X,LOC
+2 SET MAX=$SELECT(+($GET(GMTSNDM))>0:+($GET(GMTSNDM)),1:999)
SET LOC="LRB"
+3 SET LRDFN=$$GET1^DIQ(2,+($GET(DFN)),63,"I")
if +LRDFN=0!('$DATA(^LR(+LRDFN)))
QUIT
+4 ;
+5 ; Get Available Units
+6 ; Blood Bank Package AVUNIT^VBECA4
+7 ; Lab Package ^GMTSLRBE
+8 ;
+9 if +($$ROK^GMTSU("VBECA4"))>0
DO AVUNIT^VBECA4(DFN,LOC,GMTS1,GMTS2,MAX)
+10 if +($$ROK^GMTSU("VBECA4"))'>0
DO ^GMTSLRBE
+11 if '$DATA(^TMP("LRB",$JOB))
QUIT
+12 DO WRTBTYP
+13 SET IX=0
FOR
SET IX=$ORDER(^TMP("LRB",$JOB,IX))
if IX=""
QUIT
Begin DoDot:1
+14 SET X=^TMP("LRB",$JOB,IX)
DO WRT
End DoDot:1
+15 KILL ^TMP("LRB",$JOB)
+16 QUIT
WRTBTYP ; Writes Blood Type (Added 03/31/1994)
+1 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+2 WRITE ?1,"Patient Blood Type:",?22,$PIECE(^TMP("LRB",$JOB,0),U,1)
+3 WRITE ?25,$PIECE(^TMP("LRB",$JOB,0),U,2),!!
+4 QUIT
WRT ; Writes Blood Availability Record
+1 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+2 WRITE $PIECE(X,U),?2,$PIECE(X,U,2),?11,$PIECE(X,U,3),?22,$PIECE(X,U,4)
+3 WRITE ?62,$JUSTIFY($PIECE(X,U,6),2),?65,$PIECE(X,U,7),?69,$PIECE(X,U,8),!
+4 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+5 WRITE ?6,"Unit Location:"
+6 WRITE ?22,$SELECT($LENGTH($PIECE(X,U,10)):$PIECE(X,U,10),1:"Blood Bank"),!
+7 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+8 WRITE ?6,"Unit Division:",?22,$PIECE(X,U,9),!
+9 IF $LENGTH($PIECE(X,U,8))
DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
Begin DoDot:1
+10 WRITE ?6,"Donation Type:",?22,$PIECE(X,U,8),!
End DoDot:1
+11 QUIT
