BLRRLMUU ; IHS/MSC/MKK - Reference Lab Meaningful Use Utilities ; 22-Oct-2013 09:22 ; MKK
;;5.2;IHS LABORATORY;**1033**;NOV 1, 1997
;
RELAHMID(UID) ; EP - For INCOMING messages, Return the IEN into the ^LAHM(62.49 global for the given UID, if it exists
NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,LRPARAM,IOXY,TESTDESC,U,UID,XPARSYS,XQXFLG)
;
S IEN="AAA",FOUNDIT=0
; Reverse Order thorugh 62.49 so as to find the latest IEN
F S IEN=$O(^LAHM(62.49,IEN),-1) Q:IEN<1!(FOUNDIT) D
. Q:$P($G(^LAHM(62.49,IEN,0)),"^",2)'="I" ; Only INCOMING messages
. ;
. S CNT=0
. F S CNT=$O(^LAHM(62.49,IEN,150,CNT)) Q:CNT<1!(FOUNDIT) D
.. S STR=$G(^LAHM(62.49,IEN,150,CNT,0))
.. S:$P(STR,"|")="OBR"&($P($P(STR,"|",3),"^")=UID) FOUNDIT=IEN
;
Q FOUNDIT
;
SHL7SEGS(UID) ; EP - Store UID's HL7 Segment numbers for Later Analysis
NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,LRPARAM,IOXY,TESTDESC,U,UID,XPARSYS,XQXFLG)
;
; Don't redo if already created
I $D(^TMP("BLRRLMUU",$J,UID)) Q $O(^TMP("BLRRLMUU",$J,UID,0))
;
S IEN=$$RELAHMID(UID)
Q:IEN<1 0
;
; Don't redo if already created
Q:$D(^TMP("BLRRLMUU",$J,UID,IEN)) IEN
;
S CNT=0
F S CNT=$O(^LAHM(62.49,IEN,150,CNT)) Q:CNT<1 D
. S SEG=$P($G(^LAHM(62.49,IEN,150,CNT,0)),"|")
. Q:$L(SEG)<1
. S ^TMP("BLRRLMUU",$J,UID,IEN,SEG,CNT)=""
Q IEN
;
GETCANCL(UID) ; EP - Get Cancel reason from SPM segment in LAHM 62.49
NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,LRPARAM,IOXY,TESTDESC,U,UID,XPARSYS,XQXFLG)
;
S IEN=$$SHL7SEGS(UID)
Q:IEN<1 ""
;
S WHERE=+$O(^TMP("BLRRLMUU",$J,UID,IEN,"SPM",0))
Q:WHERE<1 ""
;
Q $P($P($G(^LAHM(62.49,IEN,150,WHERE,0)),"|",22),"^",2)
;
LABSTOR(LRDFN,LRSS,LRIDT) ; EP - Store 62.49 IEN
NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,LRDFN,LRSS,LRIDT,U,XPARSYS,XQXFLG)
;
S LRUID=+$G(^LR(LRDFN,LRSS,LRIDT,"ORU")) ; Get UID
Q:LRUID<1
;
S P6249=$$RELAHMID^BLRRLMUU(LRUID)
;
S:+P2649 ^LR(LRDFN,LRSS,LRIDT,"HL7")=P2649_"^"
Q
;
; ================== ^LAH routines follow
;
RETLAHID(UID) ; EP - Return the IEN into the ^LAH global for the given UID, if it exists
NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,LRPARAM,IOXY,TESTDESC,U,UID,XPARSYS,XQXFLG)
;
S IEN="AAA",FOUNDIT=0
F S IEN=$O(^LAH(IEN),-1) Q:IEN<1!(FOUNDIT) D
. S:$O(^LAH(IEN,1,"U",""))=UID FOUNDIT=IEN
;
Q FOUNDIT
BLRRLMUU ; IHS/MSC/MKK - Reference Lab Meaningful Use Utilities ; 22-Oct-2013 09:22 ; MKK
+1 ;;5.2;IHS LABORATORY;**1033**;NOV 1, 1997
+2 ;
RELAHMID(UID) ; EP - For INCOMING messages, Return the IEN into the ^LAHM(62.49 global for the given UID, if it exists
+1 NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,LRPARAM,IOXY,TESTDESC,U,UID,XPARSYS,XQXFLG)
+2 ;
+3 SET IEN="AAA"
SET FOUNDIT=0
+4 ; Reverse Order thorugh 62.49 so as to find the latest IEN
+5 FOR
SET IEN=$ORDER(^LAHM(62.49,IEN),-1)
IF IEN<1!(FOUNDIT)
QUIT
Begin DoDot:1
+6 ; Only INCOMING messages
IF $PIECE($GET(^LAHM(62.49,IEN,0)),"^",2)'="I"
QUIT
+7 ;
+8 SET CNT=0
+9 FOR
SET CNT=$ORDER(^LAHM(62.49,IEN,150,CNT))
IF CNT<1!(FOUNDIT)
QUIT
Begin DoDot:2
+10 SET STR=$GET(^LAHM(62.49,IEN,150,CNT,0))
+11 IF $PIECE(STR,"|")="OBR"&($PIECE($PIECE(STR,"|",3),"^")=UID)
SET FOUNDIT=IEN
End DoDot:2
End DoDot:1
+12 ;
+13 QUIT FOUNDIT
+14 ;
SHL7SEGS(UID) ; EP - Store UID's HL7 Segment numbers for Later Analysis
+1 NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,LRPARAM,IOXY,TESTDESC,U,UID,XPARSYS,XQXFLG)
+2 ;
+3 ; Don't redo if already created
+4 IF $DATA(^TMP("BLRRLMUU",$JOB,UID))
QUIT $ORDER(^TMP("BLRRLMUU",$JOB,UID,0))
+5 ;
+6 SET IEN=$$RELAHMID(UID)
+7 IF IEN<1
QUIT 0
+8 ;
+9 ; Don't redo if already created
+10 IF $DATA(^TMP("BLRRLMUU",$JOB,UID,IEN))
QUIT IEN
+11 ;
+12 SET CNT=0
+13 FOR
SET CNT=$ORDER(^LAHM(62.49,IEN,150,CNT))
IF CNT<1
QUIT
Begin DoDot:1
+14 SET SEG=$PIECE($GET(^LAHM(62.49,IEN,150,CNT,0)),"|")
+15 IF $LENGTH(SEG)<1
QUIT
+16 SET ^TMP("BLRRLMUU",$JOB,UID,IEN,SEG,CNT)=""
End DoDot:1
+17 QUIT IEN
+18 ;
GETCANCL(UID) ; EP - Get Cancel reason from SPM segment in LAHM 62.49
+1 NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,LRPARAM,IOXY,TESTDESC,U,UID,XPARSYS,XQXFLG)
+2 ;
+3 SET IEN=$$SHL7SEGS(UID)
+4 IF IEN<1
QUIT ""
+5 ;
+6 SET WHERE=+$ORDER(^TMP("BLRRLMUU",$JOB,UID,IEN,"SPM",0))
+7 IF WHERE<1
QUIT ""
+8 ;
+9 QUIT $PIECE($PIECE($GET(^LAHM(62.49,IEN,150,WHERE,0)),"|",22),"^",2)
+10 ;
LABSTOR(LRDFN,LRSS,LRIDT) ; EP - Store 62.49 IEN
+1 NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,LRDFN,LRSS,LRIDT,U,XPARSYS,XQXFLG)
+2 ;
+3 ; Get UID
SET LRUID=+$GET(^LR(LRDFN,LRSS,LRIDT,"ORU"))
+4 IF LRUID<1
QUIT
+5 ;
+6 SET P6249=$$RELAHMID^BLRRLMUU(LRUID)
+7 ;
+8 IF +P2649
SET ^LR(LRDFN,LRSS,LRIDT,"HL7")=P2649_"^"
+9 QUIT
+10 ;
+11 ; ================== ^LAH routines follow
+12 ;
RETLAHID(UID) ; EP - Return the IEN into the ^LAH global for the given UID, if it exists
+1 NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,LRPARAM,IOXY,TESTDESC,U,UID,XPARSYS,XQXFLG)
+2 ;
+3 SET IEN="AAA"
SET FOUNDIT=0
+4 FOR
SET IEN=$ORDER(^LAH(IEN),-1)
IF IEN<1!(FOUNDIT)
QUIT
Begin DoDot:1
+5 IF $ORDER(^LAH(IEN,1,"U",""))=UID
SET FOUNDIT=IEN
End DoDot:1
+6 ;
+7 QUIT FOUNDIT
