- ORWDPLM1 ;PBM/HINES/RMS - DISPLAY LAB DATA IN CPRS ORDERING DIALOG ; 21 Dec 2016 4:46 PM
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;**420**;;Build 7
- SL Q:'$$GET^XPAR("ALL","OR CPRS LAB DISPLAY ENABLED") ; param off? - skip
- N DIC,X,Y,ORL50,ORL507,ORL2,ORLNODE,ORLRSLT,FOUND,ORLCRCL,REFRANGE
- S ORL2=+$G(ORVP) I ORL2 G SL2
- S X=$TR($G(VA("PID")),"-"),DIC=2,DIC(0)="M"
- D ^DIC
- Q:Y=-1
- S ORL2=+Y
- SL2 S ORL507=+$P($G(^ORD(101.43,OI,0)),U,2) Q:'+ORL507
- S ORL50=0 F S ORL50=$O(^PSDRUG("ASP",ORL507,ORL50)) Q:'+ORL50!($G(FOUND)) D
- . S ORLNODE=$G(^PSDRUG(ORL50,"CLOZ")) Q:'+ORLNODE
- . I +ORLNODE,$$SCRTEST(+ORLNODE) S ORLRSLT=$$GETSCR(ORL2) S ILST=ILST+1,LST(ILST)="tLAST "_$$GET1^DIQ(60,+ORLNODE,.01)_": "_$P(ORLRSLT,U)
- . I +ORLNODE,'$$SCRTEST(+ORLNODE) S ORLRSLT=$$GETLAB(ORL2,+ORLNODE,+$P(ORLNODE,U,3),$P(ORLNODE,U,2)) S ILST=ILST+1,LST(ILST)="tLAST "_$$GET1^DIQ(60,+ORLNODE,.01)_": "_$P(ORLRSLT,U)
- . I +$P(ORLRSLT,U,2) S LST(ILST)=LST(ILST)_" "_$P(ORLRSLT,U,4)_" ("_$$FMTE^XLFDT($P(ORLRSLT,U,2))_")"
- . I $P(ORLRSLT,U,5)]"" S ILST=ILST+1,LST(ILST)="tREFERENCE RANGE: "_$P(ORLRSLT,U,5)_" "_$P(ORLRSLT,U,4)
- . I +$P(ORLRSLT,U,2) I $$SCRTEST(+ORLNODE) S ORLCRCL=$$CRCL^PSOORUT2(ORL2) I +$P(ORLCRCL,U,2) S ILST=ILST+1,LST(ILST)="tEstimated Creatinine Clearance: "_$P(ORLCRCL,U,2)_" mL/min"
- . S FOUND=1
- Q
- ;
- GETSCR(DFN) ;New PBM/RMS 1-29-2016
- ;If lab test is CREATININE, get results using national term
- N OCXTL,OCXTLS,SCR,OCXT,OCXTS,SCRD,PSCR,SCRV
- S OCXTL="" Q:'$$TERMLKUP^ORB31(.OCXTL,"SERUM CREATININE") "No mapped creatinine lab test available"
- S OCXTLS="" Q:'$$TERMLKUP^ORB31(.OCXTLS,"SERUM SPECIMEN") "No mapped serum specimen found"
- S PSCR="^^^^^^0"
- S SCR="",OCXT=0 F S OCXT=$O(OCXTL(OCXT)) Q:'OCXT D
- .S OCXTS=0 F S OCXTS=$O(OCXTLS(OCXTS)) Q:'OCXTS D
- ..S SCR=$$LOCL^ORQQLR1(DFN,$P(OCXTL(OCXT),U),$P(OCXTLS(OCXTS),U))
- ..I $P(SCR,U,7)>$P(PSCR,U,7) S PSCR=SCR
- S SCR=PSCR,SCRV=$P(SCR,U,3) Q:+$G(SCRV)<.01 "NONE FOUND IN LAST "_$S(+$P(ORLNODE,U,2):$P(ORLNODE,U,2),1:365)_" DAYS"
- S SCRD=$P(SCR,U,7) Q:'$L(SCRD) "NONE FOUND IN LAST "_$S(+$P(ORLNODE,U,2):$P(ORLNODE,U,2),1:365)_" DAYS"
- I $$FMADD^XLFDT(DT,-$P(ORLNODE,U,2))>SCRD Q "NONE FOUND IN LAST "_$S(+$P(ORLNODE,U,2):$P(ORLNODE,U,2),1:365)_" DAYS" ;Result Before Max Days
- Q $P(SCR,U,3)_U_$P(SCR,U,7)_U_$P(SCR,U,2)_U_$P(SCR,U,4)_U_$P(SCR,U,6)
- ;
- SCRTEST(LAB60) ;New PBM/RMS 1-29-2016
- ;Function to check if drug-associated lab test is CREATININE
- N TERM,IEN,OCXTL,ORLSCR
- S TERM=$$TERMLKUP^ORB31(.OCXTL,"SERUM CREATININE")
- S IEN=0
- F S IEN=$O(OCXTL(IEN)) Q:'+IEN S ORLSCR(+$G(OCXTL(IEN)))=""
- Q $D(ORLSCR(LAB60))
- ;
- GETLAB(DFN,TEST,SPEC,MDAYS) ;CUSTOM LAB LOOKUP API
- N ORLBDT,TESTNAME,RESULT,LNAME,LDATE,UNITS
- N X,X1,X2
- Q:'+$G(TEST) ""
- Q:'+$G(DFN) ""
- S TESTNAME=$P($G(^LAB(60,TEST,0)),U)
- S MDAYS=$G(MDAYS,365)
- S X1=DT,X2=-$G(MDAYS) D C^%DTC
- S ORLBDT=$S(X<DT:X,1:0)
- D RR^LR7OR1(DFN,,ORLBDT,DT,,TEST,,1,$G(SPEC))
- D FORMAT
- I $G(RESULT)']"" Q "NONE FOUND IN LAST "_+$S(+MDAYS:MDAYS,1:365)_" DAYS"_U_U_TESTNAME
- Q RESULT_U_LDATE_U_LNAME_U_UNITS_U_REFRANGE
- FORMAT N IDT,LOC,NODE
- S IDT=0 F S IDT=$O(^TMP("LRRR",$J,DFN,"CH",IDT)) Q:'+IDT D
- . S LOC=0 F S LOC=$O(^TMP("LRRR",$J,DFN,"CH",IDT,LOC)) Q:'+LOC D
- .. S NODE=$G(^TMP("LRRR",$J,DFN,"CH",IDT,LOC))
- .. S RESULT=$P(NODE,U,2)
- .. S UNITS=$P(NODE,U,4)
- .. S LNAME=$P(NODE,U,10)
- .. S REFRANGE=$P(NODE,U,5)
- .. I LNAME']"" S LNAME=$P(NODE,U,15)
- .. S LDATE=9999999-IDT
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORWDPLM1 3468 printed Mar 13, 2025@21:40:36 Page 2
- ORWDPLM1 ;PBM/HINES/RMS - DISPLAY LAB DATA IN CPRS ORDERING DIALOG ; 21 Dec 2016 4:46 PM
- +1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**420**;;Build 7
- SL ; param off? - skip
- if '$$GET^XPAR("ALL","OR CPRS LAB DISPLAY ENABLED")
- QUIT
- +1 NEW DIC,X,Y,ORL50,ORL507,ORL2,ORLNODE,ORLRSLT,FOUND,ORLCRCL,REFRANGE
- +2 SET ORL2=+$GET(ORVP)
- IF ORL2
- GOTO SL2
- +3 SET X=$TRANSLATE($GET(VA("PID")),"-")
- SET DIC=2
- SET DIC(0)="M"
- +4 DO ^DIC
- +5 if Y=-1
- QUIT
- +6 SET ORL2=+Y
- SL2 SET ORL507=+$PIECE($GET(^ORD(101.43,OI,0)),U,2)
- if '+ORL507
- QUIT
- +1 SET ORL50=0
- FOR
- SET ORL50=$ORDER(^PSDRUG("ASP",ORL507,ORL50))
- if '+ORL50!($GET(FOUND))
- QUIT
- Begin DoDot:1
- +2 SET ORLNODE=$GET(^PSDRUG(ORL50,"CLOZ"))
- if '+ORLNODE
- QUIT
- +3 IF +ORLNODE
- IF $$SCRTEST(+ORLNODE)
- SET ORLRSLT=$$GETSCR(ORL2)
- SET ILST=ILST+1
- SET LST(ILST)="tLAST "_$$GET1^DIQ(60,+ORLNODE,.01)_": "_$PIECE(ORLRSLT,U)
- +4 IF +ORLNODE
- IF '$$SCRTEST(+ORLNODE)
- SET ORLRSLT=$$GETLAB(ORL2,+ORLNODE,+$PIECE(ORLNODE,U,3),$PIECE(ORLNODE,U,2))
- SET ILST=ILST+1
- SET LST(ILST)="tLAST "_$$GET1^DIQ(60,+ORLNODE,.01)_": "_$PIECE(ORLRSLT,U)
- +5 IF +$PIECE(ORLRSLT,U,2)
- SET LST(ILST)=LST(ILST)_" "_$PIECE(ORLRSLT,U,4)_" ("_$$FMTE^XLFDT($PIECE(ORLRSLT,U,2))_")"
- +6 IF $PIECE(ORLRSLT,U,5)]""
- SET ILST=ILST+1
- SET LST(ILST)="tREFERENCE RANGE: "_$PIECE(ORLRSLT,U,5)_" "_$PIECE(ORLRSLT,U,4)
- +7 IF +$PIECE(ORLRSLT,U,2)
- IF $$SCRTEST(+ORLNODE)
- SET ORLCRCL=$$CRCL^PSOORUT2(ORL2)
- IF +$PIECE(ORLCRCL,U,2)
- SET ILST=ILST+1
- SET LST(ILST)="tEstimated Creatinine Clearance: "_$PIECE(ORLCRCL,U,2)_" mL/min"
- +8 SET FOUND=1
- End DoDot:1
- +9 QUIT
- +10 ;
- GETSCR(DFN) ;New PBM/RMS 1-29-2016
- +1 ;If lab test is CREATININE, get results using national term
- +2 NEW OCXTL,OCXTLS,SCR,OCXT,OCXTS,SCRD,PSCR,SCRV
- +3 SET OCXTL=""
- if '$$TERMLKUP^ORB31(.OCXTL,"SERUM CREATININE")
- QUIT "No mapped creatinine lab test available"
- +4 SET OCXTLS=""
- if '$$TERMLKUP^ORB31(.OCXTLS,"SERUM SPECIMEN")
- QUIT "No mapped serum specimen found"
- +5 SET PSCR="^^^^^^0"
- +6 SET SCR=""
- SET OCXT=0
- FOR
- SET OCXT=$ORDER(OCXTL(OCXT))
- if 'OCXT
- QUIT
- Begin DoDot:1
- +7 SET OCXTS=0
- FOR
- SET OCXTS=$ORDER(OCXTLS(OCXTS))
- if 'OCXTS
- QUIT
- Begin DoDot:2
- +8 SET SCR=$$LOCL^ORQQLR1(DFN,$PIECE(OCXTL(OCXT),U),$PIECE(OCXTLS(OCXTS),U))
- +9 IF $PIECE(SCR,U,7)>$PIECE(PSCR,U,7)
- SET PSCR=SCR
- End DoDot:2
- End DoDot:1
- +10 SET SCR=PSCR
- SET SCRV=$PIECE(SCR,U,3)
- if +$GET(SCRV)<.01
- QUIT "NONE FOUND IN LAST "_$SELECT(+$PIECE(ORLNODE,U,2):$PIECE(ORLNODE,U,2),1:365)_" DAYS"
- +11 SET SCRD=$PIECE(SCR,U,7)
- if '$LENGTH(SCRD)
- QUIT "NONE FOUND IN LAST "_$SELECT(+$PIECE(ORLNODE,U,2):$PIECE(ORLNODE,U,2),1:365)_" DAYS"
- +12 ;Result Before Max Days
- IF $$FMADD^XLFDT(DT,-$PIECE(ORLNODE,U,2))>SCRD
- QUIT "NONE FOUND IN LAST "_$SELECT(+$PIECE(ORLNODE,U,2):$PIECE(ORLNODE,U,2),1:365)_" DAYS"
- +13 QUIT $PIECE(SCR,U,3)_U_$PIECE(SCR,U,7)_U_$PIECE(SCR,U,2)_U_$PIECE(SCR,U,4)_U_$PIECE(SCR,U,6)
- +14 ;
- SCRTEST(LAB60) ;New PBM/RMS 1-29-2016
- +1 ;Function to check if drug-associated lab test is CREATININE
- +2 NEW TERM,IEN,OCXTL,ORLSCR
- +3 SET TERM=$$TERMLKUP^ORB31(.OCXTL,"SERUM CREATININE")
- +4 SET IEN=0
- +5 FOR
- SET IEN=$ORDER(OCXTL(IEN))
- if '+IEN
- QUIT
- SET ORLSCR(+$GET(OCXTL(IEN)))=""
- +6 QUIT $DATA(ORLSCR(LAB60))
- +7 ;
- GETLAB(DFN,TEST,SPEC,MDAYS) ;CUSTOM LAB LOOKUP API
- +1 NEW ORLBDT,TESTNAME,RESULT,LNAME,LDATE,UNITS
- +2 NEW X,X1,X2
- +3 if '+$GET(TEST)
- QUIT ""
- +4 if '+$GET(DFN)
- QUIT ""
- +5 SET TESTNAME=$PIECE($GET(^LAB(60,TEST,0)),U)
- +6 SET MDAYS=$GET(MDAYS,365)
- +7 SET X1=DT
- SET X2=-$GET(MDAYS)
- DO C^%DTC
- +8 SET ORLBDT=$SELECT(X<DT:X,1:0)
- +9 DO RR^LR7OR1(DFN,,ORLBDT,DT,,TEST,,1,$GET(SPEC))
- +10 DO FORMAT
- +11 IF $GET(RESULT)']""
- QUIT "NONE FOUND IN LAST "_+$SELECT(+MDAYS:MDAYS,1:365)_" DAYS"_U_U_TESTNAME
- +12 QUIT RESULT_U_LDATE_U_LNAME_U_UNITS_U_REFRANGE
- FORMAT NEW IDT,LOC,NODE
- +1 SET IDT=0
- FOR
- SET IDT=$ORDER(^TMP("LRRR",$JOB,DFN,"CH",IDT))
- if '+IDT
- QUIT
- Begin DoDot:1
- +2 SET LOC=0
- FOR
- SET LOC=$ORDER(^TMP("LRRR",$JOB,DFN,"CH",IDT,LOC))
- if '+LOC
- QUIT
- Begin DoDot:2
- +3 SET NODE=$GET(^TMP("LRRR",$JOB,DFN,"CH",IDT,LOC))
- +4 SET RESULT=$PIECE(NODE,U,2)
- +5 SET UNITS=$PIECE(NODE,U,4)
- +6 SET LNAME=$PIECE(NODE,U,10)
- +7 SET REFRANGE=$PIECE(NODE,U,5)
- +8 IF LNAME']""
- SET LNAME=$PIECE(NODE,U,15)
- +9 SET LDATE=9999999-IDT
- End DoDot:2
- End DoDot:1
- +10 QUIT
