Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: HMPDJ06

HMPDJ06.m

Go to the documentation of this file. 
  1. 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
  1.  ;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1.  ; External References          DBIA#
  1.  ; -------------------          -----
  1.  ; ^LAB(60                         91
  1.  ; ^LR                            525
  1.  ; ^PXRMINDX                     4290
  1.  ; ^TMP("LRRR" [LR7OR1]          2503
  1.  ; DIQ                           2056
  1.  ; LR7OR1,^TMP("LRRR"            2503
  1.  ; LRPXAPI                       4245
  1.  ; LRPXAPIU                      4246
  1.  ; XLFSTR                       10104
  1.  ; XUAF4                         2171
  1.  ;
  1.  ; All tags expect DFN, ID, LRDFN, [HMPSTART, HMPSTOP, HMPMAX, HMPTEXT]
  1.  ;               & ^TMP("LRRR",$J,DFN,HMPSUB,HMPIDT,HMPP),HMPN
  1.  Q
  1.  ;
  1. CH1 ; -- lab ID = CH;HMPIDT;HMPN
  1.  N LAB,LRI,X,X0,SPC,LOINC,ORD,CMMT
  1.  N $ES,$ET,ERRPAT,ERRMSG
  1.  S $ET="D ERRHDLR^HMPDERRH",ERRPAT=DFN
  1.  S ERRMSG="A problem occurred converting record "_ID_" for the chemistry domain"
  1.  ;
  1.  M LAB=HMPACC ;get accession info
  1.  S LAB("localId")=ID,LAB("uid")=$$SETUID^HMPUTILS("lab",DFN,ID)
  1.  S LAB("categoryCode")="urn:va:lab-category:CH"
  1.  S LAB("categoryName")="Laboratory"
  1.  S LAB("displayOrder")=HMPP
  1.  S LRI=$G(^LR(LRDFN,"CH",HMPIDT,HMPN))  ;DE2818, ^LR( - ICR525
  1.  S X0=$G(^TMP("LRRR",$J,DFN,"CH",HMPIDT,HMPP)),SPC=+$P(X0,U,19)
  1.  ;DE2818 - ^LAB(60) references - ICR 91
  1.  S LAB("typeId")=+X0,LAB("typeName")=$P($G(^LAB(60,+X0,0)),U)
  1.  S:$L($P(X0,U,2)) LAB("result")=$P(X0,U,2)
  1.  S:$L($P(X0,U,4)) LAB("units")=$P(X0,U,4)
  1.  S X=$P(X0,U,5) I $L(X),X["-" S LAB("low")=$$TRIM^XLFSTR($P(X,"-")),LAB("high")=$$TRIM^XLFSTR($P(X,"-",2))
  1.  S X=$P(X0,U,3) I $L(X) D
  1.  . S:X["*" X=$S(X["L":"LL",1:"HH")
  1.  . S LAB("interpretationCode")="urn:hl7:observation-interpretation:"_X
  1.  . S LAB("interpretationName")=$S(X["L":"Low",1:"High")_$S($L(X)>1:" alert",1:"")
  1.  S LAB("displayName")=$S($L($P(X0,U,15)):$P(X0,U,15),1:LAB("test"))
  1.  S ORD=+$P(X0,U,17) S:ORD LAB("labOrderId")=ORD
  1.  S X=$$ORDER^HMPDLR(ORD,+X0) S:X LAB("orderUid")=$$SETUID^HMPUTILS("order",DFN,X)
  1.  ;DE4624 - If no LOINC code in the lab data, check in the LABRATORY TEST (#60) file
  1.  S LOINC=$P($P(LRI,U,3),"!",3) S:'LOINC LOINC=$$LOINC^HMPDJ06(+X0,SPC)
  1.  I LOINC S LAB("typeCode")="urn:lnc:"_$$GET1^DIQ(95.3,+LOINC_",",.01),LAB("vuid")="urn:va:vuid:"_$$VUID^HMPD(+LOINC,95.3)
  1.  I 'LOINC S LAB("typeCode")="urn:va:ien:60:"_+X0_":"_SPC
  1.  I $D(^TMP("LRRR",$J,DFN,"CH",HMPIDT,"N")) M CMMT=^("N") S LAB("comment")=$$STRING^HMPD(.CMMT)
  1.  S LAB("statusCode")="urn:va:lab-status:completed",LAB("statusName")="completed"
  1.  S LAB("lastUpdateTime")=$$EN^HMPSTMP("lab") ;RHL 20150102
  1.  S LAB("stampTime")=LAB("lastUpdateTime") ; RHL 20150102
  1.  ;US6734 - pre-compile metastamp
  1.  I $G(HMPMETA) D ADD^HMPMETA("lab",LAB("uid"),LAB("stampTime")) Q:HMPMETA=1  ;US6734,US11019
  1.  D ADD^HMPDJ("LAB","lab")
  1.  Q
  1.  ;
  1. ACC ; -- put accession-level data in HMPACC("attribute")
  1.  N LR0,CDT,SPC,X K HMPACC
  1.  S LR0=$G(^LR(LRDFN,HMPSUB,HMPIDT,0))  ;DE2818, ^LR( - ICR525
  1.  S CDT=9999999-HMPIDT,HMPACC("observed")=$$DATE(CDT)
  1.  S HMPACC("resulted")=$$DATE($P(LR0,U,3)),SPC=+$P(LR0,U,5) I SPC D
  1.  . N IENS,HMPY S IENS=SPC_","
  1.  . D GETS^DIQ(61,IENS,".01;4.1",,"HMPY")
  1.  . S HMPACC("specimen")=$G(HMPY(61,IENS,.01))
  1.  . S HMPACC("sample")=$G(HMPY(61,IENS,4.1))
  1.  S HMPACC("groupUid")=$$SETUID^HMPUTILS("accession",DFN,HMPSUB_";"_HMPIDT)
  1.  S HMPACC("groupName")=$P(LR0,U,6)
  1.  S X=+$P(LR0,U,14) D  D FACILITY^HMPUTILS(X,"HMPACC")
  1.  . S:X X=$$STA^XUAF4(X)_U_$P($$NS^XUAF4(X),U)
  1.  . I 'X S X=$$FAC^HMPD ;local stn#^name
  1.  Q
  1.  ;
  1. MI ; -- microbiology accession ID = MI;HMPIDT
  1.  N LAB,CDT,LR0,X,ACC,FAC,X0,X1,X2,IDX,HMPM,HMPPX,HMPITM,DA,FLD
  1.  N $ES,$ET,ERRPAT,ERRMSG
  1.  S $ET="D ERRHDLR^HMPDERRH",ERRPAT=DFN
  1.  S ERRMSG="A problem occurred converting record "_ID_" for the microbiology domain"
  1.  ;
  1.  S LAB("localId")=ID,LAB("uid")=$$SETUID^HMPUTILS("lab",DFN,ID)
  1.  S LAB("categoryCode")="urn:va:lab-category:MI"
  1.  S LAB("categoryName")="Microbiology"
  1.  S LAB("statusCode")="urn:va:lab-status:completed",LAB("statusName")="completed"
  1.  S CDT=9999999-HMPIDT,LAB("observed")=$$DATE(CDT)
  1.  S LR0=$G(^LR(LRDFN,"MI",HMPIDT,0))  ; DE2818, ^LR( - ICR525
  1.  S:$P(LR0,U,3) LAB("resulted")=$$DATE($P(LR0,U,3))
  1.  S X=+$P(LR0,U,5) I X D  ;specimen
  1.  . N IENS,HMPY S IENS=X_","
  1.  . D GETS^DIQ(61,IENS,".01;2",,"HMPY")
  1.  . S LAB("specimen")=$G(HMPY(61,IENS,.01))
  1.  . S LAB("sample")=$$GET1^DIQ(61,X_",",4.1)
  1.  S LAB("groupName")=$P(LR0,U,6),ACC=$P(ID,";",1,2) ;accession#
  1.  S LAB("groupUid")=$$SETUID^HMPUTILS("accession",DFN,ACC)
  1.  S X=$P(LR0,U,14),FAC=$S(X:$$STA^XUAF4(X)_U_$P($$NS^XUAF4(X),U),1:$$FAC^HMPD)
  1.  D FACILITY^HMPUTILS(FAC,"LAB")
  1.  ; get results from ^TMP
  1.  S HMPN=0 F  S HMPN=$O(^TMP("LRRR",$J,DFN,HMPSUB,HMPIDT,HMPN)) Q:HMPN<1  D
  1.  . S X0=$G(^TMP("LRRR",$J,DFN,"MI",HMPIDT,HMPN)),X1=$P(X0,U),X2=$P(X0,U,2)
  1.  . I X1="URINE SCREEN" S LAB("urineScreen")=X2 Q
  1.  . ; X1="ORGANISM" S LAB("organism")=$P(X2,";"),LAB("organismQty")=$P(X2,";",2)
  1.  . I X1="GRAM STAIN" S LAB("gramStain",HMPN,"result")=X2 Q
  1.  . I X1="Bacteriology Remark(s)" S LAB("bactRemarks")=X2 Q
  1.  ; get other results from ^PXRMINDX
  1.  S X=$O(^PXRMINDX(63,"PDI",DFN,CDT,"M;T;0")) I X?1"M;T;"1.N D
  1.  . S IDX=$O(^PXRMINDX(63,"PDI",DFN,CDT,X,"")) K HMPM
  1.  . D LRPXRM^LRPXAPI(.HMPM,IDX,X) Q:HMPM<1
  1.  . S LAB("typeName")=$P(HMPM,U,2)
  1.  . S LAB("typeCode")="urn:va:ien:60:"_+HMPM_":"_+$P(HMPM,U,7)
  1.  F HMPPX="M;O;","M;A;" D
  1.  . S HMPITM=HMPPX F  S HMPITM=$O(^PXRMINDX(63,"PDI",DFN,CDT,HMPITM)) Q:$E(HMPITM,1,4)'=HMPPX  D
  1.  .. S IDX=$O(^PXRMINDX(63,"PDI",DFN,CDT,HMPITM,"")) K HMPM
  1.  .. S DA=$P(IDX,";",5),FLD=$P(IDX,";",6)
  1.  .. D LRPXRM^LRPXAPI(.HMPM,IDX,HMPITM) Q:'$L($G(HMPM))
  1.  .. I HMPPX["O" S LAB("organisms",DA,"name")=$P(HMPM,U,2),LAB("organisms",DA,"qty")=$P(HMPM,U,4) Q
  1.  .. I HMPPX["A" D  Q
  1.  ... S LAB("organisms",DA,"drugs",FLD,"name")=$P(HMPM,U,2)
  1.  ... S LAB("organisms",DA,"drugs",FLD,"result")=$P(HMPM,U,3)
  1.  ... S LAB("organisms",DA,"drugs",FLD,"interp")=$P(HMPM,U,4)
  1.  ... S:$L($P(HMPM,U,5)) LAB("organisms",DA,"drugs",FLD,"restrict")=$P(HMPM,U,5)
  1.  ;
  1.  S LAB("results",1,"uid")=ACC
  1.  S LAB("results",1,"resultUid")=$$SETUID^HMPUTILS("document",DFN,ACC)
  1.  S LAB("results",1,"localTitle")="LR MICROBIOLOGY REPORT"
  1.  I $L($G(^LR(LRDFN,"MI",HMPIDT,99))) S LAB("comment")=^(99)  ; DE2818, ^LR( - ICR525
  1.  S LAB("lastUpdateTime")=$$EN^HMPSTMP("lab") ;RHL 20150102
  1.  S LAB("stampTime")=LAB("lastUpdateTime") ; RHL 20150102
  1.  ;US6734 - pre-compile metastamp
  1.  I $G(HMPMETA) D ADD^HMPMETA("lab",LAB("uid"),LAB("stampTime")) Q:HMPMETA=1  ;US6734,US11019
  1.  D ADD^HMPDJ("LAB","lab")
  1.  Q
  1.  ;
  1. ITEM() ; -- find ITEM string from ^PXRMINDX [uses LRDFN,ID,DFN,CDT]
  1.  N ITM,IDX,Y S Y=""
  1.  S IDX=LRDFN_";"_ID,ITM="M"
  1.  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
  1.  Q Y
  1.  ;
  1. AP ; -- pathology ID = HMPSUB;HMPIDT
  1.  N LAB,LR0,X,I,NODE
  1.  N $ES,$ET,ERRPAT,ERRMSG
  1.  S $ET="D ERRHDLR^HMPDERRH",ERRPAT=DFN
  1.  S ERRMSG="A problem occurred converting record "_ID_" for the pathology domain"
  1.  ;
  1.  S LAB("localId")=ID,LAB("organizerType")="accession"
  1.  S LAB("uid")=$$SETUID^HMPUTILS("lab",DFN,ID)
  1.  S LAB("categoryCode")="urn:va:lab-category:"_HMPSUB
  1.  S LAB("categoryName")=$S(HMPSUB="BB":"Blood Bank",HMPSUB="SP":"Surgical Pathology",1:"Pathology")
  1.  S LAB("statusCode")="urn:va:lab-status:completed",LAB("statusName")="completed"
  1.  S CDT=9999999-HMPIDT,LAB("observed")=$$DATE(CDT)
  1.  ;DE2818 begin, ^LR( references - ICR525
  1.  S LR0=$G(^LR(LRDFN,HMPSUB,HMPIDT,0))
  1.  S LAB("resulted")=$$DATE($P(LR0,U,11)),LAB("groupName")=$P(LR0,U,6)
  1.  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)
  1.  S:$L(X) LAB("specimen")=X
  1.  D FACILITY^HMPUTILS($$FAC^HMPD,"LAB")
  1.  S NODE=$S(HMPSUB="AU":$NA(^LR(LRDFN,101)),1:$NA(^LR(LRDFN,HMPSUB,HMPIDT,.05)))
  1.  S I=0 F  S I=$O(@NODE@(I)) Q:I<1  S X=+$P($G(@NODE@(I,0)),U,2) I X D
  1.  . N LT S LT=$$GET1^DIQ(8925,+X_",",.01) Q:$P(LT," ")="Addendum"
  1.  . S LAB("results",I,"uid")=LAB("uid")
  1.  . S LAB("results",I,"resultUid")=$$SETUID^HMPUTILS("document",DFN,X)
  1.  . S LAB("results",I,"localTitle")=LT
  1.  I '$O(LAB("results",0)) D  ;non-TIU reports
  1.  . S LAB("results",1,"uid")=LAB("uid")
  1.  . S LAB("results",1,"resultUid")=$$SETUID^HMPUTILS("document",DFN,ID)
  1.  . S LAB("results",1,"localTitle")="LR "_$$NAME^HMPDLRA(HMPSUB)_" REPORT"
  1.  ; ;DE2818 end, ^LR( references - ICR525
  1.  S LAB("lastUpdateTime")=$$EN^HMPSTMP("lab") ;RHL 20150102
  1.  S LAB("stampTime")=LAB("lastUpdateTime") ; RHL 20150102
  1.  ;US6734 - pre-compile metastamp
  1.  I $G(HMPMETA) D ADD^HMPMETA("lab",LAB("uid"),LAB("stampTime")) Q:HMPMETA=1  ;US6734,US11019
  1.  D ADD^HMPDJ("LAB","lab")
  1.  ;
  1. DATE(X) ; -- strip off seconds, return JSON format
  1.  N Y S Y=$G(X)
  1.  I $L($P(Y,".",2))>4 S Y=$P(Y,".")_"."_$E($P(Y,".",2),1,4) ;strip seconds
  1.  S:Y Y=$$JSONDT^HMPUTILS(Y)
  1.  Q Y
  1. LOINC(LTEST,SPC) ;DE4624 - Gets LOINC code from Lab Test/Specimin
  1.  I '$D(^LAB(60,LTEST)) Q ""
  1.  I '$D(^LAB(60,LTEST,1,SPC)) Q ""
  1.  Q +$G(^LAB(60,LTEST,1,SPC,95.3))