- 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
