VPRDJ06 ;SLC/MKB -- Laboratory ;6/25/12 16:11
;;1.0;VIRTUAL PATIENT RECORD;**2**;Sep 01, 2011;Build 317
;;Per VHA Directive 2004-038, this routine should not be modified.
;
; External References DBIA#
; ------------------- -----
; ^LAB(60 10054
; ^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, [VPRSTART, VPRSTOP, VPRMAX, VPRTEXT]
; & ^TMP("LRRR",$J,DFN,VPRSUB,VPRIDT,VPRP),VPRN
;
CH1 ; -- lab ID = CH;VPRIDT;VPRN
N LAB,LRI,X,X0,SPC,LOINC,ORD,CMMT
M LAB=VPRACC ;get accession info
S LAB("localId")=ID,LAB("uid")=$$SETUID^VPRUTILS("lab",DFN,ID)
S LAB("categoryCode")="urn:va:lab-category:CH"
S LAB("categoryName")="Laboratory"
S LAB("displayOrder")=VPRP
S LRI=$G(^LR(LRDFN,"CH",VPRIDT,VPRN))
S X0=$G(^TMP("LRRR",$J,DFN,"CH",VPRIDT,VPRP)),SPC=+$P(X0,U,19)
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^VPRDLR(ORD,+X0) S:X LAB("orderUid")=$$SETUID^VPRUTILS("order",DFN,X)
S LOINC=$P($P(LRI,U,3),"!",3) ;S:'LOINC LOINC=$$LOINC(+X0,SPC)
I LOINC S LAB("typeCode")="urn:lnc:"_$$GET1^DIQ(95.3,+LOINC_",",.01),LAB("vuid")="urn:va:vuid:"_$$VUID^VPRD(+LOINC,95.3)
I 'LOINC S LAB("typeCode")="urn:va:ien:60:"_+X0_":"_SPC
I $D(^TMP("LRRR",$J,DFN,"CH",VPRIDT,"N")) M CMMT=^("N") S LAB("comment")=$$STRING^VPRD(.CMMT)
S LAB("statusCode")="urn:va:lab-status:completed",LAB("statusName")="completed"
D ADD^VPRDJ("LAB","lab")
Q
;
ACC ; -- put accession-level data in VPRACC("attribute")
N LR0,CDT,SPC,X K VPRACC
S LR0=$G(^LR(LRDFN,VPRSUB,VPRIDT,0))
S CDT=9999999-VPRIDT,VPRACC("observed")=$$DATE(CDT)
S VPRACC("resulted")=$$DATE($P(LR0,U,3)),SPC=+$P(LR0,U,5) I SPC D
. N IENS,VPRY S IENS=SPC_","
. D GETS^DIQ(61,IENS,".01;4.1",,"VPRY")
. S VPRACC("specimen")=$G(VPRY(61,IENS,.01))
. S VPRACC("sample")=$G(VPRY(61,IENS,4.1))
S VPRACC("groupUid")=$$SETUID^VPRUTILS("accession",DFN,VPRSUB_";"_VPRIDT)
S VPRACC("groupName")=$P(LR0,U,6)
S X=+$P(LR0,U,14) D D FACILITY^VPRUTILS(X,"VPRACC")
. S:X X=$$STA^XUAF4(X)_U_$P($$NS^XUAF4(X),U)
. I 'X S X=$$FAC^VPRD ;local stn#^name
Q
;
MI ; -- microbiology accession ID = MI;VPRIDT
N LAB,CDT,LR0,X,ACC,FAC,X0,X1,X2,IDX,VPRM,VPRPX,VPRITM,DA,FLD
S LAB("localId")=ID,LAB("uid")=$$SETUID^VPRUTILS("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-VPRIDT,LAB("observed")=$$DATE(CDT)
S LR0=$G(^LR(LRDFN,"MI",VPRIDT,0))
S:$P(LR0,U,3) LAB("resulted")=$$DATE($P(LR0,U,3))
S X=+$P(LR0,U,5) I X D ;specimen
. N IENS,VPRY S IENS=X_","
. D GETS^DIQ(61,IENS,".01;2",,"VPRY")
. S LAB("specimen")=$G(VPRY(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^VPRUTILS("accession",DFN,ACC)
S X=$P(LR0,U,14),FAC=$S(X:$$STA^XUAF4(X)_U_$P($$NS^XUAF4(X),U),1:$$FAC^VPRD)
D FACILITY^VPRUTILS(FAC,"LAB")
; get results from ^TMP
S VPRN=0 F S VPRN=$O(^TMP("LRRR",$J,DFN,VPRSUB,VPRIDT,VPRN)) Q:VPRN<1 D
. S X0=$G(^TMP("LRRR",$J,DFN,"MI",VPRIDT,VPRN)),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",VPRN,"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 VPRM
. D LRPXRM^LRPXAPI(.VPRM,IDX,X) Q:VPRM<1
. S LAB("typeName")=$P(VPRM,U,2)
. S LAB("typeCode")="urn:va:ien:60:"_+VPRM_":"_+$P(VPRM,U,7)
F VPRPX="M;O;","M;A;" D
. S VPRITM=VPRPX F S VPRITM=$O(^PXRMINDX(63,"PDI",DFN,CDT,VPRITM)) Q:$E(VPRITM,1,4)'=VPRPX D
.. S IDX=$O(^PXRMINDX(63,"PDI",DFN,CDT,VPRITM,"")) K VPRM
.. S DA=$P(IDX,";",5),FLD=$P(IDX,";",6)
.. D LRPXRM^LRPXAPI(.VPRM,IDX,VPRITM) Q:'$L($G(VPRM))
.. I VPRPX["O" S LAB("organisms",DA,"name")=$P(VPRM,U,2),LAB("organisms",DA,"qty")=$P(VPRM,U,4) Q
.. I VPRPX["A" D Q
... S LAB("organisms",DA,"drugs",FLD,"name")=$P(VPRM,U,2)
... S LAB("organisms",DA,"drugs",FLD,"result")=$P(VPRM,U,3)
... S LAB("organisms",DA,"drugs",FLD,"interp")=$P(VPRM,U,4)
... S:$L($P(VPRM,U,5)) LAB("organisms",DA,"drugs",FLD,"restrict")=$P(VPRM,U,5)
;
S LAB("results",1,"uid")=ACC
S LAB("results",1,"resultUid")=$$SETUID^VPRUTILS("document",DFN,ACC)
S LAB("results",1,"localTitle")="LR MICROBIOLOGY REPORT"
I $L($G(^LR(LRDFN,"MI",VPRIDT,99))) S LAB("comment")=^(99)
D ADD^VPRDJ("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 = VPRSUB;VPRIDT
N LAB,LR0,X,I,NODE
S LAB("localId")=ID,LAB("organizerType")="accession"
S LAB("uid")=$$SETUID^VPRUTILS("lab",DFN,ID)
S LAB("categoryCode")="urn:va:lab-category:"_VPRSUB
S LAB("categoryName")=$S(VPRSUB="BB":"Blood Bank",VPRSUB="SP":"Surgical Pathology",1:"Pathology")
S LAB("statusCode")="urn:va:lab-status:completed",LAB("statusName")="completed"
S CDT=9999999-VPRIDT,LAB("observed")=$$DATE(CDT)
S LR0=$G(^LR(LRDFN,VPRSUB,VPRIDT,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,VPRSUB,VPRIDT,.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^VPRUTILS($$FAC^VPRD,"LAB")
S NODE=$S(VPRSUB="AU":$NA(^LR(LRDFN,101)),1:$NA(^LR(LRDFN,VPRSUB,VPRIDT,.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:NT="" NT="LABORATORY NOTE"
. S LAB("results",I,"uid")=LAB("uid")_";0"
. S LAB("results",I,"resultUid")=$$SETUID^VPRUTILS("document",DFN,X)
. S LAB("results",I,"localTitle")=LT
. S LAB("results",I,"nationalTitle")=NT
I '$O(LAB("results",0)) D ;non-TIU reports
. S LAB("results",1,"uid")=LAB("uid")_";0"
. S LAB("results",1,"resultUid")=$$SETUID^VPRUTILS("document",DFN,ID)
. S LAB("results",1,"localTitle")="LR "_$$NAME^VPRDLRA(VPRSUB)_" REPORT"
. S LAB("results",1,"nationalTitle")="LABORATORY NOTE"
D ADD^VPRDJ("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^VPRUTILS(Y)
Q Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVPRDJ06 7528 printed Nov 22, 2024@17:54:32 Page 2
VPRDJ06 ;SLC/MKB -- Laboratory ;6/25/12 16:11
+1 ;;1.0;VIRTUAL PATIENT RECORD;**2**;Sep 01, 2011;Build 317
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ; External References DBIA#
+5 ; ------------------- -----
+6 ; ^LAB(60 10054
+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, [VPRSTART, VPRSTOP, VPRMAX, VPRTEXT]
+18 ; & ^TMP("LRRR",$J,DFN,VPRSUB,VPRIDT,VPRP),VPRN
+19 ;
CH1 ; -- lab ID = CH;VPRIDT;VPRN
+1 NEW LAB,LRI,X,X0,SPC,LOINC,ORD,CMMT
+2 ;get accession info
MERGE LAB=VPRACC
+3 SET LAB("localId")=ID
SET LAB("uid")=$$SETUID^VPRUTILS("lab",DFN,ID)
+4 SET LAB("categoryCode")="urn:va:lab-category:CH"
+5 SET LAB("categoryName")="Laboratory"
+6 SET LAB("displayOrder")=VPRP
+7 SET LRI=$GET(^LR(LRDFN,"CH",VPRIDT,VPRN))
+8 SET X0=$GET(^TMP("LRRR",$JOB,DFN,"CH",VPRIDT,VPRP))
SET SPC=+$PIECE(X0,U,19)
+9 SET LAB("typeId")=+X0
SET LAB("typeName")=$PIECE($GET(^LAB(60,+X0,0)),U)
+10 if $LENGTH($PIECE(X0,U,2))
SET LAB("result")=$PIECE(X0,U,2)
+11 if $LENGTH($PIECE(X0,U,4))
SET LAB("units")=$PIECE(X0,U,4)
+12 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))
+13 SET X=$PIECE(X0,U,3)
IF $LENGTH(X)
Begin DoDot:1
+14 if X["*"
SET X=$SELECT(X["L":"LL",1:"HH")
+15 SET LAB("interpretationCode")="urn:hl7:observation-interpretation:"_X
+16 SET LAB("interpretationName")=$SELECT(X["L":"Low",1:"High")_$SELECT($LENGTH(X)>1:" alert",1:"")
End DoDot:1
+17 SET LAB("displayName")=$SELECT($LENGTH($PIECE(X0,U,15)):$PIECE(X0,U,15),1:LAB("test"))
+18 SET ORD=+$PIECE(X0,U,17)
if ORD
SET LAB("labOrderId")=ORD
+19 SET X=$$ORDER^VPRDLR(ORD,+X0)
if X
SET LAB("orderUid")=$$SETUID^VPRUTILS("order",DFN,X)
+20 ;S:'LOINC LOINC=$$LOINC(+X0,SPC)
SET LOINC=$PIECE($PIECE(LRI,U,3),"!",3)
+21 IF LOINC
SET LAB("typeCode")="urn:lnc:"_$$GET1^DIQ(95.3,+LOINC_",",.01)
SET LAB("vuid")="urn:va:vuid:"_$$VUID^VPRD(+LOINC,95.3)
+22 IF 'LOINC
SET LAB("typeCode")="urn:va:ien:60:"_+X0_":"_SPC
+23 IF $DATA(^TMP("LRRR",$JOB,DFN,"CH",VPRIDT,"N"))
MERGE CMMT=^("N")
SET LAB("comment")=$$STRING^VPRD(.CMMT)
+24 SET LAB("statusCode")="urn:va:lab-status:completed"
SET LAB("statusName")="completed"
+25 DO ADD^VPRDJ("LAB","lab")
+26 QUIT
+27 ;
ACC ; -- put accession-level data in VPRACC("attribute")
+1 NEW LR0,CDT,SPC,X
KILL VPRACC
+2 SET LR0=$GET(^LR(LRDFN,VPRSUB,VPRIDT,0))
+3 SET CDT=9999999-VPRIDT
SET VPRACC("observed")=$$DATE(CDT)
+4 SET VPRACC("resulted")=$$DATE($PIECE(LR0,U,3))
SET SPC=+$PIECE(LR0,U,5)
IF SPC
Begin DoDot:1
+5 NEW IENS,VPRY
SET IENS=SPC_","
+6 DO GETS^DIQ(61,IENS,".01;4.1",,"VPRY")
+7 SET VPRACC("specimen")=$GET(VPRY(61,IENS,.01))
+8 SET VPRACC("sample")=$GET(VPRY(61,IENS,4.1))
End DoDot:1
+9 SET VPRACC("groupUid")=$$SETUID^VPRUTILS("accession",DFN,VPRSUB_";"_VPRIDT)
+10 SET VPRACC("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^VPRD
End DoDot:1
DO FACILITY^VPRUTILS(X,"VPRACC")
+14 QUIT
+15 ;
MI ; -- microbiology accession ID = MI;VPRIDT
+1 NEW LAB,CDT,LR0,X,ACC,FAC,X0,X1,X2,IDX,VPRM,VPRPX,VPRITM,DA,FLD
+2 SET LAB("localId")=ID
SET LAB("uid")=$$SETUID^VPRUTILS("lab",DFN,ID)
+3 SET LAB("categoryCode")="urn:va:lab-category:MI"
+4 SET LAB("categoryName")="Microbiology"
+5 SET LAB("statusCode")="urn:va:lab-status:completed"
SET LAB("statusName")="completed"
+6 SET CDT=9999999-VPRIDT
SET LAB("observed")=$$DATE(CDT)
+7 SET LR0=$GET(^LR(LRDFN,"MI",VPRIDT,0))
+8 if $PIECE(LR0,U,3)
SET LAB("resulted")=$$DATE($PIECE(LR0,U,3))
+9 ;specimen
SET X=+$PIECE(LR0,U,5)
IF X
Begin DoDot:1
+10 NEW IENS,VPRY
SET IENS=X_","
+11 DO GETS^DIQ(61,IENS,".01;2",,"VPRY")
+12 SET LAB("specimen")=$GET(VPRY(61,IENS,.01))
+13 SET LAB("sample")=$$GET1^DIQ(61,X_",",4.1)
End DoDot:1
+14 ;accession#
SET LAB("groupName")=$PIECE(LR0,U,6)
SET ACC=$PIECE(ID,";",1,2)
+15 SET LAB("groupUid")=$$SETUID^VPRUTILS("accession",DFN,ACC)
+16 SET X=$PIECE(LR0,U,14)
SET FAC=$SELECT(X:$$STA^XUAF4(X)_U_$PIECE($$NS^XUAF4(X),U),1:$$FAC^VPRD)
+17 DO FACILITY^VPRUTILS(FAC,"LAB")
+18 ; get results from ^TMP
+19 SET VPRN=0
FOR
SET VPRN=$ORDER(^TMP("LRRR",$JOB,DFN,VPRSUB,VPRIDT,VPRN))
if VPRN<1
QUIT
Begin DoDot:1
+20 SET X0=$GET(^TMP("LRRR",$JOB,DFN,"MI",VPRIDT,VPRN))
SET X1=$PIECE(X0,U)
SET X2=$PIECE(X0,U,2)
+21 IF X1="URINE SCREEN"
SET LAB("urineScreen")=X2
QUIT
+22 ; X1="ORGANISM" S LAB("organism")=$P(X2,";"),LAB("organismQty")=$P(X2,";",2)
+23 IF X1="GRAM STAIN"
SET LAB("gramStain",VPRN,"result")=X2
QUIT
+24 IF X1="Bacteriology Remark(s)"
SET LAB("bactRemarks")=X2
QUIT
End DoDot:1
+25 ; get other results from ^PXRMINDX
+26 SET X=$ORDER(^PXRMINDX(63,"PDI",DFN,CDT,"M;T;0"))
IF X?1"M;T;"1.N
Begin DoDot:1
+27 SET IDX=$ORDER(^PXRMINDX(63,"PDI",DFN,CDT,X,""))
KILL VPRM
+28 DO LRPXRM^LRPXAPI(.VPRM,IDX,X)
if VPRM<1
QUIT
+29 SET LAB("typeName")=$PIECE(VPRM,U,2)
+30 SET LAB("typeCode")="urn:va:ien:60:"_+VPRM_":"_+$PIECE(VPRM,U,7)
End DoDot:1
+31 FOR VPRPX="M;O;","M;A;"
Begin DoDot:1
+32 SET VPRITM=VPRPX
FOR
SET VPRITM=$ORDER(^PXRMINDX(63,"PDI",DFN,CDT,VPRITM))
if $EXTRACT(VPRITM,1,4)'=VPRPX
QUIT
Begin DoDot:2
+33 SET IDX=$ORDER(^PXRMINDX(63,"PDI",DFN,CDT,VPRITM,""))
KILL VPRM
+34 SET DA=$PIECE(IDX,";",5)
SET FLD=$PIECE(IDX,";",6)
+35 DO LRPXRM^LRPXAPI(.VPRM,IDX,VPRITM)
if '$LENGTH($GET(VPRM))
QUIT
+36 IF VPRPX["O"
SET LAB("organisms",DA,"name")=$PIECE(VPRM,U,2)
SET LAB("organisms",DA,"qty")=$PIECE(VPRM,U,4)
QUIT
+37 IF VPRPX["A"
Begin DoDot:3
+38 SET LAB("organisms",DA,"drugs",FLD,"name")=$PIECE(VPRM,U,2)
+39 SET LAB("organisms",DA,"drugs",FLD,"result")=$PIECE(VPRM,U,3)
+40 SET LAB("organisms",DA,"drugs",FLD,"interp")=$PIECE(VPRM,U,4)
+41 if $LENGTH($PIECE(VPRM,U,5))
SET LAB("organisms",DA,"drugs",FLD,"restrict")=$PIECE(VPRM,U,5)
End DoDot:3
QUIT
End DoDot:2
End DoDot:1
+42 ;
+43 SET LAB("results",1,"uid")=ACC
+44 SET LAB("results",1,"resultUid")=$$SETUID^VPRUTILS("document",DFN,ACC)
+45 SET LAB("results",1,"localTitle")="LR MICROBIOLOGY REPORT"
+46 IF $LENGTH($GET(^LR(LRDFN,"MI",VPRIDT,99)))
SET LAB("comment")=^(99)
+47 DO ADD^VPRDJ("LAB","lab")
+48 QUIT
+49 ;
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 = VPRSUB;VPRIDT
+1 NEW LAB,LR0,X,I,NODE
+2 SET LAB("localId")=ID
SET LAB("organizerType")="accession"
+3 SET LAB("uid")=$$SETUID^VPRUTILS("lab",DFN,ID)
+4 SET LAB("categoryCode")="urn:va:lab-category:"_VPRSUB
+5 SET LAB("categoryName")=$SELECT(VPRSUB="BB":"Blood Bank",VPRSUB="SP":"Surgical Pathology",1:"Pathology")
+6 SET LAB("statusCode")="urn:va:lab-status:completed"
SET LAB("statusName")="completed"
+7 SET CDT=9999999-VPRIDT
SET LAB("observed")=$$DATE(CDT)
+8 SET LR0=$GET(^LR(LRDFN,VPRSUB,VPRIDT,0))
+9 SET LAB("resulted")=$$DATE($PIECE(LR0,U,11))
SET LAB("groupName")=$PIECE(LR0,U,6)
+10 SET X=""
SET I=0
FOR
SET I=$ORDER(^LR(LRDFN,VPRSUB,VPRIDT,.1,I))
if I<1
QUIT
SET X=X_$SELECT($LENGTH(X):", ",1:"")_$PIECE($GET(^(I,0)),U)
+11 if $LENGTH(X)
SET LAB("specimen")=X
+12 DO FACILITY^VPRUTILS($$FAC^VPRD,"LAB")
+13 SET NODE=$SELECT(VPRSUB="AU":$NAME(^LR(LRDFN,101)),1:$NAME(^LR(LRDFN,VPRSUB,VPRIDT,.05)))
+14 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
+15 NEW LT,NT
+16 SET LT=$$GET1^DIQ(8925,+X_",",.01)
if $PIECE(LT," ")="Addendum"
QUIT
+17 SET NT=$$GET1^DIQ(8925,+X_",",".01:1501")
if NT=""
SET NT="LABORATORY NOTE"
+18 SET LAB("results",I,"uid")=LAB("uid")_";0"
+19 SET LAB("results",I,"resultUid")=$$SETUID^VPRUTILS("document",DFN,X)
+20 SET LAB("results",I,"localTitle")=LT
+21 SET LAB("results",I,"nationalTitle")=NT
End DoDot:1
+22 ;non-TIU reports
IF '$ORDER(LAB("results",0))
Begin DoDot:1
+23 SET LAB("results",1,"uid")=LAB("uid")_";0"
+24 SET LAB("results",1,"resultUid")=$$SETUID^VPRUTILS("document",DFN,ID)
+25 SET LAB("results",1,"localTitle")="LR "_$$NAME^VPRDLRA(VPRSUB)_" REPORT"
+26 SET LAB("results",1,"nationalTitle")="LABORATORY NOTE"
End DoDot:1
+27 DO ADD^VPRDJ("LAB","lab")
+28 ;
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^VPRUTILS(Y)
+4 QUIT Y
