ORQQLR1 ; slc/CLA - Extrinsic functions and procedures which return patient lab results ; 7/10/17 5:45pm
;;3.0;ORDER ENTRY/RESULTS REPORTING;**6,51,74,143,414**;Dec 17, 1997;Build 8
;Per VA Directive 6402, this routine should not be modified.
;
;DBIA reference section
;2387 ^LAB(60
;2503 RR^LR7OR1
;10103 FMTE^XLFDT
;
OETOLAB(ORNUM) ;extrinsic funct to get a lab order number from an oe/rr number
N LRNUM
S LRNUM=$G(^OR(100,ORNUM,4))
Q +LRNUM
;
PRINTNAM(LRIEN) ;extrinsic function to return the print name for an entry in the Lab file [#60]
Q:+$G(LRIEN)<1 ""
N NODE,NAME
S NODE=$G(^LAB(60,LRIEN,.1))
Q:'$L(NODE) ""
S NAME=$P(NODE,U)
Q NAME
;
OIRES(PT,OILR,SPEC) ;extrinsic function to return pt's most recent lab results for a lab orderable item in the format:
; test id^abbrev test name^result^units^flag^collection d/t
N RSLT,ORZ
S ORZ=""
S RSLT=$$GETDATA^OCXCACHE(.ORZ,"$$OIRESC^ORQQLR1("_PT_","_OILR_","_SPEC_")",PT,)
Q ORZ
;
OIRESC(PT,OILR,SPEC) ;extrinsic function to return pt's most recent lab results for a lab orderable item in the format:
; test id^abbrev test name^result^units^flag^collection d/t
N ORY,ORX,ORN,ORLR,SUB,INVDT,SEQ,ORDG,RESULT
S SUB="",INVDT=0,SEQ=0,ORY=""
;check to make sure the OI is in DG lab
Q:'$L($G(PT))!('$L($G(OILR))) ORY
Q:'$L($G(^ORD(101.43,OILR,0))) ORY
I +$G(SPEC)<1 S SPEC=""
S ORDG=$$DG^ORQOR1("LAB")
Q:'$L($G(ORDG)) ORY
Q:$P(^ORD(101.43,OILR,0),U,5)'=ORDG ORY ;quit if display grp is not lab
;get lab test ien
S ORX=$P(^ORD(101.43,OILR,0),U,2)
S ORLR=$S(ORX["~":$P(ORX,"~"),1:$P(ORX,";"))
;get lab results
K ^TMP("LRRR",$J)
D RR^LR7OR1(PT,"","","","",ORLR,"L",1,SPEC) I $D(^TMP("LRRR",$J,PT)) D
.S SUB=$O(^TMP("LRRR",$J,PT,SUB)) Q:SUB=""
.S INVDT=$O(^TMP("LRRR",$J,PT,SUB,INVDT)) Q:'INVDT
.S SEQ=$O(^TMP("LRRR",$J,PT,SUB,INVDT,SEQ)) Q:'SEQ D
..S RESULT=^(SEQ),ORY=$P(RESULT,U)_U_$P(RESULT,U,15)_U_$P(RESULT,U,2)_U_$P(RESULT,U,4)_U_$P(RESULT,U,3)_U_$P(RESULT,U,5)_U_(9999999-INVDT)
K ^TMP("LRRR",$J)
Q ORY
;
NATL(PT,NID,SPEC) ;extrinsic function to return pt's most recent lab results for a lab national id in the format:
; test id^abbrev test name^result^units^flag^collection d/t
N RSLT,ORZ
S ORZ=""
S RSLT=$$GETDATA^OCXCACHE(.ORZ,"$$NATLC^ORQQLR1("_PT_","_NID_","_SPEC_")",PT,)
Q ORZ
;
NATLC(PT,NID,SPEC) ;extrinsic function to return pt's most recent lab results for a lab national id in the format:
; test id^abbrev test name^result^units^flag^collection d/t
N ORY,ORX,ORN,ORLR,SUB,INVDT,SEQ,ORDG
S SUB="",INVDT=0,SEQ=0,ORY=""
I +$G(SPEC)<1 S SPEC=""
;get lab results
K ^TMP("LRRR",$J)
D RR^LR7OR1(PT,"","","","",NID,"N",1,SPEC) I $D(^TMP("LRRR",$J,PT)) D
.S SUB=$O(^TMP("LRRR",$J,PT,SUB)) Q:SUB=""
.S INVDT=$O(^TMP("LRRR",$J,PT,SUB,INVDT)) Q:'INVDT
.S SEQ=$O(^TMP("LRRR",$J,PT,SUB,INVDT,SEQ)) Q:'SEQ D
..S RESULT=^(SEQ),ORY=$P(RESULT,U)_U_$P(RESULT,U,15)_U_$P(RESULT,U,2)_U_$P(RESULT,U,4)_U_$P(RESULT,U,3)_U_$P(RESULT,U,5)_U_(9999999-INVDT)
K ^TMP("LRRR",$J)
Q ORY
;
LOCL(PT,LID,SPEC) ;extrinsic function to return pt's most recent lab results for a lab local id in the format:
; test id^abbrev test name^result^units^flag^collection d/t
N RSLT,ORZ
S ORZ=""
S RSLT=$$GETDATA^OCXCACHE(.ORZ,"$$LOCLC^ORQQLR1("_PT_","_LID_","_SPEC_")",PT,)
Q ORZ
;
LOCLC(PT,LID,SPEC) ;extrinsic function to return pt's most recent lab results for a lab local id in the format:
; test id^abbrev test name^result^units^flag^collection d/t
N ORY,ORX,SUB,INVDT,SEQ,RESULT
S SUB="",INVDT=0,SEQ=0,ORY=""
;get lab results
I +$G(SPEC)<1 S SPEC=""
K ^TMP("LRRR",$J)
D RR^LR7OR1(PT,"","","","",LID,"L",,SPEC) I $D(^TMP("LRRR",$J,PT)) D
.S SUB=$O(^TMP("LRRR",$J,PT,SUB)) Q:SUB=""
.S INVDT="" F S INVDT=$O(^TMP("LRRR",$J,PT,SUB,INVDT)) Q:'INVDT D
..S SEQ="" F S SEQ=$O(^TMP("LRRR",$J,PT,SUB,INVDT,SEQ)) Q:'SEQ!(+$G(RESULT)>0) D
...S ORX=^(SEQ)
...I $P(ORX,U,2)'="canc" D ;if results were not cancelled in lab:
....S RESULT=$P(ORX,U,2)
....S ORY=$P(ORX,U)_U_$P(ORX,U,15)_U_$P(ORX,U,2)_U_$P(ORX,U,4)
....S ORY=ORY_U_$P(ORX,U,3)_U_$P(ORX,U,5)_U_(9999999-INVDT)
K ^TMP("LRRR",$J)
Q ORY
;
LOCLFORM(PT,LID,SPEC) ;extrinsic function to return formatted most recnt lab
;rtn format: 1 (if results)^<print name> <value> <units> <high/low flag>
; (<reference range>) <collection date/time>
N FRCNT,X
S X=$$LOCL(PT,LID,SPEC)
Q:'$L(X) "^No results found."
S FRCNT="1^"_$P(X,U,2)_" "_$P(X,U,3)_" "_$P(X,U,4)_" "_$P(X,U,5)
S FRCNT=FRCNT_" ("_$P(X,U,6)_") "_$$FMTE^XLFDT($P(X,U,7),"2P")
Q FRCNT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORQQLR1 4631 printed Apr 09, 2024@21:37:29 Page 2
ORQQLR1 ; slc/CLA - Extrinsic functions and procedures which return patient lab results ; 7/10/17 5:45pm
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**6,51,74,143,414**;Dec 17, 1997;Build 8
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ;DBIA reference section
+5 ;2387 ^LAB(60
+6 ;2503 RR^LR7OR1
+7 ;10103 FMTE^XLFDT
+8 ;
OETOLAB(ORNUM) ;extrinsic funct to get a lab order number from an oe/rr number
+1 NEW LRNUM
+2 SET LRNUM=$GET(^OR(100,ORNUM,4))
+3 QUIT +LRNUM
+4 ;
PRINTNAM(LRIEN) ;extrinsic function to return the print name for an entry in the Lab file [#60]
+1 if +$GET(LRIEN)<1
QUIT ""
+2 NEW NODE,NAME
+3 SET NODE=$GET(^LAB(60,LRIEN,.1))
+4 if '$LENGTH(NODE)
QUIT ""
+5 SET NAME=$PIECE(NODE,U)
+6 QUIT NAME
+7 ;
OIRES(PT,OILR,SPEC) ;extrinsic function to return pt's most recent lab results for a lab orderable item in the format:
+1 ; test id^abbrev test name^result^units^flag^collection d/t
+2 NEW RSLT,ORZ
+3 SET ORZ=""
+4 SET RSLT=$$GETDATA^OCXCACHE(.ORZ,"$$OIRESC^ORQQLR1("_PT_","_OILR_","_SPEC_")",PT,)
+5 QUIT ORZ
+6 ;
OIRESC(PT,OILR,SPEC) ;extrinsic function to return pt's most recent lab results for a lab orderable item in the format:
+1 ; test id^abbrev test name^result^units^flag^collection d/t
+2 NEW ORY,ORX,ORN,ORLR,SUB,INVDT,SEQ,ORDG,RESULT
+3 SET SUB=""
SET INVDT=0
SET SEQ=0
SET ORY=""
+4 ;check to make sure the OI is in DG lab
+5 if '$LENGTH($GET(PT))!('$LENGTH($GET(OILR)))
QUIT ORY
+6 if '$LENGTH($GET(^ORD(101.43,OILR,0)))
QUIT ORY
+7 IF +$GET(SPEC)<1
SET SPEC=""
+8 SET ORDG=$$DG^ORQOR1("LAB")
+9 if '$LENGTH($GET(ORDG))
QUIT ORY
+10 ;quit if display grp is not lab
if $PIECE(^ORD(101.43,OILR,0),U,5)'=ORDG
QUIT ORY
+11 ;get lab test ien
+12 SET ORX=$PIECE(^ORD(101.43,OILR,0),U,2)
+13 SET ORLR=$SELECT(ORX["~":$PIECE(ORX,"~"),1:$PIECE(ORX,";"))
+14 ;get lab results
+15 KILL ^TMP("LRRR",$JOB)
+16 DO RR^LR7OR1(PT,"","","","",ORLR,"L",1,SPEC)
IF $DATA(^TMP("LRRR",$JOB,PT))
Begin DoDot:1
+17 SET SUB=$ORDER(^TMP("LRRR",$JOB,PT,SUB))
if SUB=""
QUIT
+18 SET INVDT=$ORDER(^TMP("LRRR",$JOB,PT,SUB,INVDT))
if 'INVDT
QUIT
+19 SET SEQ=$ORDER(^TMP("LRRR",$JOB,PT,SUB,INVDT,SEQ))
if 'SEQ
QUIT
Begin DoDot:2
+20 SET RESULT=^(SEQ)
SET ORY=$PIECE(RESULT,U)_U_$PIECE(RESULT,U,15)_U_$PIECE(RESULT,U,2)_U_$PIECE(RESULT,U,4)_U_$PIECE(RESULT,U,3)_U_$PIECE(RESULT,U,5)_U_(9999999-INVDT)
End DoDot:2
End DoDot:1
+21 KILL ^TMP("LRRR",$JOB)
+22 QUIT ORY
+23 ;
NATL(PT,NID,SPEC) ;extrinsic function to return pt's most recent lab results for a lab national id in the format:
+1 ; test id^abbrev test name^result^units^flag^collection d/t
+2 NEW RSLT,ORZ
+3 SET ORZ=""
+4 SET RSLT=$$GETDATA^OCXCACHE(.ORZ,"$$NATLC^ORQQLR1("_PT_","_NID_","_SPEC_")",PT,)
+5 QUIT ORZ
+6 ;
NATLC(PT,NID,SPEC) ;extrinsic function to return pt's most recent lab results for a lab national id in the format:
+1 ; test id^abbrev test name^result^units^flag^collection d/t
+2 NEW ORY,ORX,ORN,ORLR,SUB,INVDT,SEQ,ORDG
+3 SET SUB=""
SET INVDT=0
SET SEQ=0
SET ORY=""
+4 IF +$GET(SPEC)<1
SET SPEC=""
+5 ;get lab results
+6 KILL ^TMP("LRRR",$JOB)
+7 DO RR^LR7OR1(PT,"","","","",NID,"N",1,SPEC)
IF $DATA(^TMP("LRRR",$JOB,PT))
Begin DoDot:1
+8 SET SUB=$ORDER(^TMP("LRRR",$JOB,PT,SUB))
if SUB=""
QUIT
+9 SET INVDT=$ORDER(^TMP("LRRR",$JOB,PT,SUB,INVDT))
if 'INVDT
QUIT
+10 SET SEQ=$ORDER(^TMP("LRRR",$JOB,PT,SUB,INVDT,SEQ))
if 'SEQ
QUIT
Begin DoDot:2
+11 SET RESULT=^(SEQ)
SET ORY=$PIECE(RESULT,U)_U_$PIECE(RESULT,U,15)_U_$PIECE(RESULT,U,2)_U_$PIECE(RESULT,U,4)_U_$PIECE(RESULT,U,3)_U_$PIECE(RESULT,U,5)_U_(9999999-INVDT)
End DoDot:2
End DoDot:1
+12 KILL ^TMP("LRRR",$JOB)
+13 QUIT ORY
+14 ;
LOCL(PT,LID,SPEC) ;extrinsic function to return pt's most recent lab results for a lab local id in the format:
+1 ; test id^abbrev test name^result^units^flag^collection d/t
+2 NEW RSLT,ORZ
+3 SET ORZ=""
+4 SET RSLT=$$GETDATA^OCXCACHE(.ORZ,"$$LOCLC^ORQQLR1("_PT_","_LID_","_SPEC_")",PT,)
+5 QUIT ORZ
+6 ;
LOCLC(PT,LID,SPEC) ;extrinsic function to return pt's most recent lab results for a lab local id in the format:
+1 ; test id^abbrev test name^result^units^flag^collection d/t
+2 NEW ORY,ORX,SUB,INVDT,SEQ,RESULT
+3 SET SUB=""
SET INVDT=0
SET SEQ=0
SET ORY=""
+4 ;get lab results
+5 IF +$GET(SPEC)<1
SET SPEC=""
+6 KILL ^TMP("LRRR",$JOB)
+7 DO RR^LR7OR1(PT,"","","","",LID,"L",,SPEC)
IF $DATA(^TMP("LRRR",$JOB,PT))
Begin DoDot:1
+8 SET SUB=$ORDER(^TMP("LRRR",$JOB,PT,SUB))
if SUB=""
QUIT
+9 SET INVDT=""
FOR
SET INVDT=$ORDER(^TMP("LRRR",$JOB,PT,SUB,INVDT))
if 'INVDT
QUIT
Begin DoDot:2
+10 SET SEQ=""
FOR
SET SEQ=$ORDER(^TMP("LRRR",$JOB,PT,SUB,INVDT,SEQ))
if 'SEQ!(+$GET(RESULT)>0)
QUIT
Begin DoDot:3
+11 SET ORX=^(SEQ)
+12 ;if results were not cancelled in lab:
IF $PIECE(ORX,U,2)'="canc"
Begin DoDot:4
+13 SET RESULT=$PIECE(ORX,U,2)
+14 SET ORY=$PIECE(ORX,U)_U_$PIECE(ORX,U,15)_U_$PIECE(ORX,U,2)_U_$PIECE(ORX,U,4)
+15 SET ORY=ORY_U_$PIECE(ORX,U,3)_U_$PIECE(ORX,U,5)_U_(9999999-INVDT)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+16 KILL ^TMP("LRRR",$JOB)
+17 QUIT ORY
+18 ;
LOCLFORM(PT,LID,SPEC) ;extrinsic function to return formatted most recnt lab
+1 ;rtn format: 1 (if results)^<print name> <value> <units> <high/low flag>
+2 ; (<reference range>) <collection date/time>
+3 NEW FRCNT,X
+4 SET X=$$LOCL(PT,LID,SPEC)
+5 if '$LENGTH(X)
QUIT "^No results found."
+6 SET FRCNT="1^"_$PIECE(X,U,2)_" "_$PIECE(X,U,3)_" "_$PIECE(X,U,4)_" "_$PIECE(X,U,5)
+7 SET FRCNT=FRCNT_" ("_$PIECE(X,U,6)_") "_$$FMTE^XLFDT($PIECE(X,U,7),"2P")
+8 QUIT FRCNT
