Routine: GMTSLROE

GMTSLROE ; SLC/JER,KER - Lab Orders Extract Routine ; 09/21/2001

 ;;2.7;Health Summary;**9,28,47,96,112**;Oct 20, 1995;Build 3

 ; 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  5466  ^LRJWLST

 ;   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)

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_U_$P(TST,U,7),GMI=GMI+1

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"

 S X=CS,OS=$S(X="C":"COLLECTED",X="U":"CANCELED",1:"On Collection List")

RESULT ; Result Date and Time

 N X S X=$P(FST,U,2) D REGDTM4^GMTSU S RDT=X

 I X S OS="COMPLETED"

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 $T(GETACC^LRJWLST)]"" D

 . N OACC

 . S OACC=$P($G(^LRO(69,CD,1,SN,2,TN,64.91)),"^",3)

 . I OACC]"" S ACC=OACC

 I $D(^LRO(68,+ACCA,1,+ACCD,1,+ACCN,4,TPTR,0)) S X=$P(^(0),U,5) I $G(OS)'="CANCELED",$G(OS)'="On Collection List" S OS=$S('$L(X):"PROCESSING",1:"COMPLETED")

GMTSLROE.m