| 1 | GMTSLROE ; SLC/JER,KER - Lab Orders Extract Routine ; 09/21/2001
|
|---|
| 2 | ;;2.7;Health Summary;**9,28,47**;Oct 20, 1995
|
|---|
| 3 | ;
|
|---|
| 4 | ; External References
|
|---|
| 5 | ; DBIA 10035 ^DPT(
|
|---|
| 6 | ; DBIA 525 ^LR(
|
|---|
| 7 | ; DBIA 532 ^LRO(69,
|
|---|
| 8 | ; DBIA 524 ^LAB(61,
|
|---|
| 9 | ; DBIA 67 ^LAB(60
|
|---|
| 10 | ; DBIA 530 ^LAB(62.05,
|
|---|
| 11 | ; DBIA 531 ^LRO(68,
|
|---|
| 12 | ; DBIA 10142 $$VERSION^XPDUTL
|
|---|
| 13 | ;
|
|---|
| 14 | XTRCT ; Gets lab orders and loads them into GMTSLRO local array
|
|---|
| 15 | N LRDFN,GMI,CD,ID,SN,TN K ^TMP("LROI",$J)
|
|---|
| 16 | K ^TMP("LRO",$J)
|
|---|
| 17 | Q:'$D(^DPT(DFN,"LR")) S LRDFN=+^DPT(DFN,"LR") Q:'$D(^LR(LRDFN))
|
|---|
| 18 | S CD=GMTSBEG-.1
|
|---|
| 19 | 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)=""
|
|---|
| 20 | 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
|
|---|
| 21 | K ^TMP("LROI",$J)
|
|---|
| 22 | Q
|
|---|
| 23 | SET ; Sets ^TMP("LRO",$J, w/appropriate data
|
|---|
| 24 | N SPST,CST,OS,CDT,SPST,FST,RDT,SITE,SPEC,TST,IDT,COLL,ODT,MD,CS,URG,ACC
|
|---|
| 25 | N RL,TEST
|
|---|
| 26 | I $D(^LRO(69,CD,1,SN,0)) S SPST=^(0) D ORDER
|
|---|
| 27 | I $D(^LRO(69,CD,1,SN,1)) S CST=^(1) D COLLECT I 1
|
|---|
| 28 | 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
|
|---|
| 29 | I $D(^LRO(69,CD,1,SN,3)) S FST=^(3) D RESULT I 1
|
|---|
| 30 | E S RDT="UNKNOWN"
|
|---|
| 31 | 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")
|
|---|
| 32 | I $D(^LRO(69,CD,1,SN,2,TN,0)) S TST=^(0) S:$P(TST,"^",9)="CA" OS="CANCELED" D TEST
|
|---|
| 33 | I $D(BADTEST) K BADTEST Q
|
|---|
| 34 | 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
|
|---|
| 35 | Q
|
|---|
| 36 | ORDER ; Get Orders
|
|---|
| 37 | N IFN,FNF,FILE,NM,NSPACE,PKG,X
|
|---|
| 38 | S COLL=$S($L($P(SPST,U,4)):$P(SPST,U,4),1:"UNKNOWN")
|
|---|
| 39 | S:"LW"[COLL COLL=$S(COLL="L":"LAB",1:"WARD")
|
|---|
| 40 | S X=$P(SPST,U,5) D REGDTM4^GMTSU S ODT=X
|
|---|
| 41 | S (MD,IFN)=$P(SPST,U,6),FNF=0,NSPACE="LR"
|
|---|
| 42 | S PKG=$$VERSION^XPDUTL(NSPACE),FILE=$S($G(PKG)<5.2:6,1:200)
|
|---|
| 43 | S NM=$$NAME^GMTSU(MD,0,10) S MD=MD_";"_NM
|
|---|
| 44 | S RL=$P(SPST,U,7) Q
|
|---|
| 45 | COLLECT ; Collection Date and Time
|
|---|
| 46 | N X S X=$P(CST,U),IDT=9999999-X D REGDTM4^GMTSU S CDT=X,CS=$P(CST,U,4),OS="COLLECTED"
|
|---|
| 47 | Q
|
|---|
| 48 | RESULT ; Result Date and Time
|
|---|
| 49 | N X S X=$P(FST,U,2) D REGDTM4^GMTSU S RDT=X
|
|---|
| 50 | Q
|
|---|
| 51 | TEST ; Lab Test Ordered
|
|---|
| 52 | N TPTR,UPTR,ACCD,ACCA,ACCN
|
|---|
| 53 | S TPTR=+TST,UPTR=$P(TST,U,2),ACCD=$P(TST,U,3)
|
|---|
| 54 | I $D(TPTR),(TPTR'>0) S BADTEST=1 Q
|
|---|
| 55 | S ACCA=$P(TST,U,4),ACCN=$P(TST,U,5)
|
|---|
| 56 | S TEST=TPTR_";"_$S($L($P(^LAB(60,TPTR,0),U))<21:$P(^(0),U),1:$P(^(.1),U))
|
|---|
| 57 | S URG=$E($S($D(^LAB(62.05,+UPTR,0)):$P(^(0),U),1:""),1,7)
|
|---|
| 58 | I $S('$D(ACCD):1,'$L(ACCA):1,'$L(ACCD):1,1:0) S ACC="NONE" Q
|
|---|
| 59 | S ACC=$S($D(^LRO(68,+ACCA,1,+ACCD,1,+ACCN,.2)):^(.2),1:"NONE")
|
|---|
| 60 | 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")
|
|---|
| 61 | Q
|
|---|
