ORAMTTR ; POR/RSF - Rosendaal Calculations, Individual & Group ;10/05/10 11:57
;;3.0;ORDER ENTRY/RESULTS REPORTING;**307,339,354,516**;Dec 17, 1997;Build 1
;;Per VHA Directive 2004-038, this routine should not be modified
;needs testing in system with new file and parameters
Q
;
MAIN ; Rosendaal TTR Option
N RESULT,DIR,DIRUT,DUOUT,DTOUT,DIROUT,Y,X,TYPE
S DIR("B")="I",DIR(0)="SO^I:Include inactive patients and missed appointments;E:Exclude inactive patients and missed appointments"
D ^DIR
Q:$D(DIRUT)!$D(DUOUT)!$D(DTOUT)!$D(DIROUT)
S TYPE=$S($E(Y)="I":0,1:1)
D NROSENT(.RESULT,TYPE)
Q
SINGLE ; TTR for Individual
N ORAMDFN,ORAMED,ORAMSD,DUOUT,DTOUT,DIRUT,RESULT
S (ORAMED,ORAMSD)=""
W !!,"Single Patient TRR Calculation (Rosendaal Method):",!
S ORAMDFN=+$$PATIENT^ORAMX Q:+ORAMDFN'>0
F D Q:+ORAMED>+ORAMSD!$D(DIRUT)
. W !
. S ORAMSD=+$$READ^ORAMX("DA^::E","Please Enter START Date: ","T-90","Enter a start date for the report")
. Q:'ORAMSD
. S ORAMED=+$$READ^ORAMX("DA^::E"," Please Enter END Date: ","T","Enter an INCLUSIVE end date for the report")
. Q:'ORAMED
. I $L(ORAMED,".")=1 S ORAMED=ORAMED_".2359"
. I ORAMSD>ORAMED W !,"END DATE must be more recent than the START DATE" S (ORAMSD,ORAMED)=""
Q:$S(+ORAMDFN'>0:1,ORAMED'>0:1,ORAMSD'>0:1,1:0)
D NRINDV(.RESULT,ORAMDFN,ORAMSD,ORAMED,1)
Q
NROSENT(RESULT,TYPE) ;
;*354 TYPE -> Optional, defaults to include all patients.
; > 0 Will drop inactive patients.
N ORAMSD,ORAMED,ORAMDFN,ORAMFSD,ORAMCLIN,ORAMPT,ORAMDATE,LG,HG,V1,V2,D1,D2,ORAMDAYS
N ORAMDIG,ORAMTD,ORAMCARR,TOTS,CNT,ORSITE
K ^TMP("ORAM",$J)
W !!,"Rosendaal method for percentage of INR scores in therapeutic range",!
SD1 ; Get date range for calculations
S ORAMSD=+$$READ^ORAMX("DA^::E","Please Enter START Date: ","T-90","Enter a start date for the report")
Q:'ORAMSD
S ORAMED=+$$READ^ORAMX("DA^::E"," Please Enter END Date: ","T","Enter an INCLUSIVE end date for the report")
Q:'ORAMED
I $L(ORAMED,".")=1 S ORAMED=ORAMED_".2359"
I ORAMSD>ORAMED W !,"END DATE must be more recent than the START DATE" S (ORAMSD,ORAMED)="" G SD1
S ORAMDFN=0 F S ORAMDFN=$O(^ORAM(103,ORAMDFN)) Q:'$G(ORAMDFN) D
. N ORAMFS,ORAMDD,PGR
. Q:'+$D(^ORAM(103,ORAMDFN,3)) ;go to next pt if no flow sheet entries
. Q:'$D(^ORAM(103,ORAMDFN,6)) Q:$P(^ORAM(103,ORAMDFN,6),U,2)="" ;QUIT IF NO CLINIC ASSIGNED
. S ORAMCLIN=$P(^ORAM(103,ORAMDFN,6),U,2)
. ; 1. Get local labs for patient w/in date range
. D NGETINR(ORAMDFN,ORAMCLIN,ORAMSD,ORAMED)
. ; 2. Next, loop thru flow sheets for patient to gather goal ranges
. S ORAMDD=ORAMSD-.01
. F S ORAMDD=$O(^ORAM(103,ORAMDFN,3,"B",ORAMDD)) Q:'+$G(ORAMDD) D
.. S ORAMFS=0 F S ORAMFS=$O(^ORAM(103,ORAMDFN,3,"B",ORAMDD,ORAMFS)) Q:'+$G(ORAMFS) D
... I $G(PGR)="" S PGR=0 I ORAMFS>2 S PGR=$P(^ORAM(103,ORAMDFN,3,(ORAMFS-1),0),U,12) S:$G(PGR)="" PGR=0
... S ORAMFSD=$P(^ORAM(103,ORAMDFN,3,ORAMFS,0),U) Q:$G(ORAMFSD)<ORAMSD Q:$G(ORAMFSD)>ORAMED ;OUT OF DATE RANGE
... I $P(^ORAM(103,ORAMDFN,3,ORAMFS,0),U,3)="",'+$D(^TMP("ORAM",$J,ORAMCLIN,ORAMDFN,ORAMFSD)) Q
... I +$D(^TMP("ORAM",$J,ORAMCLIN,ORAMDFN,ORAMFSD)) S ^TMP("ORAM",$J,ORAMCLIN,ORAMDFN,ORAMFSD)=$P(^TMP("ORAM",$J,ORAMCLIN,ORAMDFN,ORAMFSD),U)_U_$P(^ORAM(103,ORAMDFN,3,ORAMFS,0),U,12)
... I '+$D(^TMP("ORAM",$J,ORAMCLIN,ORAMDFN,ORAMFSD)) S ^TMP("ORAM",$J,ORAMCLIN,ORAMDFN,ORAMFSD)=$P(^ORAM(103,ORAMDFN,3,ORAMFS,0),U,3)_U_$P(^(0),U,12)
; 3. Loop thru array of pts & INRs collected in prior steps
; Format: ^TMP("ORAM",$J,CLINIC,DFN,FMDATE)=INR_VALUE ^GOAL RANGE
S ORAMCLIN=0
F S ORAMCLIN=$O(^TMP("ORAM",$J,ORAMCLIN)) Q:$G(ORAMCLIN)="" D
. N ORAMPT S ORAMPT=0
. F S ORAMPT=$O(^TMP("ORAM",$J,ORAMCLIN,ORAMPT)) Q:'+$G(ORAMPT) D
.. ;*354 Add second report type (omit inactive patients)
.. N ORAMDATE S ORAMDATE=0 I ($G(TYPE)>0),$$DROP(ORAMPT,ORAMSD,ORAMED) K ^TMP("ORAM",$J,ORAMCLIN,ORAMPT) Q
.. S (LG,HG,V1,V1,D1,D2)=""
.. F S ORAMDATE=$O(^TMP("ORAM",$J,ORAMCLIN,ORAMPT,ORAMDATE)) Q:'+$G(ORAMDATE) D NGETFS(.ORAMCARR,ORAMCLIN,ORAMPT,ORAMDATE,.D1,.D2,.V1,.V2,.PGR,.LG,.HG,.ORAMDIG,.ORAMTD)
I $G(ORAMDIG)<1 S RESULT="0^0" W !!?2,"Unable to calculate TTR (may be due to a short time frame with few repeat",!?2,"readings on the same patients)." Q
S TOTS=$TR($J((ORAMDIG/ORAMTD)*100,8,1)," ","")
S ORSITE=$$NAME^VASITE
S:ORSITE']"" ORSITE=$P($$SITE^VASITE,U,2)
W @IOF,"Results of Rosendaal Method for Time in Therapeutic Range:"
W !!,"Facility-wide for ",ORSITE," for ",$$FMTE^XLFDT(ORAMSD,2)," - ",$$FMTE^XLFDT(ORAMED,2)
W !,"TTR = ",TOTS,"% (TOTAL DAYS IN GOAL: ",$TR($J(ORAMDIG,8,1)," ","")," TOTAL DAYS: ",$TR($J(ORAMTD,8,1)," ",""),")"
I +$O(ORAMCARR(0)) W !!,"Results by Clinic:"
S CNT=0 F S CNT=$O(ORAMCARR(CNT)) Q:$G(CNT)="" D
. N CTOT S CTOT=$TR($J(($P(ORAMCARR(CNT),U,2)/$P(ORAMCARR(CNT),U))*100,8,1)," ",""),$P(ORAMCARR(CNT),U,2)=$TR($J($P(ORAMCARR(CNT),U,2),8,1)," ",""),$P(ORAMCARR(CNT),U,3)=CTOT
. W !,$E($P(^SC(CNT,0),U),1,21),": TTR = ",CTOT,"% (Total days in goal: ",$TR($J($P(ORAMCARR(CNT),U,2),8,1)," ","")," TOTAL DAYS: ",$TR($J($P(ORAMCARR(CNT),U),8,1)," ",""),")",!
. S ORAMCARR(CNT)=$P(^SC(CNT,0),U)_U_$P(ORAMCARR(CNT),U,2,3)
M RESULT=ORAMCARR
S RESULT(0)=TOTS_U_$TR($J(ORAMDIG,8,1)," ","")_U_$TR($J(ORAMTD,8,1)," ","")
K ^TMP("ORAM",$J)
Q
;
NRINDV(RESULT,ORAMDFN,ORAMSD,ORAMED,ORAMWON) ; TTR for single patient
N ORAMFS,ORAMDD,PGR,ORAMCLIN
S RESULT="NA"
K ^TMP("ORAM",$J)
Q:'+$D(^ORAM(103,ORAMDFN)) ;NOT IN FILE YET
Q:'+$D(^ORAM(103,ORAMDFN,3)) ;NO FS ENTRIES YET
Q:'$D(^ORAM(103,ORAMDFN,6)) Q:$P(^ORAM(103,ORAMDFN,6),U,2)="" ;QUIT IF NO CLINIC ASSIGNED
S:$G(ORAMSD)="" ORAMSD=$P(^ORAM(103,ORAMDFN,3,1,0),U) ;IF NO DEFINED START DATE, DO FOR THE WHOLE TIME IN CLINIC.
S:$G(ORAMED)="" ORAMED=DT
S:$G(ORAMWON)="" ORAMWON=0 ;IF A NUMBER WILL WRITE RESULTS TO THE SCREEN
S ORAMCLIN=$P(^ORAM(103,ORAMDFN,6),U,2)
D NGETINR(ORAMDFN,ORAMCLIN,ORAMSD,ORAMED) ;GETS LOCAL INR VALUES IN FORM ^TMP("ORAM",$J,CLINIC,DFN,FM_DATE)=VALUE^
S ORAMDD=ORAMSD-.01
F S ORAMDD=$O(^ORAM(103,ORAMDFN,3,"B",ORAMDD)) Q:'+$G(ORAMDD) D
. S ORAMFS=0 F S ORAMFS=$O(^ORAM(103,ORAMDFN,3,"B",ORAMDD,ORAMFS)) Q:'+$G(ORAMFS) D
.. N ORAMFSD
.. I $G(PGR)="" S PGR=0 I ORAMFS>2 S PGR=$P(^ORAM(103,ORAMDFN,3,(ORAMFS-1),0),U,12) S:$G(PGR)="" PGR=0
.. S ORAMFSD=$P(^ORAM(103,ORAMDFN,3,ORAMFS,0),U) Q:$G(ORAMFSD)<ORAMSD Q:$G(ORAMFSD)>ORAMED ;OUT OF DATE RANGE
.. I $P(^ORAM(103,ORAMDFN,3,ORAMFS,0),U,3)="",'+$D(^TMP("ORAM",$J,ORAMCLIN,ORAMDFN,ORAMFSD)) Q
.. I +$D(^TMP("ORAM",$J,ORAMCLIN,ORAMDFN,ORAMFSD)) S ^TMP("ORAM",$J,ORAMCLIN,ORAMDFN,ORAMFSD)=$P(^TMP("ORAM",$J,ORAMCLIN,ORAMDFN,ORAMFSD),U)_U_$P(^ORAM(103,ORAMDFN,3,ORAMFS,0),U,12)
.. I '+$D(^TMP("ORAM",$J,ORAMCLIN,ORAMDFN,ORAMFSD)) S ^TMP("ORAM",$J,ORAMCLIN,ORAMDFN,ORAMFSD)=$P(^ORAM(103,ORAMDFN,3,ORAMFS,0),U,3)_U_$P(^(0),U,12)
Q:'$D(^TMP("ORAM",$J,ORAMCLIN,ORAMDFN))
;FORMED ARRAY OF PATIENTS AND SCORES IN THE DATE RANGE; FORMAT ^TMP("ORAM",$J,CLINIC,DFN,FMDATE)=INR_VALUE ^ GOAL RANGE.
N ORAMDATE,LG,HG,V1,V2,D1,D2,ORAMDAYS,ORAMDIG,ORAMTD
N ORAMC2,ORAMPT,ORAMCARR S ORAMC2=ORAMCLIN,ORAMPT=ORAMDFN
S ORAMDATE=0 F S ORAMDATE=$O(^TMP("ORAM",$J,ORAMCLIN,ORAMDFN,ORAMDATE)) Q:'+$G(ORAMDATE) D NGETFS(.ORAMCARR,ORAMCLIN,ORAMDFN,ORAMDATE,.D1,.D2,.V1,.V2,.PGR,.LG,.HG,.ORAMDIG,.ORAMTD)
I $G(ORAMDIG)<1 S RESULT="0^0" W:+$G(ORAMWON) !!?2,"Unable to calculate TTR (may be due to a short time frame with few repeat",!?2,"readings on the same patient)." Q
N TOTS S TOTS=$TR($J((ORAMDIG/ORAMTD)*100,8,1)," ","")
I +$G(ORAMWON) D
. W !!,"Rosendaal method for percentage of INR scores in therapeutic range",!
. W !,?5,$E($P(^DPT($G(ORAMDFN),0),U),1,10)_" ("_$E($P(^(0),U,9),6,9)_") for ",$$FMTE^XLFDT(ORAMSD,2)," - ",$$FMTE^XLFDT(ORAMED,2)
. W !,?5,"TTR = ",TOTS,"% (TOTAL DAYS IN GOAL: ",$TR($J(ORAMDIG,8,1)," ","")," TOTAL DAYS: ",$TR($J(ORAMTD,8,1)," ",""),")",!
S RESULT=TOTS_U_$TR($J(ORAMDIG,8,1)," ","")_U_$TR($J(ORAMTD,8,1)," ","")
K ^TMP("ORAM",$J)
Q
;
NGETINR(ORAMDFN,ORAMCLIN,ORAMSD,ORAMED) ; Get local INRs - sort by clinic, patient, & date
N LDATE,INR,LRDFN,ORAMITST,ORAMQO,INRHD,INRRD,RSD,RED
I '$G(ORAMDFN) Q ;IF DFN IS NOT PASSED, EXIT
S LRDFN=$G(^DPT(ORAMDFN,"LR")) Q:'+$G(LRDFN)
S RSD=9999999-(ORAMSD-.01) ;REVERSE START DATE
S RED=9999999-ORAMED
N ORAMITST,ORAMORD S ORAMQO=$$GET^XPAR("ALL","ORAM INR QUICK ORDER",1,"I")
I +ORAMQO'>0 W !!,"Parameter ORAM QUICK ORDER not yet established. Please contact your CAC.",! Q
S ORAMITST=$$INRCHK^ORAM(ORAMQO)
I +ORAMITST'>0 W !!,"Parameter ORAM QUICK ORDER not properly set up. Please contact your CAC.",! Q
S LDATE=RSD F SET LDATE=$O(^LR(LRDFN,"CH",LDATE),-1) Q:LDATE<1!(LDATE<RED) D
. N SCORE S SCORE=$G(^LR(LRDFN,"CH",LDATE,ORAMITST)) ;648149
. Q:SCORE="" ;QUIT IF NO INR TEST
. Q:$P(SCORE,U,1)="" ;QUIT IF NO INR DATA
. S INR=$P(SCORE,U,1) ;INR
. N ORAMX S ORAMX=$E((9999999-LDATE),1,7)
. S ^TMP("ORAM",$J,ORAMCLIN,ORAMDFN,ORAMX)=$G(INR)_U
Q
;
NGETFS(ORAMCARR,ORAMCLIN,ORAMPT,ORAMDATE,D1,D2,V1,V2,PGR,LG,HG,ORAMDIG,ORAMTD) ; Check flow sheet entries vs. goals
N CG,ORAMZ,ORAMDAYS
S CG=$P(^TMP("ORAM",$J,ORAMCLIN,ORAMPT,ORAMDATE),U,2),ORAMZ=0
I $G(CG)="",'+$G(LG) Q:'+$G(PGR) S CG=PGR ;BRINGS IN THE LAST GOAL INFO THAT SHOULD BE IN EFFECT FOR THE FIRST SEGMENT
I $G(CG)'="" S LG=$P(CG,"-"),HG=$P(CG,"-",2) S:HG[" " HG=$P(HG," ",2) ;USES NEW ONE IF AVAILABLE
Q:$P(^TMP("ORAM",$J,ORAMCLIN,ORAMPT,ORAMDATE),U)=""
N ORAMIV S ORAMIV=$P(^TMP("ORAM",$J,ORAMCLIN,ORAMPT,ORAMDATE),U) S:ORAMIV[">" ORAMIV=$P(ORAMIV,">",2) S:ORAMIV["<" ORAMIV=$P(ORAMIV,"<",2)
Q:'+ORAMIV ;QUITS IF NOT A NUMBER AFTER CHECKING FOR > AND < SIGNS
S D2=ORAMDATE S V2=ORAMIV_U_$S(ORAMIV>HG:"H",ORAMIV<LG:"L",1:"G") ;IF OUT OF RANGE LISTS H OR L OTHERWISE G
I $G(D1)="" S ORAMZ=1
I '+$G(ORAMZ) D
. S ORAMDAYS=$$FMDIFF^XLFDT(D2,D1,1) ;DAYS DIFFERENCE BETWEEN THE LAST TWO INRS
. S ORAMTD=$G(ORAMTD)+ORAMDAYS
. S $P(ORAMCARR(ORAMCLIN),U)=($P($G(ORAMCARR(ORAMCLIN)),U)+ORAMDAYS)
. I $P(V1,U,2)=$P(V2,U,2) S:$P(V1,U,2)="G" ORAMDIG=$G(ORAMDIG)+ORAMDAYS,$P(ORAMCARR(ORAMCLIN),U,2)=$P(ORAMCARR(ORAMCLIN),U,2)+ORAMDAYS ;IF ALL IN GOAL, ALL GOOD, OTHERWISE 0 IN GOAL
. I $P(V1,U,2)'=$P(V2,U,2) D ;WAS IN GOAL IN ONLY ONE OF THE READINGS (OR ONE H AND ONE L)
.. N DIFF S DIFF=$$ABS^XLFMTH($P(V1,U)-$P(V2,U)) N NUMC,NUMPC S:$P(V1,U,2)="G" NUMC=$P(V1,U)_U_$P(V2,U,2) S:$P(V2,U,2)="G" NUMC=$P(V2,U)_U_$P(V1,U,2)
.. I $G(NUMC)'="" D
... I $P(NUMC,U,2)="L" S NUMPC=$$ABS^XLFMTH(LG-$P(NUMC,U))
... I $P(NUMC,U,2)="H" S NUMPC=$$ABS^XLFMTH(HG-$P(NUMC,U))
... S NUMPC=$S(DIFF=0:0,1:NUMPC/DIFF)
.. I $G(NUMC)="" D ; FOR THE RARE CASE OF A SKIPPED GOAL RANGE, SO NOT =, BUT ONE IS LOW AND THE OTHER HIGH
... S NUMPC=$$ABS^XLFMTH(HG-LG),NUMPC=$S(DIFF=0:0,1:NUMPC/DIFF)
.. S ORAMDIG=$G(ORAMDIG)+$TR($J(NUMPC*ORAMDAYS,8.3)," ","")
.. S $P(ORAMCARR(ORAMCLIN),U,2)=($P(ORAMCARR(ORAMCLIN),U,2)+$TR($J(NUMPC*ORAMDAYS,8.3)," ",""))
S D1=D2,V1=V2
Q
;
DROP(DPT,BDT,EDT) ;
; Return if Patient should be dropped from calculation 1 (yes), 0 (no), -1 (err)
; DPT -> PT DFN (required)
; BDT -> Begin Date (optional)
; EDT -> End Date (optional)
N FS,INR,PRE,ORAMISS,ORAMDROP,FSDT
S:'$G(BDT) BDT=0 ;No Input set 0
S:'$G(EDT) EDT=9999999 ;No input, set end of time.
Q:'$D(^ORAM(103,DPT)) -1
Q:(2=$$GET1^DIQ(103,DPT,15,"I")) 1 ;inactive patient
F FS=0:0 S FS=$O(^ORAM(103,DPT,3,FS)) Q:'FS D
. S FSDT=$$GET1^DIQ(103.011,FS_","_DPT,.01,"I")
. S INR=$$GET1^DIQ(103.011,FS_","_DPT,20,"I")
. I '$G(INR) S ORAMISS(DPT,FSDT)=1 ;Mark Missed Appts
S FS=BDT-.01 F S FS=$O(ORAMISS(DPT,FS)) S PRE=$O(ORAMISS(DPT,FS),-1) Q:('FS)!(FS>EDT)!$G(ORAMDROP(DPT)) D
. Q:'PRE I ($$FMDIFF^XLFDT(FS,PRE)>56) S ORAMDROP(DPT)=1
Q $G(ORAMDROP(DPT),0)
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORAMTTR 11871 printed Apr 09, 2024@21:32:35 Page 2
ORAMTTR ; POR/RSF - Rosendaal Calculations, Individual & Group ;10/05/10 11:57
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**307,339,354,516**;Dec 17, 1997;Build 1
+2 ;;Per VHA Directive 2004-038, this routine should not be modified
+3 ;needs testing in system with new file and parameters
+4 QUIT
+5 ;
MAIN ; Rosendaal TTR Option
+1 NEW RESULT,DIR,DIRUT,DUOUT,DTOUT,DIROUT,Y,X,TYPE
+2 SET DIR("B")="I"
SET DIR(0)="SO^I:Include inactive patients and missed appointments;E:Exclude inactive patients and missed appointments"
+3 DO ^DIR
+4 if $DATA(DIRUT)!$DATA(DUOUT)!$DATA(DTOUT)!$DATA(DIROUT)
QUIT
+5 SET TYPE=$SELECT($EXTRACT(Y)="I":0,1:1)
+6 DO NROSENT(.RESULT,TYPE)
+7 QUIT
SINGLE ; TTR for Individual
+1 NEW ORAMDFN,ORAMED,ORAMSD,DUOUT,DTOUT,DIRUT,RESULT
+2 SET (ORAMED,ORAMSD)=""
+3 WRITE !!,"Single Patient TRR Calculation (Rosendaal Method):",!
+4 SET ORAMDFN=+$$PATIENT^ORAMX
if +ORAMDFN'>0
QUIT
+5 FOR
Begin DoDot:1
+6 WRITE !
+7 SET ORAMSD=+$$READ^ORAMX("DA^::E","Please Enter START Date: ","T-90","Enter a start date for the report")
+8 if 'ORAMSD
QUIT
+9 SET ORAMED=+$$READ^ORAMX("DA^::E"," Please Enter END Date: ","T","Enter an INCLUSIVE end date for the report")
+10 if 'ORAMED
QUIT
+11 IF $LENGTH(ORAMED,".")=1
SET ORAMED=ORAMED_".2359"
+12 IF ORAMSD>ORAMED
WRITE !,"END DATE must be more recent than the START DATE"
SET (ORAMSD,ORAMED)=""
End DoDot:1
if +ORAMED>+ORAMSD!$DATA(DIRUT)
QUIT
+13 if $SELECT(+ORAMDFN'>0
QUIT
+14 DO NRINDV(.RESULT,ORAMDFN,ORAMSD,ORAMED,1)
+15 QUIT
NROSENT(RESULT,TYPE) ;
+1 ;*354 TYPE -> Optional, defaults to include all patients.
+2 ; > 0 Will drop inactive patients.
+3 NEW ORAMSD,ORAMED,ORAMDFN,ORAMFSD,ORAMCLIN,ORAMPT,ORAMDATE,LG,HG,V1,V2,D1,D2,ORAMDAYS
+4 NEW ORAMDIG,ORAMTD,ORAMCARR,TOTS,CNT,ORSITE
+5 KILL ^TMP("ORAM",$JOB)
+6 WRITE !!,"Rosendaal method for percentage of INR scores in therapeutic range",!
SD1 ; Get date range for calculations
+1 SET ORAMSD=+$$READ^ORAMX("DA^::E","Please Enter START Date: ","T-90","Enter a start date for the report")
+2 if 'ORAMSD
QUIT
+3 SET ORAMED=+$$READ^ORAMX("DA^::E"," Please Enter END Date: ","T","Enter an INCLUSIVE end date for the report")
+4 if 'ORAMED
QUIT
+5 IF $LENGTH(ORAMED,".")=1
SET ORAMED=ORAMED_".2359"
+6 IF ORAMSD>ORAMED
WRITE !,"END DATE must be more recent than the START DATE"
SET (ORAMSD,ORAMED)=""
GOTO SD1
+7 SET ORAMDFN=0
FOR
SET ORAMDFN=$ORDER(^ORAM(103,ORAMDFN))
if '$GET(ORAMDFN)
QUIT
Begin DoDot:1
+8 NEW ORAMFS,ORAMDD,PGR
+9 ;go to next pt if no flow sheet entries
if '+$DATA(^ORAM(103,ORAMDFN,3))
QUIT
+10 ;QUIT IF NO CLINIC ASSIGNED
if '$DATA(^ORAM(103,ORAMDFN,6))
QUIT
if $PIECE(^ORAM(103,ORAMDFN,6),U,2)=""
QUIT
+11 SET ORAMCLIN=$PIECE(^ORAM(103,ORAMDFN,6),U,2)
+12 ; 1. Get local labs for patient w/in date range
+13 DO NGETINR(ORAMDFN,ORAMCLIN,ORAMSD,ORAMED)
+14 ; 2. Next, loop thru flow sheets for patient to gather goal ranges
+15 SET ORAMDD=ORAMSD-.01
+16 FOR
SET ORAMDD=$ORDER(^ORAM(103,ORAMDFN,3,"B",ORAMDD))
if '+$GET(ORAMDD)
QUIT
Begin DoDot:2
+17 SET ORAMFS=0
FOR
SET ORAMFS=$ORDER(^ORAM(103,ORAMDFN,3,"B",ORAMDD,ORAMFS))
if '+$GET(ORAMFS)
QUIT
Begin DoDot:3
+18 IF $GET(PGR)=""
SET PGR=0
IF ORAMFS>2
SET PGR=$PIECE(^ORAM(103,ORAMDFN,3,(ORAMFS-1),0),U,12)
if $GET(PGR)=""
SET PGR=0
+19 ;OUT OF DATE RANGE
SET ORAMFSD=$PIECE(^ORAM(103,ORAMDFN,3,ORAMFS,0),U)
if $GET(ORAMFSD)<ORAMSD
QUIT
if $GET(ORAMFSD)>ORAMED
QUIT
+20 IF $PIECE(^ORAM(103,ORAMDFN,3,ORAMFS,0),U,3)=""
IF '+$DATA(^TMP("ORAM",$JOB,ORAMCLIN,ORAMDFN,ORAMFSD))
QUIT
+21 IF +$DATA(^TMP("ORAM",$JOB,ORAMCLIN,ORAMDFN,ORAMFSD))
SET ^TMP("ORAM",$JOB,ORAMCLIN,ORAMDFN,ORAMFSD)=$PIECE(^TMP("ORAM",$JOB,ORAMCLIN,ORAMDFN,ORAMFSD),U)_U_$PIECE(^ORAM(103,ORAMDFN,3,ORAMFS,0),U,12)
+22 IF '+$DATA(^TMP("ORAM",$JOB,ORAMCLIN,ORAMDFN,ORAMFSD))
SET ^TMP("ORAM",$JOB,ORAMCLIN,ORAMDFN,ORAMFSD)=$PIECE(^ORAM(103,ORAMDFN,3,ORAMFS,0),U,3)_U_$PIECE(^(0),U,12)
End DoDot:3
End DoDot:2
End DoDot:1
+23 ; 3. Loop thru array of pts & INRs collected in prior steps
+24 ; Format: ^TMP("ORAM",$J,CLINIC,DFN,FMDATE)=INR_VALUE ^GOAL RANGE
+25 SET ORAMCLIN=0
+26 FOR
SET ORAMCLIN=$ORDER(^TMP("ORAM",$JOB,ORAMCLIN))
if $GET(ORAMCLIN)=""
QUIT
Begin DoDot:1
+27 NEW ORAMPT
SET ORAMPT=0
+28 FOR
SET ORAMPT=$ORDER(^TMP("ORAM",$JOB,ORAMCLIN,ORAMPT))
if '+$GET(ORAMPT)
QUIT
Begin DoDot:2
+29 ;*354 Add second report type (omit inactive patients)
+30 NEW ORAMDATE
SET ORAMDATE=0
IF ($GET(TYPE)>0)
IF $$DROP(ORAMPT,ORAMSD,ORAMED)
KILL ^TMP("ORAM",$JOB,ORAMCLIN,ORAMPT)
QUIT
+31 SET (LG,HG,V1,V1,D1,D2)=""
+32 FOR
SET ORAMDATE=$ORDER(^TMP("ORAM",$JOB,ORAMCLIN,ORAMPT,ORAMDATE))
if '+$GET(ORAMDATE)
QUIT
DO NGETFS(.ORAMCARR,ORAMCLIN,ORAMPT,ORAMDATE,.D1,.D2,.V1,.V2,.PGR,.LG,.HG,.ORAMDIG,.ORAMTD)
End DoDot:2
End DoDot:1
+33 IF $GET(ORAMDIG)<1
SET RESULT="0^0"
WRITE !!?2,"Unable to calculate TTR (may be due to a short time frame with few repeat",!?2,"readings on the same patients)."
QUIT
+34 SET TOTS=$TRANSLATE($JUSTIFY((ORAMDIG/ORAMTD)*100,8,1)," ","")
+35 SET ORSITE=$$NAME^VASITE
+36 if ORSITE']""
SET ORSITE=$PIECE($$SITE^VASITE,U,2)
+37 WRITE @IOF,"Results of Rosendaal Method for Time in Therapeutic Range:"
+38 WRITE !!,"Facility-wide for ",ORSITE," for ",$$FMTE^XLFDT(ORAMSD,2)," - ",$$FMTE^XLFDT(ORAMED,2)
+39 WRITE !,"TTR = ",TOTS,"% (TOTAL DAYS IN GOAL: ",$TRANSLATE($JUSTIFY(ORAMDIG,8,1)," ","")," TOTAL DAYS: ",$TRANSLATE($JUSTIFY(ORAMTD,8,1)," ",""),")"
+40 IF +$ORDER(ORAMCARR(0))
WRITE !!,"Results by Clinic:"
+41 SET CNT=0
FOR
SET CNT=$ORDER(ORAMCARR(CNT))
if $GET(CNT)=""
QUIT
Begin DoDot:1
+42 NEW CTOT
SET CTOT=$TRANSLATE($JUSTIFY(($PIECE(ORAMCARR(CNT),U,2)/$PIECE(ORAMCARR(CNT),U))*100,8,1)," ","")
SET $PIECE(ORAMCARR(CNT),U,2)=$TRANSLATE($JUSTIFY($PIECE(ORAMCARR(CNT),U,2),8,1)," ","")
SET $PIECE(ORAMCARR(CNT),U,3)=CTOT
+43 WRITE !,$EXTRACT($PIECE(^SC(CNT,0),U),1,21),": TTR = ",CTOT,"% (Total days in goal: ",$TRANSLATE($JUSTIFY($PIECE(ORAMCARR(CNT),U,2),8,1)," ","")," TOTAL DAYS: ",$TRANSLATE($JUSTIFY($PIECE(ORAMCARR(CNT),U),8,1)," ",""),")",!
+44 SET ORAMCARR(CNT)=$PIECE(^SC(CNT,0),U)_U_$PIECE(ORAMCARR(CNT),U,2,3)
End DoDot:1
+45 MERGE RESULT=ORAMCARR
+46 SET RESULT(0)=TOTS_U_$TRANSLATE($JUSTIFY(ORAMDIG,8,1)," ","")_U_$TRANSLATE($JUSTIFY(ORAMTD,8,1)," ","")
+47 KILL ^TMP("ORAM",$JOB)
+48 QUIT
+49 ;
NRINDV(RESULT,ORAMDFN,ORAMSD,ORAMED,ORAMWON) ; TTR for single patient
+1 NEW ORAMFS,ORAMDD,PGR,ORAMCLIN
+2 SET RESULT="NA"
+3 KILL ^TMP("ORAM",$JOB)
+4 ;NOT IN FILE YET
if '+$DATA(^ORAM(103,ORAMDFN))
QUIT
+5 ;NO FS ENTRIES YET
if '+$DATA(^ORAM(103,ORAMDFN,3))
QUIT
+6 ;QUIT IF NO CLINIC ASSIGNED
if '$DATA(^ORAM(103,ORAMDFN,6))
QUIT
if $PIECE(^ORAM(103,ORAMDFN,6),U,2)=""
QUIT
+7 ;IF NO DEFINED START DATE, DO FOR THE WHOLE TIME IN CLINIC.
if $GET(ORAMSD)=""
SET ORAMSD=$PIECE(^ORAM(103,ORAMDFN,3,1,0),U)
+8 if $GET(ORAMED)=""
SET ORAMED=DT
+9 ;IF A NUMBER WILL WRITE RESULTS TO THE SCREEN
if $GET(ORAMWON)=""
SET ORAMWON=0
+10 SET ORAMCLIN=$PIECE(^ORAM(103,ORAMDFN,6),U,2)
+11 ;GETS LOCAL INR VALUES IN FORM ^TMP("ORAM",$J,CLINIC,DFN,FM_DATE)=VALUE^
DO NGETINR(ORAMDFN,ORAMCLIN,ORAMSD,ORAMED)
+12 SET ORAMDD=ORAMSD-.01
+13 FOR
SET ORAMDD=$ORDER(^ORAM(103,ORAMDFN,3,"B",ORAMDD))
if '+$GET(ORAMDD)
QUIT
Begin DoDot:1
+14 SET ORAMFS=0
FOR
SET ORAMFS=$ORDER(^ORAM(103,ORAMDFN,3,"B",ORAMDD,ORAMFS))
if '+$GET(ORAMFS)
QUIT
Begin DoDot:2
+15 NEW ORAMFSD
+16 IF $GET(PGR)=""
SET PGR=0
IF ORAMFS>2
SET PGR=$PIECE(^ORAM(103,ORAMDFN,3,(ORAMFS-1),0),U,12)
if $GET(PGR)=""
SET PGR=0
+17 ;OUT OF DATE RANGE
SET ORAMFSD=$PIECE(^ORAM(103,ORAMDFN,3,ORAMFS,0),U)
if $GET(ORAMFSD)<ORAMSD
QUIT
if $GET(ORAMFSD)>ORAMED
QUIT
+18 IF $PIECE(^ORAM(103,ORAMDFN,3,ORAMFS,0),U,3)=""
IF '+$DATA(^TMP("ORAM",$JOB,ORAMCLIN,ORAMDFN,ORAMFSD))
QUIT
+19 IF +$DATA(^TMP("ORAM",$JOB,ORAMCLIN,ORAMDFN,ORAMFSD))
SET ^TMP("ORAM",$JOB,ORAMCLIN,ORAMDFN,ORAMFSD)=$PIECE(^TMP("ORAM",$JOB,ORAMCLIN,ORAMDFN,ORAMFSD),U)_U_$PIECE(^ORAM(103,ORAMDFN,3,ORAMFS,0),U,12)
+20 IF '+$DATA(^TMP("ORAM",$JOB,ORAMCLIN,ORAMDFN,ORAMFSD))
SET ^TMP("ORAM",$JOB,ORAMCLIN,ORAMDFN,ORAMFSD)=$PIECE(^ORAM(103,ORAMDFN,3,ORAMFS,0),U,3)_U_$PIECE(^(0),U,12)
End DoDot:2
End DoDot:1
+21 if '$DATA(^TMP("ORAM",$JOB,ORAMCLIN,ORAMDFN))
QUIT
+22 ;FORMED ARRAY OF PATIENTS AND SCORES IN THE DATE RANGE; FORMAT ^TMP("ORAM",$J,CLINIC,DFN,FMDATE)=INR_VALUE ^ GOAL RANGE.
+23 NEW ORAMDATE,LG,HG,V1,V2,D1,D2,ORAMDAYS,ORAMDIG,ORAMTD
+24 NEW ORAMC2,ORAMPT,ORAMCARR
SET ORAMC2=ORAMCLIN
SET ORAMPT=ORAMDFN
+25 SET ORAMDATE=0
FOR
SET ORAMDATE=$ORDER(^TMP("ORAM",$JOB,ORAMCLIN,ORAMDFN,ORAMDATE))
if '+$GET(ORAMDATE)
QUIT
DO NGETFS(.ORAMCARR,ORAMCLIN,ORAMDFN,ORAMDATE,.D1,.D2,.V1,.V2,.PGR,.LG,.HG,.ORAMDIG,.ORAMTD)
+26 IF $GET(ORAMDIG)<1
SET RESULT="0^0"
if +$GET(ORAMWON)
WRITE !!?2,"Unable to calculate TTR (may be due to a short time frame with few repeat",!?2,"readings on the same patient)."
QUIT
+27 NEW TOTS
SET TOTS=$TRANSLATE($JUSTIFY((ORAMDIG/ORAMTD)*100,8,1)," ","")
+28 IF +$GET(ORAMWON)
Begin DoDot:1
+29 WRITE !!,"Rosendaal method for percentage of INR scores in therapeutic range",!
+30 WRITE !,?5,$EXTRACT($PIECE(^DPT($GET(ORAMDFN),0),U),1,10)_" ("_$EXTRACT($PIECE(^(0),U,9),6,9)_") for ",$$FMTE^XLFDT(ORAMSD,2)," - ",$$FMTE^XLFDT(ORAMED,2)
+31 WRITE !,?5,"TTR = ",TOTS,"% (TOTAL DAYS IN GOAL: ",$TRANSLATE($JUSTIFY(ORAMDIG,8,1)," ","")," TOTAL DAYS: ",$TRANSLATE($JUSTIFY(ORAMTD,8,1)," ",""),")",!
End DoDot:1
+32 SET RESULT=TOTS_U_$TRANSLATE($JUSTIFY(ORAMDIG,8,1)," ","")_U_$TRANSLATE($JUSTIFY(ORAMTD,8,1)," ","")
+33 KILL ^TMP("ORAM",$JOB)
+34 QUIT
+35 ;
NGETINR(ORAMDFN,ORAMCLIN,ORAMSD,ORAMED) ; Get local INRs - sort by clinic, patient, & date
+1 NEW LDATE,INR,LRDFN,ORAMITST,ORAMQO,INRHD,INRRD,RSD,RED
+2 ;IF DFN IS NOT PASSED, EXIT
IF '$GET(ORAMDFN)
QUIT
+3 SET LRDFN=$GET(^DPT(ORAMDFN,"LR"))
if '+$GET(LRDFN)
QUIT
+4 ;REVERSE START DATE
SET RSD=9999999-(ORAMSD-.01)
+5 SET RED=9999999-ORAMED
+6 NEW ORAMITST,ORAMORD
SET ORAMQO=$$GET^XPAR("ALL","ORAM INR QUICK ORDER",1,"I")
+7 IF +ORAMQO'>0
WRITE !!,"Parameter ORAM QUICK ORDER not yet established. Please contact your CAC.",!
QUIT
+8 SET ORAMITST=$$INRCHK^ORAM(ORAMQO)
+9 IF +ORAMITST'>0
WRITE !!,"Parameter ORAM QUICK ORDER not properly set up. Please contact your CAC.",!
QUIT
+10 SET LDATE=RSD
FOR
SET LDATE=$ORDER(^LR(LRDFN,"CH",LDATE),-1)
if LDATE<1!(LDATE<RED)
QUIT
Begin DoDot:1
+11 ;648149
NEW SCORE
SET SCORE=$GET(^LR(LRDFN,"CH",LDATE,ORAMITST))
+12 ;QUIT IF NO INR TEST
if SCORE=""
QUIT
+13 ;QUIT IF NO INR DATA
if $PIECE(SCORE,U,1)=""
QUIT
+14 ;INR
SET INR=$PIECE(SCORE,U,1)
+15 NEW ORAMX
SET ORAMX=$EXTRACT((9999999-LDATE),1,7)
+16 SET ^TMP("ORAM",$JOB,ORAMCLIN,ORAMDFN,ORAMX)=$GET(INR)_U
End DoDot:1
+17 QUIT
+18 ;
NGETFS(ORAMCARR,ORAMCLIN,ORAMPT,ORAMDATE,D1,D2,V1,V2,PGR,LG,HG,ORAMDIG,ORAMTD) ; Check flow sheet entries vs. goals
+1 NEW CG,ORAMZ,ORAMDAYS
+2 SET CG=$PIECE(^TMP("ORAM",$JOB,ORAMCLIN,ORAMPT,ORAMDATE),U,2)
SET ORAMZ=0
+3 ;BRINGS IN THE LAST GOAL INFO THAT SHOULD BE IN EFFECT FOR THE FIRST SEGMENT
IF $GET(CG)=""
IF '+$GET(LG)
if '+$GET(PGR)
QUIT
SET CG=PGR
+4 ;USES NEW ONE IF AVAILABLE
IF $GET(CG)'=""
SET LG=$PIECE(CG,"-")
SET HG=$PIECE(CG,"-",2)
if HG[" "
SET HG=$PIECE(HG," ",2)
+5 if $PIECE(^TMP("ORAM",$JOB,ORAMCLIN,ORAMPT,ORAMDATE),U)=""
QUIT
+6 NEW ORAMIV
SET ORAMIV=$PIECE(^TMP("ORAM",$JOB,ORAMCLIN,ORAMPT,ORAMDATE),U)
if ORAMIV[">"
SET ORAMIV=$PIECE(ORAMIV,">",2)
if ORAMIV["<"
SET ORAMIV=$PIECE(ORAMIV,"<",2)
+7 ;QUITS IF NOT A NUMBER AFTER CHECKING FOR > AND < SIGNS
if '+ORAMIV
QUIT
+8 ;IF OUT OF RANGE LISTS H OR L OTHERWISE G
SET D2=ORAMDATE
SET V2=ORAMIV_U_$SELECT(ORAMIV>HG:"H",ORAMIV<LG:"L",1:"G")
+9 IF $GET(D1)=""
SET ORAMZ=1
+10 IF '+$GET(ORAMZ)
Begin DoDot:1
+11 ;DAYS DIFFERENCE BETWEEN THE LAST TWO INRS
SET ORAMDAYS=$$FMDIFF^XLFDT(D2,D1,1)
+12 SET ORAMTD=$GET(ORAMTD)+ORAMDAYS
+13 SET $PIECE(ORAMCARR(ORAMCLIN),U)=($PIECE($GET(ORAMCARR(ORAMCLIN)),U)+ORAMDAYS)
+14 ;IF ALL IN GOAL, ALL GOOD, OTHERWISE 0 IN GOAL
IF $PIECE(V1,U,2)=$PIECE(V2,U,2)
if $PIECE(V1,U,2)="G"
SET ORAMDIG=$GET(ORAMDIG)+ORAMDAYS
SET $PIECE(ORAMCARR(ORAMCLIN),U,2)=$PIECE(ORAMCARR(ORAMCLIN),U,2)+ORAMDAYS
+15 ;WAS IN GOAL IN ONLY ONE OF THE READINGS (OR ONE H AND ONE L)
IF $PIECE(V1,U,2)'=$PIECE(V2,U,2)
Begin DoDot:2
+16 NEW DIFF
SET DIFF=$$ABS^XLFMTH($PIECE(V1,U)-$PIECE(V2,U))
NEW NUMC,NUMPC
if $PIECE(V1,U,2)="G"
SET NUMC=$PIECE(V1,U)_U_$PIECE(V2,U,2)
if $PIECE(V2,U,2)="G"
SET NUMC=$PIECE(V2,U)_U_$PIECE(V1,U,2)
+17 IF $GET(NUMC)'=""
Begin DoDot:3
+18 IF $PIECE(NUMC,U,2)="L"
SET NUMPC=$$ABS^XLFMTH(LG-$PIECE(NUMC,U))
+19 IF $PIECE(NUMC,U,2)="H"
SET NUMPC=$$ABS^XLFMTH(HG-$PIECE(NUMC,U))
+20 SET NUMPC=$SELECT(DIFF=0:0,1:NUMPC/DIFF)
End DoDot:3
+21 ; FOR THE RARE CASE OF A SKIPPED GOAL RANGE, SO NOT =, BUT ONE IS LOW AND THE OTHER HIGH
IF $GET(NUMC)=""
Begin DoDot:3
+22 SET NUMPC=$$ABS^XLFMTH(HG-LG)
SET NUMPC=$SELECT(DIFF=0:0,1:NUMPC/DIFF)
End DoDot:3
+23 SET ORAMDIG=$GET(ORAMDIG)+$TRANSLATE($JUSTIFY(NUMPC*ORAMDAYS,8.3)," ","")
+24 SET $PIECE(ORAMCARR(ORAMCLIN),U,2)=($PIECE(ORAMCARR(ORAMCLIN),U,2)+$TRANSLATE($JUSTIFY(NUMPC*ORAMDAYS,8.3)," ",""))
End DoDot:2
End DoDot:1
+25 SET D1=D2
SET V1=V2
+26 QUIT
+27 ;
DROP(DPT,BDT,EDT) ;
+1 ; Return if Patient should be dropped from calculation 1 (yes), 0 (no), -1 (err)
+2 ; DPT -> PT DFN (required)
+3 ; BDT -> Begin Date (optional)
+4 ; EDT -> End Date (optional)
+5 NEW FS,INR,PRE,ORAMISS,ORAMDROP,FSDT
+6 ;No Input set 0
if '$GET(BDT)
SET BDT=0
+7 ;No input, set end of time.
if '$GET(EDT)
SET EDT=9999999
+8 if '$DATA(^ORAM(103,DPT))
QUIT -1
+9 ;inactive patient
if (2=$$GET1^DIQ(103,DPT,15,"I"))
QUIT 1
+10 FOR FS=0:0
SET FS=$ORDER(^ORAM(103,DPT,3,FS))
if 'FS
QUIT
Begin DoDot:1
+11 SET FSDT=$$GET1^DIQ(103.011,FS_","_DPT,.01,"I")
+12 SET INR=$$GET1^DIQ(103.011,FS_","_DPT,20,"I")
+13 ;Mark Missed Appts
IF '$GET(INR)
SET ORAMISS(DPT,FSDT)=1
End DoDot:1
+14 SET FS=BDT-.01
FOR
SET FS=$ORDER(ORAMISS(DPT,FS))
SET PRE=$ORDER(ORAMISS(DPT,FS),-1)
if ('FS)!(FS>EDT)!$GET(ORAMDROP(DPT))
QUIT
Begin DoDot:1
+15 if 'PRE
QUIT
IF ($$FMDIFF^XLFDT(FS,PRE)>56)
SET ORAMDROP(DPT)=1
End DoDot:1
+16 QUIT $GET(ORAMDROP(DPT),0)
+17 ;
