- NHINVLR ;SLC/MKB -- Laboratory extract
- ;;1.0;NHIN;**1**;Oct 25, 2010;Build 11
- ;
- ; External References DBIA#
- ; ------------------- -----
- ; ^DPT 10035
- ; ^LAB(60 10054
- ; ^LRO(69 2407
- ; ^LR 525
- ; DIC 2051
- ; DIQ 2056
- ; LR7OR1,^TMP("LRRR",$J) 2503
- ;
- ; ------------ Get results from VistA ------------
- ;
- EN(DFN,BEG,END,MAX,ID) ; -- find patient's lab results
- N NHSUB,NHIDT,NHI,NHITM,LRDFN,SUB
- S DFN=+$G(DFN) Q:$G(DFN)<1
- S BEG=$G(BEG,1410101),END=$G(END,9999998),MAX=$G(MAX,999999)
- K ^TMP("LRRR",$J,DFN) S LRDFN=$G(^DPT(DFN,"LR")),NHSUB="CH"
- ;
- ; get result(s)
- I $L($G(ID)) D Q:NHI ;done
- . S NHSUB=$P(ID,";"),NHIDT=+$P(ID,";",2),(BEG,END)=9999999-NHIDT
- . S NHI=$P(ID,";",3) I NHI D ;skip loop - single result
- .. D RR^LR7OR1(DFN,,BEG,END,NHSUB)
- .. S SUB=$S("CH^MI"[NHSUB:NHSUB,1:"AP")_"(.NHITM)"
- .. D @SUB,XML(.NHITM)
- .. K ^TMP("LRRR",$J,DFN)
- ;
- D RR^LR7OR1(DFN,,BEG,END,NHSUB,,,MAX)
- S NHSUB="" F S NHSUB=$O(^TMP("LRRR",$J,DFN,NHSUB)) Q:NHSUB="" D
- . S NHIDT=0 F S NHIDT=$O(^TMP("LRRR",$J,DFN,NHSUB,NHIDT)) Q:NHIDT<1 D
- .. S NHI=0 F S NHI=$O(^TMP("LRRR",$J,DFN,NHSUB,NHIDT,NHI)) Q:NHI<1 D
- ... K NHITM S SUB=$S("CH^MI"[NHSUB:NHSUB,1:"AP")_"(.NHITM)"
- ... D @SUB,XML(.NHITM)
- K ^TMP("LRRR",$J,DFN)
- Q
- ;
- CH(LAB) ; -- return a Chemistry result in LAB("attribute")=value
- ; Expects ^TMP("LRRR",$J,DFN,"CH",NHIDT,NHI),LRDFN
- N CDT,LR0,LRI,X0,X,LOINC,ORD,CMMT K LAB
- S LAB("id")="CH;"_NHIDT_";"_NHI,LAB("type")="CH"
- S CDT=9999999-NHIDT,LAB("collected")=CDT
- S LR0=$G(^LR(LRDFN,"CH",NHIDT,0)),LRI=$G(^(NHI))
- S LAB("status")="completed",LAB("resulted")=$P(LR0,U,3)
- S X0=$G(^TMP("LRRR",$J,DFN,"CH",NHIDT,NHI))
- S LAB("test")=$P($G(^LAB(60,+X0,0)),U) ;$P(X0,U,10)?
- S:$L($P(X0,U,2)) LAB("result")=$P(X0,U,2)
- S:$L($P(X0,U,4)) LAB("units")=$P(X0,U,4)
- S:$L($P(X0,U,3)) LAB("interpretation")=$P(X0,U,3)
- S X=$P(X0,U,5) I $L(X),X["-" S LAB("low")=$P(X,"-"),LAB("high")=$P(X,"-",2)
- S LAB("localName")=$S($L($P(X0,U,15)):$P(X0,U,15),1:LAB("test"))
- S LAB("groupName")=$P(X0,U,16) ;accession#
- S X=$P($P(LRI,U,3),"!",3) S:X LOINC=$$GET1^DIQ(95.3,X_",",.01)
- S X=+$P(X0,U,19) I X D ;specimen
- . N VUID,IENS,NHY S VUID="",IENS=X_","
- . D GETS^DIQ(61,IENS,".01;2",,"NHY")
- . S LAB("specimen")=$G(NHY(61,IENS,2))_U_$G(NHY(61,IENS,.01)) ;SNOMED^name
- . S LAB("sample")=$$GET1^DIQ(61,X_",",4.1) ;name
- . ; LOINC=+$G(^LAB(60,+X0,1,X,95.3))
- . S:'$G(LOINC) LOINC=$$GET1^DIQ(60.01,X_","_+X0_",",95.3)
- . I LOINC S LAB("loinc")=LOINC,VUID=$$VUID^NHINV(+LOINC,95.3)
- . S:VUID LAB("vuid")=VUID
- S ORD=+$P(X0,U,17) S:ORD LAB("labOrderID")=ORD
- S X=$$ORDER(ORD,+X0) S:X LAB("orderID")=X
- S X=$P(LR0,U,14)
- S:X LAB("facility")=$$STA^XUAF4(X)_U_$P($$NS^XUAF4(X),U)
- I 'X S LAB("facility")=$$FAC^NHINV ;local stn#^name
- I $D(^TMP("LRRR",$J,DFN,"CH",NHIDT,"N")) M CMMT=^("N") S LAB("comment")=$$STRING^NHINV(.CMMT)
- Q
- ;
- ORDER(LABORD,TEST) ; -- return #100 order for Lab order# & Test
- N Y,D,S,T S Y=""
- S D=$O(^LRO(69,"C",LABORD,0)) I D D
- . S S=0 F S S=$O(^LRO(69,"C",LABORD,D,S)) Q:S<1 D
- .. S T=0 F S T=$O(^LRO(69,D,1,S,2,T)) Q:T<1 I +$G(^(T,0))=TEST S Y=+$P(^(0),U,7)
- Q Y
- ;
- MI(LAB) ; -- return a Microbiology result in LAB("attribute")=value
- ; Expects ^TMP("LRRR",$J,DFN,"MI",NHIDT,NHI),LRDFN
- N ID,CDT,X0,X,CMMT,LR0 K LAB
- S X0=$G(^TMP("LRRR",$J,DFN,"MI",NHIDT,NHI)) Q:$L($P(X0,U))'>1
- S LAB("id")="MI;"_NHIDT_"#"_NHI,LAB("status")="completed"
- S LAB("type")="MI",CDT=9999999-NHIDT,LAB("collected")=CDT
- S LR0=$G(^LR(LRDFN,"MI",NHIDT,0)),LAB("resulted")=$P(LR0,U,3)
- S:$L($P(X0,U,2)) LAB("result")=$P(X0,U,2)
- S:$L($P(X0,U,4)) LAB("units")=$P(X0,U,4)
- S:$L($P(X0,U,3)) LAB("interpretation")=$P(X0,U,3)
- S (LAB("test"),LAB("localName"))=$P(X0,U,15)
- S X=+$P(X0,U,19) I X D ;specimen
- . N IENS,NHY S IENS=X_","
- . D GETS^DIQ(61,IENS,".01;2",,"NHY")
- . S LAB("specimen")=$G(NHY(61,IENS,2))_U_$G(NHY(61,IENS,.01)) ;SNOMED^name
- . S LAB("sample")=$$GET1^DIQ(61,X_",",4.1) ;name
- S X=$P(LR0,U,14)
- S:X LAB("facility")=$$STA^XUAF4(X)_U_$P($$NS^XUAF4(X),U)
- I 'X S LAB("facility")=$$FAC^NHINV ;local stn#^name
- I $D(^TMP("LRRR",$J,DFN,"MI",NHIDT,"N")) M CMMT=^("N") S LAB("comment")=$$STRING^NHINV(.CMMT)
- Q
- ;
- AP(LAB) ; -- return a Pathology result in LAB("attribute")=value
- K LAB ;not implemented yet
- Q
- ;
- TYPE(X) ; -- Return name of lab section
- N NHIY,Y S Y=X
- D FIND^DIC(68,,.01,"PQX",X,,"B",,,"NHIY")
- S:$G(NHIY("DILIST",1,0)) Y=$P(NHIY("DILIST",1,0),U,2) ;name
- Q Y
- ;
- ; ------------ Return data to middle tier ------------
- ;
- XML(LAB) ; -- Return result as XML in @NHIN@(#)
- N ATT,X,Y,P,NAMES,TAG
- D ADD("<lab>") S NHINTOTL=$G(NHINTOTL)+1
- S ATT="" F S ATT=$O(LAB(ATT)) Q:ATT="" D D:$L(Y) ADD(Y)
- . S X=$G(LAB(ATT)),Y="" Q:'$L(X)
- . I ATT="comment" S Y="<"_ATT_" xml:space='preserve'>"_$$ESC^NHINV(X)_"</"_ATT_">" Q
- . I X'["^" S Y="<"_ATT_" value='"_$$ESC^NHINV(X)_"' />" Q
- . I $L(X)>1 D S Y=""
- .. S Y="<"_ATT_" ",NAMES="code^name^Z"
- .. F P=1:1 S TAG=$P(NAMES,U,P) Q:TAG="Z" I $L($P(X,U,P)) S Y=Y_TAG_"='"_$$ESC^NHINV($P(X,U,P))_"' "
- .. S Y=Y_"/>" D ADD(Y)
- D ADD("</lab>")
- Q
- ;
- ADD(X) ; -- Add a line @NHIN@(n)=X
- S NHINI=$G(NHINI)+1
- S @NHIN@(NHINI)=X
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNHINVLR 5395 printed Mar 13, 2025@21:22:20 Page 2
- NHINVLR ;SLC/MKB -- Laboratory extract
- +1 ;;1.0;NHIN;**1**;Oct 25, 2010;Build 11
- +2 ;
- +3 ; External References DBIA#
- +4 ; ------------------- -----
- +5 ; ^DPT 10035
- +6 ; ^LAB(60 10054
- +7 ; ^LRO(69 2407
- +8 ; ^LR 525
- +9 ; DIC 2051
- +10 ; DIQ 2056
- +11 ; LR7OR1,^TMP("LRRR",$J) 2503
- +12 ;
- +13 ; ------------ Get results from VistA ------------
- +14 ;
- EN(DFN,BEG,END,MAX,ID) ; -- find patient's lab results
- +1 NEW NHSUB,NHIDT,NHI,NHITM,LRDFN,SUB
- +2 SET DFN=+$GET(DFN)
- if $GET(DFN)<1
- QUIT
- +3 SET BEG=$GET(BEG,1410101)
- SET END=$GET(END,9999998)
- SET MAX=$GET(MAX,999999)
- +4 KILL ^TMP("LRRR",$JOB,DFN)
- SET LRDFN=$GET(^DPT(DFN,"LR"))
- SET NHSUB="CH"
- +5 ;
- +6 ; get result(s)
- +7 ;done
- IF $LENGTH($GET(ID))
- Begin DoDot:1
- +8 SET NHSUB=$PIECE(ID,";")
- SET NHIDT=+$PIECE(ID,";",2)
- SET (BEG,END)=9999999-NHIDT
- +9 ;skip loop - single result
- SET NHI=$PIECE(ID,";",3)
- IF NHI
- Begin DoDot:2
- +10 DO RR^LR7OR1(DFN,,BEG,END,NHSUB)
- +11 SET SUB=$SELECT("CH^MI"[NHSUB:NHSUB,1:"AP")_"(.NHITM)"
- +12 DO @SUB
- DO XML(.NHITM)
- +13 KILL ^TMP("LRRR",$JOB,DFN)
- End DoDot:2
- End DoDot:1
- if NHI
- QUIT
- +14 ;
- +15 DO RR^LR7OR1(DFN,,BEG,END,NHSUB,,,MAX)
- +16 SET NHSUB=""
- FOR
- SET NHSUB=$ORDER(^TMP("LRRR",$JOB,DFN,NHSUB))
- if NHSUB=""
- QUIT
- Begin DoDot:1
- +17 SET NHIDT=0
- FOR
- SET NHIDT=$ORDER(^TMP("LRRR",$JOB,DFN,NHSUB,NHIDT))
- if NHIDT<1
- QUIT
- Begin DoDot:2
- +18 SET NHI=0
- FOR
- SET NHI=$ORDER(^TMP("LRRR",$JOB,DFN,NHSUB,NHIDT,NHI))
- if NHI<1
- QUIT
- Begin DoDot:3
- +19 KILL NHITM
- SET SUB=$SELECT("CH^MI"[NHSUB:NHSUB,1:"AP")_"(.NHITM)"
- +20 DO @SUB
- DO XML(.NHITM)
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +21 KILL ^TMP("LRRR",$JOB,DFN)
- +22 QUIT
- +23 ;
- CH(LAB) ; -- return a Chemistry result in LAB("attribute")=value
- +1 ; Expects ^TMP("LRRR",$J,DFN,"CH",NHIDT,NHI),LRDFN
- +2 NEW CDT,LR0,LRI,X0,X,LOINC,ORD,CMMT
- KILL LAB
- +3 SET LAB("id")="CH;"_NHIDT_";"_NHI
- SET LAB("type")="CH"
- +4 SET CDT=9999999-NHIDT
- SET LAB("collected")=CDT
- +5 SET LR0=$GET(^LR(LRDFN,"CH",NHIDT,0))
- SET LRI=$GET(^(NHI))
- +6 SET LAB("status")="completed"
- SET LAB("resulted")=$PIECE(LR0,U,3)
- +7 SET X0=$GET(^TMP("LRRR",$JOB,DFN,"CH",NHIDT,NHI))
- +8 ;$P(X0,U,10)?
- SET LAB("test")=$PIECE($GET(^LAB(60,+X0,0)),U)
- +9 if $LENGTH($PIECE(X0,U,2))
- SET LAB("result")=$PIECE(X0,U,2)
- +10 if $LENGTH($PIECE(X0,U,4))
- SET LAB("units")=$PIECE(X0,U,4)
- +11 if $LENGTH($PIECE(X0,U,3))
- SET LAB("interpretation")=$PIECE(X0,U,3)
- +12 SET X=$PIECE(X0,U,5)
- IF $LENGTH(X)
- IF X["-"
- SET LAB("low")=$PIECE(X,"-")
- SET LAB("high")=$PIECE(X,"-",2)
- +13 SET LAB("localName")=$SELECT($LENGTH($PIECE(X0,U,15)):$PIECE(X0,U,15),1:LAB("test"))
- +14 ;accession#
- SET LAB("groupName")=$PIECE(X0,U,16)
- +15 SET X=$PIECE($PIECE(LRI,U,3),"!",3)
- if X
- SET LOINC=$$GET1^DIQ(95.3,X_",",.01)
- +16 ;specimen
- SET X=+$PIECE(X0,U,19)
- IF X
- Begin DoDot:1
- +17 NEW VUID,IENS,NHY
- SET VUID=""
- SET IENS=X_","
- +18 DO GETS^DIQ(61,IENS,".01;2",,"NHY")
- +19 ;SNOMED^name
- SET LAB("specimen")=$GET(NHY(61,IENS,2))_U_$GET(NHY(61,IENS,.01))
- +20 ;name
- SET LAB("sample")=$$GET1^DIQ(61,X_",",4.1)
- +21 ; LOINC=+$G(^LAB(60,+X0,1,X,95.3))
- +22 if '$GET(LOINC)
- SET LOINC=$$GET1^DIQ(60.01,X_","_+X0_",",95.3)
- +23 IF LOINC
- SET LAB("loinc")=LOINC
- SET VUID=$$VUID^NHINV(+LOINC,95.3)
- +24 if VUID
- SET LAB("vuid")=VUID
- End DoDot:1
- +25 SET ORD=+$PIECE(X0,U,17)
- if ORD
- SET LAB("labOrderID")=ORD
- +26 SET X=$$ORDER(ORD,+X0)
- if X
- SET LAB("orderID")=X
- +27 SET X=$PIECE(LR0,U,14)
- +28 if X
- SET LAB("facility")=$$STA^XUAF4(X)_U_$PIECE($$NS^XUAF4(X),U)
- +29 ;local stn#^name
- IF 'X
- SET LAB("facility")=$$FAC^NHINV
- +30 IF $DATA(^TMP("LRRR",$JOB,DFN,"CH",NHIDT,"N"))
- MERGE CMMT=^("N")
- SET LAB("comment")=$$STRING^NHINV(.CMMT)
- +31 QUIT
- +32 ;
- ORDER(LABORD,TEST) ; -- return #100 order for Lab order# & Test
- +1 NEW Y,D,S,T
- SET Y=""
- +2 SET D=$ORDER(^LRO(69,"C",LABORD,0))
- IF D
- Begin DoDot:1
- +3 SET S=0
- FOR
- SET S=$ORDER(^LRO(69,"C",LABORD,D,S))
- if S<1
- QUIT
- Begin DoDot:2
- +4 SET T=0
- FOR
- SET T=$ORDER(^LRO(69,D,1,S,2,T))
- if T<1
- QUIT
- IF +$GET(^(T,0))=TEST
- SET Y=+$PIECE(^(0),U,7)
- End DoDot:2
- End DoDot:1
- +5 QUIT Y
- +6 ;
- MI(LAB) ; -- return a Microbiology result in LAB("attribute")=value
- +1 ; Expects ^TMP("LRRR",$J,DFN,"MI",NHIDT,NHI),LRDFN
- +2 NEW ID,CDT,X0,X,CMMT,LR0
- KILL LAB
- +3 SET X0=$GET(^TMP("LRRR",$JOB,DFN,"MI",NHIDT,NHI))
- if $LENGTH($PIECE(X0,U))'>1
- QUIT
- +4 SET LAB("id")="MI;"_NHIDT_"#"_NHI
- SET LAB("status")="completed"
- +5 SET LAB("type")="MI"
- SET CDT=9999999-NHIDT
- SET LAB("collected")=CDT
- +6 SET LR0=$GET(^LR(LRDFN,"MI",NHIDT,0))
- SET LAB("resulted")=$PIECE(LR0,U,3)
- +7 if $LENGTH($PIECE(X0,U,2))
- SET LAB("result")=$PIECE(X0,U,2)
- +8 if $LENGTH($PIECE(X0,U,4))
- SET LAB("units")=$PIECE(X0,U,4)
- +9 if $LENGTH($PIECE(X0,U,3))
- SET LAB("interpretation")=$PIECE(X0,U,3)
- +10 SET (LAB("test"),LAB("localName"))=$PIECE(X0,U,15)
- +11 ;specimen
- SET X=+$PIECE(X0,U,19)
- IF X
- Begin DoDot:1
- +12 NEW IENS,NHY
- SET IENS=X_","
- +13 DO GETS^DIQ(61,IENS,".01;2",,"NHY")
- +14 ;SNOMED^name
- SET LAB("specimen")=$GET(NHY(61,IENS,2))_U_$GET(NHY(61,IENS,.01))
- +15 ;name
- SET LAB("sample")=$$GET1^DIQ(61,X_",",4.1)
- End DoDot:1
- +16 SET X=$PIECE(LR0,U,14)
- +17 if X
- SET LAB("facility")=$$STA^XUAF4(X)_U_$PIECE($$NS^XUAF4(X),U)
- +18 ;local stn#^name
- IF 'X
- SET LAB("facility")=$$FAC^NHINV
- +19 IF $DATA(^TMP("LRRR",$JOB,DFN,"MI",NHIDT,"N"))
- MERGE CMMT=^("N")
- SET LAB("comment")=$$STRING^NHINV(.CMMT)
- +20 QUIT
- +21 ;
- AP(LAB) ; -- return a Pathology result in LAB("attribute")=value
- +1 ;not implemented yet
- KILL LAB
- +2 QUIT
- +3 ;
- TYPE(X) ; -- Return name of lab section
- +1 NEW NHIY,Y
- SET Y=X
- +2 DO FIND^DIC(68,,.01,"PQX",X,,"B",,,"NHIY")
- +3 ;name
- if $GET(NHIY("DILIST",1,0))
- SET Y=$PIECE(NHIY("DILIST",1,0),U,2)
- +4 QUIT Y
- +5 ;
- +6 ; ------------ Return data to middle tier ------------
- +7 ;
- XML(LAB) ; -- Return result as XML in @NHIN@(#)
- +1 NEW ATT,X,Y,P,NAMES,TAG
- +2 DO ADD("<lab>")
- SET NHINTOTL=$GET(NHINTOTL)+1
- +3 SET ATT=""
- FOR
- SET ATT=$ORDER(LAB(ATT))
- if ATT=""
- QUIT
- Begin DoDot:1
- +4 SET X=$GET(LAB(ATT))
- SET Y=""
- if '$LENGTH(X)
- QUIT
- +5 IF ATT="comment"
- SET Y="<"_ATT_" xml:space='preserve'>"_$$ESC^NHINV(X)_"</"_ATT_">"
- QUIT
- +6 IF X'["^"
- SET Y="<"_ATT_" value='"_$$ESC^NHINV(X)_"' />"
- QUIT
- +7 IF $LENGTH(X)>1
- Begin DoDot:2
- +8 SET Y="<"_ATT_" "
- SET NAMES="code^name^Z"
- +9 FOR P=1:1
- SET TAG=$PIECE(NAMES,U,P)
- if TAG="Z"
- QUIT
- IF $LENGTH($PIECE(X,U,P))
- SET Y=Y_TAG_"='"_$$ESC^NHINV($PIECE(X,U,P))_"' "
- +10 SET Y=Y_"/>"
- DO ADD(Y)
- End DoDot:2
- SET Y=""
- End DoDot:1
- if $LENGTH(Y)
- DO ADD(Y)
- +11 DO ADD("</lab>")
- +12 QUIT
- +13 ;
- ADD(X) ; -- Add a line @NHIN@(n)=X
- +1 SET NHINI=$GET(NHINI)+1
- +2 SET @NHIN@(NHINI)=X
- +3 QUIT
