- 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 Mar 13, 2025@21:02:19 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
