- 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 Mar 13, 2025@21:22:21 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
