62 lines
2.8 KiB
Mathematica
62 lines
2.8 KiB
Mathematica
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
|