source: WorldVistAEHR/trunk/r/HEALTH_SUMMARY-GMTS/GMTSLRBE.m@ 1800

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

initial load of WorldVistAEHR

File size: 1.6 KB
RevLine 
[613]1GMTSLRBE ; SLC/JER,KER - Blood Availability Extract ; 08/27/2002
2 ;;2.7;Health Summary;**17,28,56**;Oct 20, 1995
3 ;
4 ;
5 ; External References
6 ; DBIA 10090 ^DIC(4
7 ; DBIA 528 ^LAB(66
8 ; DBIA 525 ^LR(
9 ; DBIA 527 ^LRD(65
10 ; DBIA 10015 EN^DIQ1 (file #65)
11 ;
12XTRCT ; Extract Blood Availability
13 N I1,UN,CNT S CNT=0 K ^TMP("LRB",$J)
14 I $L($P(^LR(LRDFN,0),U,5,6)) S ^TMP("LRB",$J,0)=$P(^(0),U,5)_U_$P(^(0),U,6)
15 S UN="" F S UN=$O(^LRD(65,"AP",LRDFN,UN)) Q:UN=""!(CNT'<MAX) D BASET
16 Q
17BASET ; Sets ^TMP("LRB",$J, with data elements
18 N ADT,DA,DIC,DIQ,DON,DR,EFLG,EDT,UID,UDIV,DTYP,COMP,ABO,RH,VOL,XDT,XMR,XMATCH
19 N IDT,GMI,ULOC
20 S (ADT,EFLG,EDT,UID,DTYP,COMP,ABO,RH,VOL,XMR,ULOC)=""
21 S UID=$P(^LRD(65,UN,0),U),EDT=$P(^(0),U,6),ABO=$P(^(0),U,7),RH=$P(^(0),U,8),VOL=$P(^(0),U,11),COMP=$P(^LAB(66,$P(^LRD(65,UN,0),U,4),0),U)
22 S ADT=$P(^LRD(65,UN,2,LRDFN,0),U,2)
23 S UDIV=$P(^LRD(65,UN,0),U,16),UDIV=$S(UDIV'="":$P(^DIC(4,UDIV,0),U),1:UDIV) ;Gets division unit is located at
24 I $D(^LRD(65,UN,8)) S DIC=65,DIQ="DON",DIQ(0)="E",DR=8.3,DA=UN D EN^DIQ1 S:$D(DON) DTYP=DON(65,UN,8.3,"E")
25 S GMI=$O(^LRD(65,UN,3,0)) I +GMI>0 D
26 . S ULOC=$P($G(^LRD(65,UN,3,GMI,0)),U,4)
27 ; If unit will expire w/in 48 hrs, flag with "*"
28 ; w/in 24 hrs, flag with "**"
29 I EDT>DT S EFLG=$S(EDT-DT<2:"*",EDT-DT<1:"**",1:"")
30 S IDT=9999999-ADT
31 I $S(IDT<GMTS1:1,IDT>GMTS2:1,EDT<DT:1,1:0) Q
32 S X=EDT D REGDT4^GMTSU S EDT=X K X
33 F Q:'$D(^TMP("LRB",$J,IDT)) S IDT=IDT+.0001
34 S ^TMP("LRB",$J,IDT)=EFLG_U_EDT_U_UID_U_COMP_U_VOL_U_ABO_U_RH_U_DTYP_U_UDIV_U_ULOC
35 S CNT=CNT+1
36 Q
Note: See TracBrowser for help on using the repository browser.