source: WorldVistAEHR/trunk/r/HEALTH_SUMMARY-GMTS/GMTSLRB.m@ 1432

Last change on this file since 1432 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.5 KB
RevLine 
[613]1GMTSLRB ; SLC/JER,KER - Blood Availability Component ; 11/26/2002
2 ;;2.7;Health Summary;**17,47,59**;Oct 20, 1995
3 ;
4 ; External References
5 ; DBIA 525 ^LR( all fields
6 ; DBIA 2056 $$GET1^DIQ (file 2)
7 ; DBIA 3177 AVUNIT^VBECA4() Blood Bank Pkg
8 ;
9MAIN ; Blood Availability
10 N GMI,MAX,LRDFN,IX,X,LOC
11 S MAX=$S(+($G(GMTSNDM))>0:+($G(GMTSNDM)),1:999),LOC="LRB"
12 S LRDFN=$$GET1^DIQ(2,+($G(DFN)),63,"I") Q:+LRDFN=0!('$D(^LR(+LRDFN)))
13 ;
14 ; Get Available Units
15 ; Blood Bank Package AVUNIT^VBECA4
16 ; Lab Package ^GMTSLRBE
17 ;
18 D:+($$ROK^GMTSU("VBECA4"))>0 AVUNIT^VBECA4(DFN,LOC,GMTS1,GMTS2,MAX)
19 D:+($$ROK^GMTSU("VBECA4"))'>0 ^GMTSLRBE
20 Q:'$D(^TMP("LRB",$J))
21 D WRTBTYP
22 S IX=0 F S IX=$O(^TMP("LRB",$J,IX)) Q:IX="" D
23 . S X=^TMP("LRB",$J,IX) D WRT
24 K ^TMP("LRB",$J)
25 Q
26WRTBTYP ; Writes Blood Type (Added 03/31/1994)
27 D CKP^GMTSUP Q:$D(GMTSQIT)
28 W ?1,"Patient Blood Type:",?22,$P(^TMP("LRB",$J,0),U,1)
29 W ?25,$P(^TMP("LRB",$J,0),U,2),!!
30 Q
31WRT ; Writes Blood Availability Record
32 D CKP^GMTSUP Q:$D(GMTSQIT)
33 W $P(X,U),?2,$P(X,U,2),?11,$P(X,U,3),?22,$P(X,U,4)
34 W ?62,$J($P(X,U,6),2),?65,$P(X,U,7),?69,$P(X,U,8),!
35 D CKP^GMTSUP Q:$D(GMTSQIT)
36 W ?6,"Unit Location:"
37 W ?22,$S($L($P(X,U,10)):$P(X,U,10),1:"Blood Bank"),!
38 D CKP^GMTSUP Q:$D(GMTSQIT)
39 W ?6,"Unit Division:",?22,$P(X,U,9),!
40 I $L($P(X,U,8)) D CKP^GMTSUP Q:$D(GMTSQIT) D
41 . W ?6,"Donation Type:",?22,$P(X,U,8),!
42 Q
Note: See TracBrowser for help on using the repository browser.