HMPDJ06 ;SLC/MKB,ASMR/RRB/MBS - Laboratory;May 10, 2016 18:20:53
;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**2**;Sep 01, 2011;Build 28
;Per VA Directive 6402, this routine should not be modified.
;
; External References DBIA#
; ------------------- -----
; ^LAB(60 91
; ^LR 525
; ^PXRMINDX 4290
; ^TMP("LRRR" [LR7OR1] 2503
; DIQ 2056
; LR7OR1,^TMP("LRRR" 2503
; LRPXAPI 4245
; LRPXAPIU 4246
; XLFSTR 10104
; XUAF4 2171
;
; All tags expect DFN, ID, LRDFN, [HMPSTART, HMPSTOP, HMPMAX, HMPTEXT]
; & ^TMP("LRRR",$J,DFN,HMPSUB,HMPIDT,HMPP),HMPN
Q
;
CH1 ; -- lab ID = CH;HMPIDT;HMPN
N LAB,LRI,X,X0,SPC,LOINC,ORD,CMMT
N $ES,$ET,ERRPAT,ERRMSG
S $ET="D ERRHDLR^HMPDERRH",ERRPAT=DFN
S ERRMSG="A problem occurred converting record "_ID_" for the chemistry domain"
;
M LAB=HMPACC ;get accession info
S LAB("localId")=ID,LAB("uid")=$$SETUID^HMPUTILS("lab",DFN,ID)
S LAB("categoryCode")="urn:va:lab-category:CH"
S LAB("categoryName")="Laboratory"
S LAB("displayOrder")=HMPP
S LRI=$G(^LR(LRDFN,"CH",HMPIDT,HMPN)) ;DE2818, ^LR( - ICR525
S X0=$G(^TMP("LRRR",$J,DFN,"CH",HMPIDT,HMPP)),SPC=+$P(X0,U,19)
;DE2818 - ^LAB(60) references - ICR 91
S LAB("typeId")=+X0,LAB("typeName")=$P($G(^LAB(60,+X0,0)),U)
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 X=$P(X0,U,5) I $L(X),X["-" S LAB("low")=$$TRIM^XLFSTR($P(X,"-")),LAB("high")=$$TRIM^XLFSTR($P(X,"-",2))
S X=$P(X0,U,3) I $L(X) D
. S:X["*" X=$S(X["L":"LL",1:"HH")
. S LAB("interpretationCode")="urn:hl7:observation-interpretation:"_X
. S LAB("interpretationName")=$S(X["L":"Low",1:"High")_$S($L(X)>1:" alert",1:"")
S LAB("displayName")=$S($L($P(X0,U,15)):$P(X0,U,15),1:LAB("test"))
S ORD=+$P(X0,U,17) S:ORD LAB("labOrderId")=ORD
S X=$$ORDER^HMPDLR(ORD,+X0) S:X LAB("orderUid")=$$SETUID^HMPUTILS("order",DFN,X)
;DE4624 - If no LOINC code in the lab data, check in the LABRATORY TEST (#60) file
S LOINC=$P($P(LRI,U,3),"!",3) S:'LOINC LOINC=$$LOINC^HMPDJ06(+X0,SPC)
I LOINC S LAB("typeCode")="urn:lnc:"_$$GET1^DIQ(95.3,+LOINC_",",.01),LAB("vuid")="urn:va:vuid:"_$$VUID^HMPD(+LOINC,95.3)
I 'LOINC S LAB("typeCode")="urn:va:ien:60:"_+X0_":"_SPC
I $D(^TMP("LRRR",$J,DFN,"CH",HMPIDT,"N")) M CMMT=^("N") S LAB("comment")=$$STRING^HMPD(.CMMT)
S LAB("statusCode")="urn:va:lab-status:completed",LAB("statusName")="completed"
S LAB("lastUpdateTime")=$$EN^HMPSTMP("lab") ;RHL 20150102
S LAB("stampTime")=LAB("lastUpdateTime") ; RHL 20150102
;US6734 - pre-compile metastamp
I $G(HMPMETA) D ADD^HMPMETA("lab",LAB("uid"),LAB("stampTime")) Q:HMPMETA=1 ;US6734,US11019
D ADD^HMPDJ("LAB","lab")
Q
;
ACC ; -- put accession-level data in HMPACC("attribute")
N LR0,CDT,SPC,X K HMPACC
S LR0=$G(^LR(LRDFN,HMPSUB,HMPIDT,0)) ;DE2818, ^LR( - ICR525
S CDT=9999999-HMPIDT,HMPACC("observed")=$$DATE(CDT)
S HMPACC("resulted")=$$DATE($P(LR0,U,3)),SPC=+$P(LR0,U,5) I SPC D
. N IENS,HMPY S IENS=SPC_","
. D GETS^DIQ(61,IENS,".01;4.1",,"HMPY")
. S HMPACC("specimen")=$G(HMPY(61,IENS,.01))
. S HMPACC("sample")=$G(HMPY(61,IENS,4.1))
S HMPACC("groupUid")=$$SETUID^HMPUTILS("accession",DFN,HMPSUB_";"_HMPIDT)
S HMPACC("groupName")=$P(LR0,U,6)
S X=+$P(LR0,U,14) D D FACILITY^HMPUTILS(X,"HMPACC")
. S:X X=$$STA^XUAF4(X)_U_$P($$NS^XUAF4(X),U)
. I 'X S X=$$FAC^HMPD ;local stn#^name
Q
;
MI ; -- microbiology accession ID = MI;HMPIDT
N LAB,CDT,LR0,X,ACC,FAC,X0,X1,X2,IDX,HMPM,HMPPX,HMPITM,DA,FLD
N $ES,$ET,ERRPAT,ERRMSG
S $ET="D ERRHDLR^HMPDERRH",ERRPAT=DFN
S ERRMSG="A problem occurred converting record "_ID_" for the microbiology domain"
;
S LAB("localId")=ID,LAB("uid")=$$SETUID^HMPUTILS("lab",DFN,ID)
S LAB("categoryCode")="urn:va:lab-category:MI"
S LAB("categoryName")="Microbiology"
S LAB("statusCode")="urn:va:lab-status:completed",LAB("statusName")="completed"
S CDT=9999999-HMPIDT,LAB("observed")=$$DATE(CDT)
S LR0=$G(^LR(LRDFN,"MI",HMPIDT,0)) ; DE2818, ^LR( - ICR525
S:$P(LR0,U,3) LAB("resulted")=$$DATE($P(LR0,U,3))
S X=+$P(LR0,U,5) I X D ;specimen
. N IENS,HMPY S IENS=X_","
. D GETS^DIQ(61,IENS,".01;2",,"HMPY")
. S LAB("specimen")=$G(HMPY(61,IENS,.01))
. S LAB("sample")=$$GET1^DIQ(61,X_",",4.1)
S LAB("groupName")=$P(LR0,U,6),ACC=$P(ID,";",1,2) ;accession#
S LAB("groupUid")=$$SETUID^HMPUTILS("accession",DFN,ACC)
S X=$P(LR0,U,14),FAC=$S(X:$$STA^XUAF4(X)_U_$P($$NS^XUAF4(X),U),1:$$FAC^HMPD)
D FACILITY^HMPUTILS(FAC,"LAB")
; get results from ^TMP
S HMPN=0 F S HMPN=$O(^TMP("LRRR",$J,DFN,HMPSUB,HMPIDT,HMPN)) Q:HMPN<1 D
. S X0=$G(^TMP("LRRR",$J,DFN,"MI",HMPIDT,HMPN)),X1=$P(X0,U),X2=$P(X0,U,2)
. I X1="URINE SCREEN" S LAB("urineScreen")=X2 Q
. ; X1="ORGANISM" S LAB("organism")=$P(X2,";"),LAB("organismQty")=$P(X2,";",2)
. I X1="GRAM STAIN" S LAB("gramStain",HMPN,"result")=X2 Q
. I X1="Bacteriology Remark(s)" S LAB("bactRemarks")=X2 Q
; get other results from ^PXRMINDX
S X=$O(^PXRMINDX(63,"PDI",DFN,CDT,"M;T;0")) I X?1"M;T;"1.N D
. S IDX=$O(^PXRMINDX(63,"PDI",DFN,CDT,X,"")) K HMPM
. D LRPXRM^LRPXAPI(.HMPM,IDX,X) Q:HMPM<1
. S LAB("typeName")=$P(HMPM,U,2)
. S LAB("typeCode")="urn:va:ien:60:"_+HMPM_":"_+$P(HMPM,U,7)
F HMPPX="M;O;","M;A;" D
. S HMPITM=HMPPX F S HMPITM=$O(^PXRMINDX(63,"PDI",DFN,CDT,HMPITM)) Q:$E(HMPITM,1,4)'=HMPPX D
.. S IDX=$O(^PXRMINDX(63,"PDI",DFN,CDT,HMPITM,"")) K HMPM
.. S DA=$P(IDX,";",5),FLD=$P(IDX,";",6)
.. D LRPXRM^LRPXAPI(.HMPM,IDX,HMPITM) Q:'$L($G(HMPM))
.. I HMPPX["O" S LAB("organisms",DA,"name")=$P(HMPM,U,2),LAB("organisms",DA,"qty")=$P(HMPM,U,4) Q
.. I HMPPX["A" D Q
... S LAB("organisms",DA,"drugs",FLD,"name")=$P(HMPM,U,2)
... S LAB("organisms",DA,"drugs",FLD,"result")=$P(HMPM,U,3)
... S LAB("organisms",DA,"drugs",FLD,"interp")=$P(HMPM,U,4)
... S:$L($P(HMPM,U,5)) LAB("organisms",DA,"drugs",FLD,"restrict")=$P(HMPM,U,5)
;
S LAB("results",1,"uid")=ACC
S LAB("results",1,"resultUid")=$$SETUID^HMPUTILS("document",DFN,ACC)
S LAB("results",1,"localTitle")="LR MICROBIOLOGY REPORT"
I $L($G(^LR(LRDFN,"MI",HMPIDT,99))) S LAB("comment")=^(99) ; DE2818, ^LR( - ICR525
S LAB("lastUpdateTime")=$$EN^HMPSTMP("lab") ;RHL 20150102
S LAB("stampTime")=LAB("lastUpdateTime") ; RHL 20150102
;US6734 - pre-compile metastamp
I $G(HMPMETA) D ADD^HMPMETA("lab",LAB("uid"),LAB("stampTime")) Q:HMPMETA=1 ;US6734,US11019
D ADD^HMPDJ("LAB","lab")
Q
;
ITEM() ; -- find ITEM string from ^PXRMINDX [uses LRDFN,ID,DFN,CDT]
N ITM,IDX,Y S Y=""
S IDX=LRDFN_";"_ID,ITM="M"
F S ITM=$O(^PXRMINDX(63,"PI",DFN,ITM)) Q:$E(ITM)'="M" I $D(^PXRMINDX(63,"PI",DFN,ITM,CDT,IDX)) S Y=ITM Q
Q Y
;
AP ; -- pathology ID = HMPSUB;HMPIDT
N LAB,LR0,X,I,NODE
N $ES,$ET,ERRPAT,ERRMSG
S $ET="D ERRHDLR^HMPDERRH",ERRPAT=DFN
S ERRMSG="A problem occurred converting record "_ID_" for the pathology domain"
;
S LAB("localId")=ID,LAB("organizerType")="accession"
S LAB("uid")=$$SETUID^HMPUTILS("lab",DFN,ID)
S LAB("categoryCode")="urn:va:lab-category:"_HMPSUB
S LAB("categoryName")=$S(HMPSUB="BB":"Blood Bank",HMPSUB="SP":"Surgical Pathology",1:"Pathology")
S LAB("statusCode")="urn:va:lab-status:completed",LAB("statusName")="completed"
S CDT=9999999-HMPIDT,LAB("observed")=$$DATE(CDT)
;DE2818 begin, ^LR( references - ICR525
S LR0=$G(^LR(LRDFN,HMPSUB,HMPIDT,0))
S LAB("resulted")=$$DATE($P(LR0,U,11)),LAB("groupName")=$P(LR0,U,6)
S X="",I=0 F S I=$O(^LR(LRDFN,HMPSUB,HMPIDT,.1,I)) Q:I<1 S X=X_$S($L(X):", ",1:"")_$P($G(^(I,0)),U)
S:$L(X) LAB("specimen")=X
D FACILITY^HMPUTILS($$FAC^HMPD,"LAB")
S NODE=$S(HMPSUB="AU":$NA(^LR(LRDFN,101)),1:$NA(^LR(LRDFN,HMPSUB,HMPIDT,.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 S LT=$$GET1^DIQ(8925,+X_",",.01) Q:$P(LT," ")="Addendum"
. S LAB("results",I,"uid")=LAB("uid")
. S LAB("results",I,"resultUid")=$$SETUID^HMPUTILS("document",DFN,X)
. S LAB("results",I,"localTitle")=LT
I '$O(LAB("results",0)) D ;non-TIU reports
. S LAB("results",1,"uid")=LAB("uid")
. S LAB("results",1,"resultUid")=$$SETUID^HMPUTILS("document",DFN,ID)
. S LAB("results",1,"localTitle")="LR "_$$NAME^HMPDLRA(HMPSUB)_" REPORT"
; ;DE2818 end, ^LR( references - ICR525
S LAB("lastUpdateTime")=$$EN^HMPSTMP("lab") ;RHL 20150102
S LAB("stampTime")=LAB("lastUpdateTime") ; RHL 20150102
;US6734 - pre-compile metastamp
I $G(HMPMETA) D ADD^HMPMETA("lab",LAB("uid"),LAB("stampTime")) Q:HMPMETA=1 ;US6734,US11019
D ADD^HMPDJ("LAB","lab")
;
DATE(X) ; -- strip off seconds, return JSON format
N Y S Y=$G(X)
I $L($P(Y,".",2))>4 S Y=$P(Y,".")_"."_$E($P(Y,".",2),1,4) ;strip seconds
S:Y Y=$$JSONDT^HMPUTILS(Y)
Q Y
LOINC(LTEST,SPC) ;DE4624 - Gets LOINC code from Lab Test/Specimin
I '$D(^LAB(60,LTEST)) Q ""
I '$D(^LAB(60,LTEST,1,SPC)) Q ""
Q +$G(^LAB(60,LTEST,1,SPC,95.3))
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHMPDJ06 9047 printed Nov 22, 2024@17:03:33 Page 2
HMPDJ06 ;SLC/MKB,ASMR/RRB/MBS - Laboratory;May 10, 2016 18:20:53
+1 ;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**2**;Sep 01, 2011;Build 28
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; External References DBIA#
+5 ; ------------------- -----
+6 ; ^LAB(60 91
+7 ; ^LR 525
+8 ; ^PXRMINDX 4290
+9 ; ^TMP("LRRR" [LR7OR1] 2503
+10 ; DIQ 2056
+11 ; LR7OR1,^TMP("LRRR" 2503
+12 ; LRPXAPI 4245
+13 ; LRPXAPIU 4246
+14 ; XLFSTR 10104
+15 ; XUAF4 2171
+16 ;
+17 ; All tags expect DFN, ID, LRDFN, [HMPSTART, HMPSTOP, HMPMAX, HMPTEXT]
+18 ; & ^TMP("LRRR",$J,DFN,HMPSUB,HMPIDT,HMPP),HMPN
+19 QUIT
+20 ;
CH1 ; -- lab ID = CH;HMPIDT;HMPN
+1 NEW LAB,LRI,X,X0,SPC,LOINC,ORD,CMMT
+2 NEW $ESTACK,$ETRAP,ERRPAT,ERRMSG
+3 SET $ETRAP="D ERRHDLR^HMPDERRH"
SET ERRPAT=DFN
+4 SET ERRMSG="A problem occurred converting record "_ID_" for the chemistry domain"
+5 ;
+6 ;get accession info
MERGE LAB=HMPACC
+7 SET LAB("localId")=ID
SET LAB("uid")=$$SETUID^HMPUTILS("lab",DFN,ID)
+8 SET LAB("categoryCode")="urn:va:lab-category:CH"
+9 SET LAB("categoryName")="Laboratory"
+10 SET LAB("displayOrder")=HMPP
+11 ;DE2818, ^LR( - ICR525
SET LRI=$GET(^LR(LRDFN,"CH",HMPIDT,HMPN))
+12 SET X0=$GET(^TMP("LRRR",$JOB,DFN,"CH",HMPIDT,HMPP))
SET SPC=+$PIECE(X0,U,19)
+13 ;DE2818 - ^LAB(60) references - ICR 91
+14 SET LAB("typeId")=+X0
SET LAB("typeName")=$PIECE($GET(^LAB(60,+X0,0)),U)
+15 if $LENGTH($PIECE(X0,U,2))
SET LAB("result")=$PIECE(X0,U,2)
+16 if $LENGTH($PIECE(X0,U,4))
SET LAB("units")=$PIECE(X0,U,4)
+17 SET X=$PIECE(X0,U,5)
IF $LENGTH(X)
IF X["-"
SET LAB("low")=$$TRIM^XLFSTR($PIECE(X,"-"))
SET LAB("high")=$$TRIM^XLFSTR($PIECE(X,"-",2))
+18 SET X=$PIECE(X0,U,3)
IF $LENGTH(X)
Begin DoDot:1
+19 if X["*"
SET X=$SELECT(X["L":"LL",1:"HH")
+20 SET LAB("interpretationCode")="urn:hl7:observation-interpretation:"_X
+21 SET LAB("interpretationName")=$SELECT(X["L":"Low",1:"High")_$SELECT($LENGTH(X)>1:" alert",1:"")
End DoDot:1
+22 SET LAB("displayName")=$SELECT($LENGTH($PIECE(X0,U,15)):$PIECE(X0,U,15),1:LAB("test"))
+23 SET ORD=+$PIECE(X0,U,17)
if ORD
SET LAB("labOrderId")=ORD
+24 SET X=$$ORDER^HMPDLR(ORD,+X0)
if X
SET LAB("orderUid")=$$SETUID^HMPUTILS("order",DFN,X)
+25 ;DE4624 - If no LOINC code in the lab data, check in the LABRATORY TEST (#60) file
+26 SET LOINC=$PIECE($PIECE(LRI,U,3),"!",3)
if 'LOINC
SET LOINC=$$LOINC^HMPDJ06(+X0,SPC)
+27 IF LOINC
SET LAB("typeCode")="urn:lnc:"_$$GET1^DIQ(95.3,+LOINC_",",.01)
SET LAB("vuid")="urn:va:vuid:"_$$VUID^HMPD(+LOINC,95.3)
+28 IF 'LOINC
SET LAB("typeCode")="urn:va:ien:60:"_+X0_":"_SPC
+29 IF $DATA(^TMP("LRRR",$JOB,DFN,"CH",HMPIDT,"N"))
MERGE CMMT=^("N")
SET LAB("comment")=$$STRING^HMPD(.CMMT)
+30 SET LAB("statusCode")="urn:va:lab-status:completed"
SET LAB("statusName")="completed"
+31 ;RHL 20150102
SET LAB("lastUpdateTime")=$$EN^HMPSTMP("lab")
+32 ; RHL 20150102
SET LAB("stampTime")=LAB("lastUpdateTime")
+33 ;US6734 - pre-compile metastamp
+34 ;US6734,US11019
IF $GET(HMPMETA)
DO ADD^HMPMETA("lab",LAB("uid"),LAB("stampTime"))
if HMPMETA=1
QUIT
+35 DO ADD^HMPDJ("LAB","lab")
+36 QUIT
+37 ;
ACC ; -- put accession-level data in HMPACC("attribute")
+1 NEW LR0,CDT,SPC,X
KILL HMPACC
+2 ;DE2818, ^LR( - ICR525
SET LR0=$GET(^LR(LRDFN,HMPSUB,HMPIDT,0))
+3 SET CDT=9999999-HMPIDT
SET HMPACC("observed")=$$DATE(CDT)
+4 SET HMPACC("resulted")=$$DATE($PIECE(LR0,U,3))
SET SPC=+$PIECE(LR0,U,5)
IF SPC
Begin DoDot:1
+5 NEW IENS,HMPY
SET IENS=SPC_","
+6 DO GETS^DIQ(61,IENS,".01;4.1",,"HMPY")
+7 SET HMPACC("specimen")=$GET(HMPY(61,IENS,.01))
+8 SET HMPACC("sample")=$GET(HMPY(61,IENS,4.1))
End DoDot:1
+9 SET HMPACC("groupUid")=$$SETUID^HMPUTILS("accession",DFN,HMPSUB_";"_HMPIDT)
+10 SET HMPACC("groupName")=$PIECE(LR0,U,6)
+11 SET X=+$PIECE(LR0,U,14)
Begin DoDot:1
+12 if X
SET X=$$STA^XUAF4(X)_U_$PIECE($$NS^XUAF4(X),U)
+13 ;local stn#^name
IF 'X
SET X=$$FAC^HMPD
End DoDot:1
DO FACILITY^HMPUTILS(X,"HMPACC")
+14 QUIT
+15 ;
MI ; -- microbiology accession ID = MI;HMPIDT
+1 NEW LAB,CDT,LR0,X,ACC,FAC,X0,X1,X2,IDX,HMPM,HMPPX,HMPITM,DA,FLD
+2 NEW $ESTACK,$ETRAP,ERRPAT,ERRMSG
+3 SET $ETRAP="D ERRHDLR^HMPDERRH"
SET ERRPAT=DFN
+4 SET ERRMSG="A problem occurred converting record "_ID_" for the microbiology domain"
+5 ;
+6 SET LAB("localId")=ID
SET LAB("uid")=$$SETUID^HMPUTILS("lab",DFN,ID)
+7 SET LAB("categoryCode")="urn:va:lab-category:MI"
+8 SET LAB("categoryName")="Microbiology"
+9 SET LAB("statusCode")="urn:va:lab-status:completed"
SET LAB("statusName")="completed"
+10 SET CDT=9999999-HMPIDT
SET LAB("observed")=$$DATE(CDT)
+11 ; DE2818, ^LR( - ICR525
SET LR0=$GET(^LR(LRDFN,"MI",HMPIDT,0))
+12 if $PIECE(LR0,U,3)
SET LAB("resulted")=$$DATE($PIECE(LR0,U,3))
+13 ;specimen
SET X=+$PIECE(LR0,U,5)
IF X
Begin DoDot:1
+14 NEW IENS,HMPY
SET IENS=X_","
+15 DO GETS^DIQ(61,IENS,".01;2",,"HMPY")
+16 SET LAB("specimen")=$GET(HMPY(61,IENS,.01))
+17 SET LAB("sample")=$$GET1^DIQ(61,X_",",4.1)
End DoDot:1
+18 ;accession#
SET LAB("groupName")=$PIECE(LR0,U,6)
SET ACC=$PIECE(ID,";",1,2)
+19 SET LAB("groupUid")=$$SETUID^HMPUTILS("accession",DFN,ACC)
+20 SET X=$PIECE(LR0,U,14)
SET FAC=$SELECT(X:$$STA^XUAF4(X)_U_$PIECE($$NS^XUAF4(X),U),1:$$FAC^HMPD)
+21 DO FACILITY^HMPUTILS(FAC,"LAB")
+22 ; get results from ^TMP
+23 SET HMPN=0
FOR
SET HMPN=$ORDER(^TMP("LRRR",$JOB,DFN,HMPSUB,HMPIDT,HMPN))
if HMPN<1
QUIT
Begin DoDot:1
+24 SET X0=$GET(^TMP("LRRR",$JOB,DFN,"MI",HMPIDT,HMPN))
SET X1=$PIECE(X0,U)
SET X2=$PIECE(X0,U,2)
+25 IF X1="URINE SCREEN"
SET LAB("urineScreen")=X2
QUIT
+26 ; X1="ORGANISM" S LAB("organism")=$P(X2,";"),LAB("organismQty")=$P(X2,";",2)
+27 IF X1="GRAM STAIN"
SET LAB("gramStain",HMPN,"result")=X2
QUIT
+28 IF X1="Bacteriology Remark(s)"
SET LAB("bactRemarks")=X2
QUIT
End DoDot:1
+29 ; get other results from ^PXRMINDX
+30 SET X=$ORDER(^PXRMINDX(63,"PDI",DFN,CDT,"M;T;0"))
IF X?1"M;T;"1.N
Begin DoDot:1
+31 SET IDX=$ORDER(^PXRMINDX(63,"PDI",DFN,CDT,X,""))
KILL HMPM
+32 DO LRPXRM^LRPXAPI(.HMPM,IDX,X)
if HMPM<1
QUIT
+33 SET LAB("typeName")=$PIECE(HMPM,U,2)
+34 SET LAB("typeCode")="urn:va:ien:60:"_+HMPM_":"_+$PIECE(HMPM,U,7)
End DoDot:1
+35 FOR HMPPX="M;O;","M;A;"
Begin DoDot:1
+36 SET HMPITM=HMPPX
FOR
SET HMPITM=$ORDER(^PXRMINDX(63,"PDI",DFN,CDT,HMPITM))
if $EXTRACT(HMPITM,1,4)'=HMPPX
QUIT
Begin DoDot:2
+37 SET IDX=$ORDER(^PXRMINDX(63,"PDI",DFN,CDT,HMPITM,""))
KILL HMPM
+38 SET DA=$PIECE(IDX,";",5)
SET FLD=$PIECE(IDX,";",6)
+39 DO LRPXRM^LRPXAPI(.HMPM,IDX,HMPITM)
if '$LENGTH($GET(HMPM))
QUIT
+40 IF HMPPX["O"
SET LAB("organisms",DA,"name")=$PIECE(HMPM,U,2)
SET LAB("organisms",DA,"qty")=$PIECE(HMPM,U,4)
QUIT
+41 IF HMPPX["A"
Begin DoDot:3
+42 SET LAB("organisms",DA,"drugs",FLD,"name")=$PIECE(HMPM,U,2)
+43 SET LAB("organisms",DA,"drugs",FLD,"result")=$PIECE(HMPM,U,3)
+44 SET LAB("organisms",DA,"drugs",FLD,"interp")=$PIECE(HMPM,U,4)
+45 if $LENGTH($PIECE(HMPM,U,5))
SET LAB("organisms",DA,"drugs",FLD,"restrict")=$PIECE(HMPM,U,5)
End DoDot:3
QUIT
End DoDot:2
End DoDot:1
+46 ;
+47 SET LAB("results",1,"uid")=ACC
+48 SET LAB("results",1,"resultUid")=$$SETUID^HMPUTILS("document",DFN,ACC)
+49 SET LAB("results",1,"localTitle")="LR MICROBIOLOGY REPORT"
+50 ; DE2818, ^LR( - ICR525
IF $LENGTH($GET(^LR(LRDFN,"MI",HMPIDT,99)))
SET LAB("comment")=^(99)
+51 ;RHL 20150102
SET LAB("lastUpdateTime")=$$EN^HMPSTMP("lab")
+52 ; RHL 20150102
SET LAB("stampTime")=LAB("lastUpdateTime")
+53 ;US6734 - pre-compile metastamp
+54 ;US6734,US11019
IF $GET(HMPMETA)
DO ADD^HMPMETA("lab",LAB("uid"),LAB("stampTime"))
if HMPMETA=1
QUIT
+55 DO ADD^HMPDJ("LAB","lab")
+56 QUIT
+57 ;
ITEM() ; -- find ITEM string from ^PXRMINDX [uses LRDFN,ID,DFN,CDT]
+1 NEW ITM,IDX,Y
SET Y=""
+2 SET IDX=LRDFN_";"_ID
SET ITM="M"
+3 FOR
SET ITM=$ORDER(^PXRMINDX(63,"PI",DFN,ITM))
if $EXTRACT(ITM)'="M"
QUIT
IF $DATA(^PXRMINDX(63,"PI",DFN,ITM,CDT,IDX))
SET Y=ITM
QUIT
+4 QUIT Y
+5 ;
AP ; -- pathology ID = HMPSUB;HMPIDT
+1 NEW LAB,LR0,X,I,NODE
+2 NEW $ESTACK,$ETRAP,ERRPAT,ERRMSG
+3 SET $ETRAP="D ERRHDLR^HMPDERRH"
SET ERRPAT=DFN
+4 SET ERRMSG="A problem occurred converting record "_ID_" for the pathology domain"
+5 ;
+6 SET LAB("localId")=ID
SET LAB("organizerType")="accession"
+7 SET LAB("uid")=$$SETUID^HMPUTILS("lab",DFN,ID)
+8 SET LAB("categoryCode")="urn:va:lab-category:"_HMPSUB
+9 SET LAB("categoryName")=$SELECT(HMPSUB="BB":"Blood Bank",HMPSUB="SP":"Surgical Pathology",1:"Pathology")
+10 SET LAB("statusCode")="urn:va:lab-status:completed"
SET LAB("statusName")="completed"
+11 SET CDT=9999999-HMPIDT
SET LAB("observed")=$$DATE(CDT)
+12 ;DE2818 begin, ^LR( references - ICR525
+13 SET LR0=$GET(^LR(LRDFN,HMPSUB,HMPIDT,0))
+14 SET LAB("resulted")=$$DATE($PIECE(LR0,U,11))
SET LAB("groupName")=$PIECE(LR0,U,6)
+15 SET X=""
SET I=0
FOR
SET I=$ORDER(^LR(LRDFN,HMPSUB,HMPIDT,.1,I))
if I<1
QUIT
SET X=X_$SELECT($LENGTH(X):", ",1:"")_$PIECE($GET(^(I,0)),U)
+16 if $LENGTH(X)
SET LAB("specimen")=X
+17 DO FACILITY^HMPUTILS($$FAC^HMPD,"LAB")
+18 SET NODE=$SELECT(HMPSUB="AU":$NAME(^LR(LRDFN,101)),1:$NAME(^LR(LRDFN,HMPSUB,HMPIDT,.05)))
+19 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
+20 NEW LT
SET LT=$$GET1^DIQ(8925,+X_",",.01)
if $PIECE(LT," ")="Addendum"
QUIT
+21 SET LAB("results",I,"uid")=LAB("uid")
+22 SET LAB("results",I,"resultUid")=$$SETUID^HMPUTILS("document",DFN,X)
+23 SET LAB("results",I,"localTitle")=LT
End DoDot:1
+24 ;non-TIU reports
IF '$ORDER(LAB("results",0))
Begin DoDot:1
+25 SET LAB("results",1,"uid")=LAB("uid")
+26 SET LAB("results",1,"resultUid")=$$SETUID^HMPUTILS("document",DFN,ID)
+27 SET LAB("results",1,"localTitle")="LR "_$$NAME^HMPDLRA(HMPSUB)_" REPORT"
End DoDot:1
+28 ; ;DE2818 end, ^LR( references - ICR525
+29 ;RHL 20150102
SET LAB("lastUpdateTime")=$$EN^HMPSTMP("lab")
+30 ; RHL 20150102
SET LAB("stampTime")=LAB("lastUpdateTime")
+31 ;US6734 - pre-compile metastamp
+32 ;US6734,US11019
IF $GET(HMPMETA)
DO ADD^HMPMETA("lab",LAB("uid"),LAB("stampTime"))
if HMPMETA=1
QUIT
+33 DO ADD^HMPDJ("LAB","lab")
+34 ;
DATE(X) ; -- strip off seconds, return JSON format
+1 NEW Y
SET Y=$GET(X)
+2 ;strip seconds
IF $LENGTH($PIECE(Y,".",2))>4
SET Y=$PIECE(Y,".")_"."_$EXTRACT($PIECE(Y,".",2),1,4)
+3 if Y
SET Y=$$JSONDT^HMPUTILS(Y)
+4 QUIT Y
LOINC(LTEST,SPC) ;DE4624 - Gets LOINC code from Lab Test/Specimin
+1 IF '$DATA(^LAB(60,LTEST))
QUIT ""
+2 IF '$DATA(^LAB(60,LTEST,1,SPC))
QUIT ""
+3 QUIT +$GET(^LAB(60,LTEST,1,SPC,95.3))
