GMTSLROE ; SLC/JER,KER - Lab Orders Extract Routine ; 09/21/2001
 ;;2.7;Health Summary;**9,28,47**;Oct 20, 1995
 ;
 ; External References
 ;   DBIA 10035  ^DPT(
 ;   DBIA   525  ^LR(
 ;   DBIA   532  ^LRO(69,
 ;   DBIA   524  ^LAB(61,
 ;   DBIA    67  ^LAB(60
 ;   DBIA   530  ^LAB(62.05,
 ;   DBIA   531  ^LRO(68,
 ;   DBIA 10142  $$VERSION^XPDUTL
 ;                 
XTRCT ; Gets lab orders and loads them into GMTSLRO local array
 N LRDFN,GMI,CD,ID,SN,TN K ^TMP("LROI",$J)
 K ^TMP("LRO",$J)
 Q:'$D(^DPT(DFN,"LR"))  S LRDFN=+^DPT(DFN,"LR") Q:'$D(^LR(LRDFN))
 S CD=GMTSBEG-.1
 F  S CD=$O(^LRO(69,"D",LRDFN,CD)) Q:CD'>0!(CD>GMTSEND)  S SN=0 F  S SN=$O(^LRO(69,"D",LRDFN,CD,SN)) Q:SN'>0  S TN=0 F  S TN=$O(^LRO(69,CD,1,SN,2,TN)) Q:TN'>0  S ^TMP("LROI",$J,9999999-CD,SN,TN)=""
 S (GMI,ID)=0 F  S ID=$O(^TMP("LROI",$J,ID)) Q:ID'>0!(GMI=MAX)  S CD=9999999-ID,SN=0 F  S SN=$O(^TMP("LROI",$J,ID,SN)) Q:SN'>0!(GMI=MAX)  S TN=0 F  S TN=$O(^TMP("LROI",$J,ID,SN,TN)) Q:TN'>0!(GMI=MAX)  D SET
 K ^TMP("LROI",$J)
 Q
SET ; Sets ^TMP("LRO",$J, w/appropriate data
 N SPST,CST,OS,CDT,SPST,FST,RDT,SITE,SPEC,TST,IDT,COLL,ODT,MD,CS,URG,ACC
 N RL,TEST
 I $D(^LRO(69,CD,1,SN,0)) S SPST=^(0) D ORDER
 I $D(^LRO(69,CD,1,SN,1)) S CST=^(1) D COLLECT I 1
 E  S OS="ORDERED",X=$P(^LRO(69,CD,1,SN,0),U,8),IDT=9999999-X D REGDTM4^GMTSU S CDT=X K X
 I $D(^LRO(69,CD,1,SN,3)) S FST=^(3) D RESULT I 1
 E  S RDT="UNKNOWN"
 S SITE=+$G(^LRO(69,CD,1,SN,4,+$O(^LRO(69,CD,1,SN,4,0)),0)),SPEC=$S(SITE>0:SITE_";"_$P(^LAB(61,SITE,0),U),1:";UNKNOWN")
 I $D(^LRO(69,CD,1,SN,2,TN,0)) S TST=^(0) S:$P(TST,"^",9)="CA" OS="CANCELED" D TEST
 I $D(BADTEST) K BADTEST Q
 I $D(IDT),$D(SN),$D(TN) S ^TMP("LRO",$J,IDT,SN_TN)=CDT_U_TEST_U_SPEC_U_URG_U_OS_U_MD_U_ODT_U_ACC_U_RDT_U_COLL_U_CD,GMI=GMI+1
 Q
ORDER ; Get Orders
 N IFN,FNF,FILE,NM,NSPACE,PKG,X
 S COLL=$S($L($P(SPST,U,4)):$P(SPST,U,4),1:"UNKNOWN")
 S:"LW"[COLL COLL=$S(COLL="L":"LAB",1:"WARD")
 S X=$P(SPST,U,5) D REGDTM4^GMTSU S ODT=X
 S (MD,IFN)=$P(SPST,U,6),FNF=0,NSPACE="LR"
 S PKG=$$VERSION^XPDUTL(NSPACE),FILE=$S($G(PKG)<5.2:6,1:200)
 S NM=$$NAME^GMTSU(MD,0,10) S MD=MD_";"_NM
 S RL=$P(SPST,U,7) Q
COLLECT ; Collection Date and Time
 N X S X=$P(CST,U),IDT=9999999-X D REGDTM4^GMTSU S CDT=X,CS=$P(CST,U,4),OS="COLLECTED"
 Q
RESULT ; Result Date and Time
 N X S X=$P(FST,U,2) D REGDTM4^GMTSU S RDT=X
 Q
TEST ; Lab Test Ordered
 N TPTR,UPTR,ACCD,ACCA,ACCN
 S TPTR=+TST,UPTR=$P(TST,U,2),ACCD=$P(TST,U,3)
 I $D(TPTR),(TPTR'>0) S BADTEST=1 Q
 S ACCA=$P(TST,U,4),ACCN=$P(TST,U,5)
 S TEST=TPTR_";"_$S($L($P(^LAB(60,TPTR,0),U))<21:$P(^(0),U),1:$P(^(.1),U))
 S URG=$E($S($D(^LAB(62.05,+UPTR,0)):$P(^(0),U),1:""),1,7)
 I $S('$D(ACCD):1,'$L(ACCA):1,'$L(ACCD):1,1:0) S ACC="NONE" Q
 S ACC=$S($D(^LRO(68,+ACCA,1,+ACCD,1,+ACCN,.2)):^(.2),1:"NONE")
 I $D(^LRO(68,+ACCA,1,+ACCD,1,+ACCN,4,TPTR,0)) S X=$P(^(0),U,5) S OS=$S('$L(X):"PROCESSING",1:"COMPLETED")
 Q