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

ORQQLR1.m

Go to the documentation of this file.
  1. 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
  1. ;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ;DBIA reference section
  1. ;2387 ^LAB(60
  1. ;2503 RR^LR7OR1
  1. ;10103 FMTE^XLFDT
  1. ;
  1. OETOLAB(ORNUM) ;extrinsic funct to get a lab order number from an oe/rr number
  1. N LRNUM
  1. S LRNUM=$G(^OR(100,ORNUM,4))
  1. Q +LRNUM
  1. ;
  1. PRINTNAM(LRIEN) ;extrinsic function to return the print name for an entry in the Lab file [#60]
  1. Q:+$G(LRIEN)<1 ""
  1. N NODE,NAME
  1. S NODE=$G(^LAB(60,LRIEN,.1))
  1. Q:'$L(NODE) ""
  1. S NAME=$P(NODE,U)
  1. Q NAME
  1. ;
  1. 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
  1. N RSLT,ORZ
  1. S ORZ=""
  1. S RSLT=$$GETDATA^OCXCACHE(.ORZ,"$$OIRESC^ORQQLR1("_PT_","_OILR_","_SPEC_")",PT,)
  1. Q ORZ
  1. ;
  1. 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
  1. N ORY,ORX,ORN,ORLR,SUB,INVDT,SEQ,ORDG,RESULT
  1. S SUB="",INVDT=0,SEQ=0,ORY=""
  1. ;check to make sure the OI is in DG lab
  1. Q:'$L($G(PT))!('$L($G(OILR))) ORY
  1. Q:'$L($G(^ORD(101.43,OILR,0))) ORY
  1. I +$G(SPEC)<1 S SPEC=""
  1. S ORDG=$$DG^ORQOR1("LAB")
  1. Q:'$L($G(ORDG)) ORY
  1. Q:$P(^ORD(101.43,OILR,0),U,5)'=ORDG ORY ;quit if display grp is not lab
  1. ;get lab test ien
  1. S ORX=$P(^ORD(101.43,OILR,0),U,2)
  1. S ORLR=$S(ORX["~":$P(ORX,"~"),1:$P(ORX,";"))
  1. ;get lab results
  1. K ^TMP("LRRR",$J)
  1. D RR^LR7OR1(PT,"","","","",ORLR,"L",1,SPEC) I $D(^TMP("LRRR",$J,PT)) D
  1. .S SUB=$O(^TMP("LRRR",$J,PT,SUB)) Q:SUB=""
  1. .S INVDT=$O(^TMP("LRRR",$J,PT,SUB,INVDT)) Q:'INVDT
  1. .S SEQ=$O(^TMP("LRRR",$J,PT,SUB,INVDT,SEQ)) Q:'SEQ D
  1. ..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)
  1. K ^TMP("LRRR",$J)
  1. Q ORY
  1. ;
  1. 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
  1. N RSLT,ORZ
  1. S ORZ=""
  1. S RSLT=$$GETDATA^OCXCACHE(.ORZ,"$$NATLC^ORQQLR1("_PT_","_NID_","_SPEC_")",PT,)
  1. Q ORZ
  1. ;
  1. 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
  1. N ORY,ORX,ORN,ORLR,SUB,INVDT,SEQ,ORDG
  1. S SUB="",INVDT=0,SEQ=0,ORY=""
  1. I +$G(SPEC)<1 S SPEC=""
  1. ;get lab results
  1. K ^TMP("LRRR",$J)
  1. D RR^LR7OR1(PT,"","","","",NID,"N",1,SPEC) I $D(^TMP("LRRR",$J,PT)) D
  1. .S SUB=$O(^TMP("LRRR",$J,PT,SUB)) Q:SUB=""
  1. .S INVDT=$O(^TMP("LRRR",$J,PT,SUB,INVDT)) Q:'INVDT
  1. .S SEQ=$O(^TMP("LRRR",$J,PT,SUB,INVDT,SEQ)) Q:'SEQ D
  1. ..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)
  1. K ^TMP("LRRR",$J)
  1. Q ORY
  1. ;
  1. 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
  1. N RSLT,ORZ
  1. S ORZ=""
  1. S RSLT=$$GETDATA^OCXCACHE(.ORZ,"$$LOCLC^ORQQLR1("_PT_","_LID_","_SPEC_")",PT,)
  1. Q ORZ
  1. ;
  1. 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
  1. N ORY,ORX,SUB,INVDT,SEQ,RESULT
  1. S SUB="",INVDT=0,SEQ=0,ORY=""
  1. ;get lab results
  1. I +$G(SPEC)<1 S SPEC=""
  1. K ^TMP("LRRR",$J)
  1. D RR^LR7OR1(PT,"","","","",LID,"L",,SPEC) I $D(^TMP("LRRR",$J,PT)) D
  1. .S SUB=$O(^TMP("LRRR",$J,PT,SUB)) Q:SUB=""
  1. .S INVDT="" F S INVDT=$O(^TMP("LRRR",$J,PT,SUB,INVDT)) Q:'INVDT D
  1. ..S SEQ="" F S SEQ=$O(^TMP("LRRR",$J,PT,SUB,INVDT,SEQ)) Q:'SEQ!(+$G(RESULT)>0) D
  1. ...S ORX=^(SEQ)
  1. ...I $P(ORX,U,2)'="canc" D ;if results were not cancelled in lab:
  1. ....S RESULT=$P(ORX,U,2)
  1. ....S ORY=$P(ORX,U)_U_$P(ORX,U,15)_U_$P(ORX,U,2)_U_$P(ORX,U,4)
  1. ....S ORY=ORY_U_$P(ORX,U,3)_U_$P(ORX,U,5)_U_(9999999-INVDT)
  1. K ^TMP("LRRR",$J)
  1. Q ORY
  1. ;
  1. 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>
  1. ; (<reference range>) <collection date/time>
  1. N FRCNT,X
  1. S X=$$LOCL(PT,LID,SPEC)
  1. Q:'$L(X) "^No results found."
  1. S FRCNT="1^"_$P(X,U,2)_" "_$P(X,U,3)_" "_$P(X,U,4)_" "_$P(X,U,5)
  1. S FRCNT=FRCNT_" ("_$P(X,U,6)_") "_$$FMTE^XLFDT($P(X,U,7),"2P")
  1. Q FRCNT