NHINVLRA ;SLC/MKB -- Laboratory extract by accession
;;1.0;NHIN;**1**;Oct 25, 2010;Build 11
;
; External References DBIA#
; ------------------- -----
; ^DPT 10035
; ^LAB(60 10054
; ^LRO(69 2407
; ^LR 525
; ^VA(200 10060
; DIC 2051
; DIQ 2056
; LR7OR1,^TMP("LRRR",$J) 2503
; LR7OSUM,^TMP("LRC") 2766
; PXAPI 1894
; XUAF4 2171
;
; ------------ Get results from VistA ------------
;
EN(DFN,BEG,END,MAX,ID) ; -- find patient's lab results
N NHSUB,NHIDT,NHI,NHITM,LRDFN,LR0,ORD,X
S DFN=+$G(DFN) Q:$G(DFN)<1
S BEG=$G(BEG,1410101),END=$G(END,9999998),MAX=$G(MAX,999999)
S LRDFN=$G(^DPT(DFN,"LR")),NHSUB=""
K ^TMP("LRRR",$J,DFN)
;
; get result(s)
I $L($G(ID)) D ;reset search parameters
. S NHSUB=$P(ID,";"),NHIDT=+$P(ID,";",2)
. S:NHIDT (BEG,END)=9999999-NHIDT
;
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 I $O(^(NHIDT,0)) D
.. K NHITM,CMMT I "CH^MI"'[NHSUB D AP(.NHITM),XML(.NHITM) Q
.. S NHITM("type")=NHSUB,NHITM("id")=NHSUB_";"_NHIDT
.. S NHITM("collected")=9999999-NHIDT,NHITM("status")="completed"
.. S LR0=$G(^LR(LRDFN,NHSUB,NHIDT,0))
.. S NHITM("resulted")=$P(LR0,U,3),X=+$P(LR0,U,5) I X D
... N IENS,NHY S IENS=X_","
... D GETS^DIQ(61,IENS,".01:2",,"NHY")
... S NHITM("specimen")=$G(NHY(61,IENS,2))_U_$G(NHY(61,IENS,.01)) ;SNOMED^name
... S NHITM("sample")=$$GET1^DIQ(61,X_",",4.1) ;name
.. S NHITM("groupName")=$P(LR0,U,6),X=+$P(LR0,U,14)
.. S:X NHITM("facility")=$$STA^XUAF4(X)_U_$P($$NS^XUAF4(X),U)
.. I 'X S NHITM("facility")=$$FAC^NHINV ;local stn#^name
.. S:NHSUB="MI" NHITM("content")=$$TEXT(DFN,NHSUB,NHIDT)
.. S NHI=0 F S NHI=$O(^TMP("LRRR",$J,DFN,NHSUB,NHIDT,NHI)) Q:NHI<1 D
... S X=$S(NHSUB="MI":$$MI,1:$$CH)
... S:$L(X) NHITM("lab",NHI)=X
... S:$G(ORD) NHITM("labOrderID")=ORD
.. I $D(^TMP("LRRR",$J,DFN,NHSUB,NHIDT,"N")) M CMMT=^("N") S NHITM("comment")=$$STRING^NHINV(.CMMT)
.. D XML(.NHITM)
K ^TMP("LRRR",$J,DFN)
Q
;
CH() ; -- return a Chemistry result as:
; id^test^result^interpretation^units^low^high^loinc^vuid^order
; Expects ^TMP("LRRR",$J,DFN,"CH",NHIDT,NHI),LRDFN
N X,Y,X0,NODE,CMMT,LOINC
S X0=$G(^TMP("LRRR",$J,DFN,"CH",NHIDT,NHI)),NODE=$G(^LR(LRDFN,"CH",NHIDT,NHI))
S X=$P($G(^LAB(60,+X0,0)),U)
S Y="CH;"_NHIDT_";"_NHI_U_X_U_$P(X0,U,2,4)
S X=$P(X0,U,5) I $L(X),X["-" S X=$TR(X,"- ","^"),$P(Y,U,6,7)=X
S X=$P($P(NODE,U,3),"!",3) S:X LOINC=$$GET1^DIQ(95.3,X_",",.01)
I '$G(LOINC) S X=+$P(X0,U,19) S:X LOINC=$$LOINC(+X0,X)
S $P(Y,U,8,9)=$G(LOINC)_U_$$VUID^NHINV(+LOINC,95.3)
S ORD=+$P(X0,U,17),X=$$ORDER(ORD,+X0) S:X $P(Y,U,10)=X
Q Y
;
MI() ; -- return a Microbiology result as:
; id^test^result^interpretation^units
; Expects ^TMP("LRRR",$J,DFN,"MI",NHIDT,NHI)
N Y,X0
S X0=$G(^TMP("LRRR",$J,DFN,"MI",NHIDT,NHI)),Y=""
S:$L($P(X0,U))>1 Y="MI;"_NHIDT_";"_NHI_U_$P(X0,U,1,4)
Q Y
;
AP(LAB) ; -- return a Pathology result in LAB("attribute")=value
N LR0,X,I,NODE
S LR0=$G(^LR(LRDFN,NHSUB,NHIDT,0))
S LAB("type")=NHSUB,LAB("id")=NHSUB_";"_NHIDT
S LAB("collected")=9999999-NHIDT,LAB("status")="completed"
S LAB("resulted")=$P(LR0,U,11),LAB("groupName")=$P(LR0,U,6)
S X="",I=0 F S I=$O(^LR(LRDFN,NHSUB,NHIDT,.1,I)) Q:I<1 S X=X_$S($L(X):", ",1:"")_$P($G(^(I,0)),U)
S:$L(X) LAB("specimen")=U_X
S LAB("facility")=$$FAC^NHINV
S NODE=$S(NHSUB="AU":$NA(^LR(LRDFN,101)),1:$NA(^LR(LRDFN,NHSUB,NHIDT,.05)))
S I=0 F S I=$O(@NODE@(I)) Q:I<1 S X=+$P($G(@NODE@(I,0)),U,2) I X D
. N LT,NT
. S LT=$$GET1^DIQ(8925,+X_",",.01) Q:$P(LT," ")="Addendum"
. S NT=$$GET1^DIQ(8925,+X_",",".01:1501")
. S LAB("document",I)=+X_U_LT_U_NT
I '$O(NHITM("document",0)) S NHITM("content")=$$TEXT(DFN,NHSUB,NHIDT)
Q
;
LOINC(TEST,SPEC) ; -- Look up LOINC code, if not mapped
N Y,LAM,NHIN,IENS S Y=""
S TEST=+$G(TEST),SPEC=+$G(SPEC)
S LAM=$G(^LAB(60,TEST,64)),LAM=$S($P(LAM,U,2):$P(LAM,U,2),1:+LAM)
D GETS^DIQ(64.01,SPEC_","_LAM_",","30*",,"NHIN")
S IENS=$O(NHIN(64.02,"")) S:IENS Y=$G(NHIN(64.02,IENS,4))
S:'Y Y=$$GET1^DIQ(60.01,SPEC_","_TEST_",",95.3)
Q Y
;
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
;
NAME(X) ; -- Return name of subscript X
I X="AU" Q "AUTOPSY"
I X="BB" Q "BLOOD BANK"
I X="CH" Q "CHEM,HEM,TOX,RIA,SER,etc."
I X="CY" Q "CYTOLOGY"
I X="EM" Q "ELECTRON MICROSCOPY"
I X="MI" Q "MICROBIOLOGY"
I X="SP" Q "SURGICAL PATHOLOGY"
Q "ANATOMIC PATHOLOGY"
;
RPT(DFN,ID,RPT) ; -- return report as a TIU document
S DFN=+$G(DFN),ID=$G(ID) Q:DFN<1 Q:'$L(ID)
N SUB,IDT,LRDFN,LR0,X
S SUB=$P(ID,";"),IDT=+$P(ID,";",2)
S LRDFN=$G(^DPT(DFN,"LR")),LR0=$G(^LR(LRDFN,SUB,IDT,0))
S RPT("id")=ID,RPT("referenceDateTime")=9999999-IDT
S RPT("localTitle")=$$NAME(SUB),RPT("status")="COMPLETED"
S X=+$P(LR0,U,14),RPT("facility")=$$FAC^NHINV(X)
S X=$P(LR0,U,13) I X["SC(" D
. N CDT,HLOC S HLOC=+X,CDT=9999999-IDT
. S X=$$GETENC^PXAPI(DFN,CDT,HLOC)
. S:X RPT("encounter")=+X
S X=+$P(LR0,U,4) S:X RPT("clinician",1)=X_U_$P($G(^VA(200,X,0)),U)
S RPT("content")=$$TEXT(DFN,SUB,IDT)
Q
;
TEXT(DFN,SUB,IDT) ; -- return report text as a string
N LRDFN,DATE,NAME,NHS,NHY,I,X,Y
K ^TMP("LRC",$J),^TMP("LRH",$J),^TMP("LRT",$J)
S DATE=9999999-+$G(IDT),NAME=$$NAME(SUB),NHS(NAME)=""
D EN^LR7OSUM(.NHY,DFN,DATE,DATE,,,.NHS)
S I=+$G(^TMP("LRH",$J,NAME))+1,Y=$G(^TMP("LRC",$J,I,0)) ;LRH=header: Y=1st line
F S I=$O(^TMP("LRC",$J,I)) Q:I<1 S X=$G(^(I,0)) Q:X?1."=" S Y=Y_$C(13,10)_X
K ^TMP("LRC",$J),^TMP("LRH",$J),^TMP("LRT",$J)
Q Y
;
; ------------ Return data to middle tier ------------
;
XML(LAB) ; -- Return result as XML in @NHIN@(#)
N ATT,X,Y,NAMES
D ADD("<accession>") S NHINTOTL=$G(NHINTOTL)+1
S ATT="" F S ATT=$O(LAB(ATT)) Q:ATT="" D D:$L(Y) ADD(Y)
. I $O(LAB(ATT,0)) D S Y="" Q
.. D ADD("<"_ATT_"s>")
.. S NAMES=$S(ATT="document":"id^localTitle^nationalTitle^Z",ATT="lab":"id^test^result^interpretation^units^low^high^loinc^vuid^order^Z",1:"code^name^Z")
.. S I=0 F S I=$O(LAB(ATT,I)) Q:I<1 D
... S X=$G(LAB(ATT,I))
... S Y="<"_ATT_" "_$$LOOP_"/>" D ADD(Y)
.. D ADD("</"_ATT_"s>")
. S X=$G(LAB(ATT)),Y="" Q:'$L(X)
. I ATT="comment" S Y="<"_ATT_" xml:space='preserve'>"_$$ESC^NHINV(X)_"</"_ATT_">" Q
. I ATT="content" 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 NAMES="code^name^Z"
.. S Y="<"_ATT_" "_$$LOOP_"/>" D ADD(Y)
D ADD("</accession>")
Q
;
LOOP() ; -- build sub-items string from NAMES and X
N STR,P,TAG S STR=""
F P=1:1 S TAG=$P(NAMES,U,P) Q:TAG="Z" I $L($P(X,U,P)) S STR=STR_TAG_"='"_$$ESC^NHINV($P(X,U,P))_"' "
Q STR
;
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[HNHINVLRA 7344 printed Dec 13, 2024@02:17:17 Page 2
NHINVLRA ;SLC/MKB -- Laboratory extract by accession
+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 ; ^VA(200 10060
+10 ; DIC 2051
+11 ; DIQ 2056
+12 ; LR7OR1,^TMP("LRRR",$J) 2503
+13 ; LR7OSUM,^TMP("LRC") 2766
+14 ; PXAPI 1894
+15 ; XUAF4 2171
+16 ;
+17 ; ------------ Get results from VistA ------------
+18 ;
EN(DFN,BEG,END,MAX,ID) ; -- find patient's lab results
+1 NEW NHSUB,NHIDT,NHI,NHITM,LRDFN,LR0,ORD,X
+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 SET LRDFN=$GET(^DPT(DFN,"LR"))
SET NHSUB=""
+5 KILL ^TMP("LRRR",$JOB,DFN)
+6 ;
+7 ; get result(s)
+8 ;reset search parameters
IF $LENGTH($GET(ID))
Begin DoDot:1
+9 SET NHSUB=$PIECE(ID,";")
SET NHIDT=+$PIECE(ID,";",2)
+10 if NHIDT
SET (BEG,END)=9999999-NHIDT
End DoDot:1
+11 ;
+12 DO RR^LR7OR1(DFN,,BEG,END,NHSUB,,,MAX)
+13 SET NHSUB=""
FOR
SET NHSUB=$ORDER(^TMP("LRRR",$JOB,DFN,NHSUB))
if NHSUB=""
QUIT
Begin DoDot:1
+14 SET NHIDT=0
FOR
SET NHIDT=$ORDER(^TMP("LRRR",$JOB,DFN,NHSUB,NHIDT))
if NHIDT<1
QUIT
IF $ORDER(^(NHIDT,0))
Begin DoDot:2
+15 KILL NHITM,CMMT
IF "CH^MI"'[NHSUB
DO AP(.NHITM)
DO XML(.NHITM)
QUIT
+16 SET NHITM("type")=NHSUB
SET NHITM("id")=NHSUB_";"_NHIDT
+17 SET NHITM("collected")=9999999-NHIDT
SET NHITM("status")="completed"
+18 SET LR0=$GET(^LR(LRDFN,NHSUB,NHIDT,0))
+19 SET NHITM("resulted")=$PIECE(LR0,U,3)
SET X=+$PIECE(LR0,U,5)
IF X
Begin DoDot:3
+20 NEW IENS,NHY
SET IENS=X_","
+21 DO GETS^DIQ(61,IENS,".01:2",,"NHY")
+22 ;SNOMED^name
SET NHITM("specimen")=$GET(NHY(61,IENS,2))_U_$GET(NHY(61,IENS,.01))
+23 ;name
SET NHITM("sample")=$$GET1^DIQ(61,X_",",4.1)
End DoDot:3
+24 SET NHITM("groupName")=$PIECE(LR0,U,6)
SET X=+$PIECE(LR0,U,14)
+25 if X
SET NHITM("facility")=$$STA^XUAF4(X)_U_$PIECE($$NS^XUAF4(X),U)
+26 ;local stn#^name
IF 'X
SET NHITM("facility")=$$FAC^NHINV
+27 if NHSUB="MI"
SET NHITM("content")=$$TEXT(DFN,NHSUB,NHIDT)
+28 SET NHI=0
FOR
SET NHI=$ORDER(^TMP("LRRR",$JOB,DFN,NHSUB,NHIDT,NHI))
if NHI<1
QUIT
Begin DoDot:3
+29 SET X=$SELECT(NHSUB="MI":$$MI,1:$$CH)
+30 if $LENGTH(X)
SET NHITM("lab",NHI)=X
+31 if $GET(ORD)
SET NHITM("labOrderID")=ORD
End DoDot:3
+32 IF $DATA(^TMP("LRRR",$JOB,DFN,NHSUB,NHIDT,"N"))
MERGE CMMT=^("N")
SET NHITM("comment")=$$STRING^NHINV(.CMMT)
+33 DO XML(.NHITM)
End DoDot:2
End DoDot:1
+34 KILL ^TMP("LRRR",$JOB,DFN)
+35 QUIT
+36 ;
CH() ; -- return a Chemistry result as:
+1 ; id^test^result^interpretation^units^low^high^loinc^vuid^order
+2 ; Expects ^TMP("LRRR",$J,DFN,"CH",NHIDT,NHI),LRDFN
+3 NEW X,Y,X0,NODE,CMMT,LOINC
+4 SET X0=$GET(^TMP("LRRR",$JOB,DFN,"CH",NHIDT,NHI))
SET NODE=$GET(^LR(LRDFN,"CH",NHIDT,NHI))
+5 SET X=$PIECE($GET(^LAB(60,+X0,0)),U)
+6 SET Y="CH;"_NHIDT_";"_NHI_U_X_U_$PIECE(X0,U,2,4)
+7 SET X=$PIECE(X0,U,5)
IF $LENGTH(X)
IF X["-"
SET X=$TRANSLATE(X,"- ","^")
SET $PIECE(Y,U,6,7)=X
+8 SET X=$PIECE($PIECE(NODE,U,3),"!",3)
if X
SET LOINC=$$GET1^DIQ(95.3,X_",",.01)
+9 IF '$GET(LOINC)
SET X=+$PIECE(X0,U,19)
if X
SET LOINC=$$LOINC(+X0,X)
+10 SET $PIECE(Y,U,8,9)=$GET(LOINC)_U_$$VUID^NHINV(+LOINC,95.3)
+11 SET ORD=+$PIECE(X0,U,17)
SET X=$$ORDER(ORD,+X0)
if X
SET $PIECE(Y,U,10)=X
+12 QUIT Y
+13 ;
MI() ; -- return a Microbiology result as:
+1 ; id^test^result^interpretation^units
+2 ; Expects ^TMP("LRRR",$J,DFN,"MI",NHIDT,NHI)
+3 NEW Y,X0
+4 SET X0=$GET(^TMP("LRRR",$JOB,DFN,"MI",NHIDT,NHI))
SET Y=""
+5 if $LENGTH($PIECE(X0,U))>1
SET Y="MI;"_NHIDT_";"_NHI_U_$PIECE(X0,U,1,4)
+6 QUIT Y
+7 ;
AP(LAB) ; -- return a Pathology result in LAB("attribute")=value
+1 NEW LR0,X,I,NODE
+2 SET LR0=$GET(^LR(LRDFN,NHSUB,NHIDT,0))
+3 SET LAB("type")=NHSUB
SET LAB("id")=NHSUB_";"_NHIDT
+4 SET LAB("collected")=9999999-NHIDT
SET LAB("status")="completed"
+5 SET LAB("resulted")=$PIECE(LR0,U,11)
SET LAB("groupName")=$PIECE(LR0,U,6)
+6 SET X=""
SET I=0
FOR
SET I=$ORDER(^LR(LRDFN,NHSUB,NHIDT,.1,I))
if I<1
QUIT
SET X=X_$SELECT($LENGTH(X):", ",1:"")_$PIECE($GET(^(I,0)),U)
+7 if $LENGTH(X)
SET LAB("specimen")=U_X
+8 SET LAB("facility")=$$FAC^NHINV
+9 SET NODE=$SELECT(NHSUB="AU":$NAME(^LR(LRDFN,101)),1:$NAME(^LR(LRDFN,NHSUB,NHIDT,.05)))
+10 SET I=0
FOR
SET I=$ORDER(@NODE@(I))
if I<1
QUIT
SET X=+$PIECE($GET(@NODE@(I,0)),U,2)
IF X
Begin DoDot:1
+11 NEW LT,NT
+12 SET LT=$$GET1^DIQ(8925,+X_",",.01)
if $PIECE(LT," ")="Addendum"
QUIT
+13 SET NT=$$GET1^DIQ(8925,+X_",",".01:1501")
+14 SET LAB("document",I)=+X_U_LT_U_NT
End DoDot:1
+15 IF '$ORDER(NHITM("document",0))
SET NHITM("content")=$$TEXT(DFN,NHSUB,NHIDT)
+16 QUIT
+17 ;
LOINC(TEST,SPEC) ; -- Look up LOINC code, if not mapped
+1 NEW Y,LAM,NHIN,IENS
SET Y=""
+2 SET TEST=+$GET(TEST)
SET SPEC=+$GET(SPEC)
+3 SET LAM=$GET(^LAB(60,TEST,64))
SET LAM=$SELECT($PIECE(LAM,U,2):$PIECE(LAM,U,2),1:+LAM)
+4 DO GETS^DIQ(64.01,SPEC_","_LAM_",","30*",,"NHIN")
+5 SET IENS=$ORDER(NHIN(64.02,""))
if IENS
SET Y=$GET(NHIN(64.02,IENS,4))
+6 if 'Y
SET Y=$$GET1^DIQ(60.01,SPEC_","_TEST_",",95.3)
+7 QUIT Y
+8 ;
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 ;
NAME(X) ; -- Return name of subscript X
+1 IF X="AU"
QUIT "AUTOPSY"
+2 IF X="BB"
QUIT "BLOOD BANK"
+3 IF X="CH"
QUIT "CHEM,HEM,TOX,RIA,SER,etc."
+4 IF X="CY"
QUIT "CYTOLOGY"
+5 IF X="EM"
QUIT "ELECTRON MICROSCOPY"
+6 IF X="MI"
QUIT "MICROBIOLOGY"
+7 IF X="SP"
QUIT "SURGICAL PATHOLOGY"
+8 QUIT "ANATOMIC PATHOLOGY"
+9 ;
RPT(DFN,ID,RPT) ; -- return report as a TIU document
+1 SET DFN=+$GET(DFN)
SET ID=$GET(ID)
if DFN<1
QUIT
if '$LENGTH(ID)
QUIT
+2 NEW SUB,IDT,LRDFN,LR0,X
+3 SET SUB=$PIECE(ID,";")
SET IDT=+$PIECE(ID,";",2)
+4 SET LRDFN=$GET(^DPT(DFN,"LR"))
SET LR0=$GET(^LR(LRDFN,SUB,IDT,0))
+5 SET RPT("id")=ID
SET RPT("referenceDateTime")=9999999-IDT
+6 SET RPT("localTitle")=$$NAME(SUB)
SET RPT("status")="COMPLETED"
+7 SET X=+$PIECE(LR0,U,14)
SET RPT("facility")=$$FAC^NHINV(X)
+8 SET X=$PIECE(LR0,U,13)
IF X["SC("
Begin DoDot:1
+9 NEW CDT,HLOC
SET HLOC=+X
SET CDT=9999999-IDT
+10 SET X=$$GETENC^PXAPI(DFN,CDT,HLOC)
+11 if X
SET RPT("encounter")=+X
End DoDot:1
+12 SET X=+$PIECE(LR0,U,4)
if X
SET RPT("clinician",1)=X_U_$PIECE($GET(^VA(200,X,0)),U)
+13 SET RPT("content")=$$TEXT(DFN,SUB,IDT)
+14 QUIT
+15 ;
TEXT(DFN,SUB,IDT) ; -- return report text as a string
+1 NEW LRDFN,DATE,NAME,NHS,NHY,I,X,Y
+2 KILL ^TMP("LRC",$JOB),^TMP("LRH",$JOB),^TMP("LRT",$JOB)
+3 SET DATE=9999999-+$GET(IDT)
SET NAME=$$NAME(SUB)
SET NHS(NAME)=""
+4 DO EN^LR7OSUM(.NHY,DFN,DATE,DATE,,,.NHS)
+5 ;LRH=header: Y=1st line
SET I=+$GET(^TMP("LRH",$JOB,NAME))+1
SET Y=$GET(^TMP("LRC",$JOB,I,0))
+6 FOR
SET I=$ORDER(^TMP("LRC",$JOB,I))
if I<1
QUIT
SET X=$GET(^(I,0))
if X?1."="
QUIT
SET Y=Y_$CHAR(13,10)_X
+7 KILL ^TMP("LRC",$JOB),^TMP("LRH",$JOB),^TMP("LRT",$JOB)
+8 QUIT Y
+9 ;
+10 ; ------------ Return data to middle tier ------------
+11 ;
XML(LAB) ; -- Return result as XML in @NHIN@(#)
+1 NEW ATT,X,Y,NAMES
+2 DO ADD("<accession>")
SET NHINTOTL=$GET(NHINTOTL)+1
+3 SET ATT=""
FOR
SET ATT=$ORDER(LAB(ATT))
if ATT=""
QUIT
Begin DoDot:1
+4 IF $ORDER(LAB(ATT,0))
Begin DoDot:2
+5 DO ADD("<"_ATT_"s>")
+6 SET NAMES=$SELECT(ATT="document":"id^localTitle^nationalTitle^Z",ATT="lab":"id^test^result^interpretation^units^low^high^loinc^vuid^order^Z",1:"code^name^Z")
+7 SET I=0
FOR
SET I=$ORDER(LAB(ATT,I))
if I<1
QUIT
Begin DoDot:3
+8 SET X=$GET(LAB(ATT,I))
+9 SET Y="<"_ATT_" "_$$LOOP_"/>"
DO ADD(Y)
End DoDot:3
+10 DO ADD("</"_ATT_"s>")
End DoDot:2
SET Y=""
QUIT
+11 SET X=$GET(LAB(ATT))
SET Y=""
if '$LENGTH(X)
QUIT
+12 IF ATT="comment"
SET Y="<"_ATT_" xml:space='preserve'>"_$$ESC^NHINV(X)_"</"_ATT_">"
QUIT
+13 IF ATT="content"
SET Y="<"_ATT_" xml:space='preserve'>"_$$ESC^NHINV(X)_"</"_ATT_">"
QUIT
+14 IF X'["^"
SET Y="<"_ATT_" value='"_$$ESC^NHINV(X)_"' />"
QUIT
+15 IF $LENGTH(X)>1
Begin DoDot:2
+16 SET NAMES="code^name^Z"
+17 SET Y="<"_ATT_" "_$$LOOP_"/>"
DO ADD(Y)
End DoDot:2
SET Y=""
End DoDot:1
if $LENGTH(Y)
DO ADD(Y)
+18 DO ADD("</accession>")
+19 QUIT
+20 ;
LOOP() ; -- build sub-items string from NAMES and X
+1 NEW STR,P,TAG
SET STR=""
+2 FOR P=1:1
SET TAG=$PIECE(NAMES,U,P)
if TAG="Z"
QUIT
IF $LENGTH($PIECE(X,U,P))
SET STR=STR_TAG_"='"_$$ESC^NHINV($PIECE(X,U,P))_"' "
+3 QUIT STR
+4 ;
ADD(X) ; -- Add a line @NHIN@(n)=X
+1 SET NHINI=$GET(NHINI)+1
+2 SET @NHIN@(NHINI)=X
+3 QUIT
