APCM25E2 ; IHS/CMI/LAB - IHS MU ;
;;1.0;MU PERFORMANCE REPORTS;**7**;MAR 26, 2012;Build 15
;;;;;;Build 3
DEMO ;EP - CALCULATE DEMOGRAPHICS
;for each provider or for the facility find out if this
;patient had a visit of A, O, R, S to this provider or facility
;if so, then check to see if they had dob, preferred language, gender, race, ethnicity recorded
NEW APCMP
S (APCMD1,APCMN1)=0
I APCMRPTT=1 D Q
.S APCMP=0 F S APCMP=$O(APCMPRV(APCMP)) Q:APCMP'=+APCMP D
..Q:'$D(APCMHVTP(APCMP)) ;DID NOT SEE THIS PATIENT
..D DEMO1
I APCMRPTT=2 D
.S APCMP=APCMFAC
.Q:'$D(APCMHVTP(APCMP))
.D DEMO1
.Q
Q
DEMO1 ;set denominator value into field
S F=$P(^APCM25OB(APCMIC,0),U,8) ;denom field for this measure
D S^APCM25E1(APCMRPT,APCMIC,1,APCMP,APCMRPTT,APCMTIME,F)
S APCMVALU="VISIT: "_$$DATE^APCM1UTL(APCMHVTP(APCMP))
;numerator?
S APCMEP=$$HASDEMO(DFN,APCMBDAT,APCMEDAT,APCMRPTT,$G(APCMVDOD))
S APCMVALU=APCMVALU_"|||"_$S($P(APCMEP,U,1)=1:"MEETS OBJECTIVE: ",1:"DOES NOT MEET OBJECTIVE: ")_$P(APCMEP,U,2)_"|||"_$P(APCMEP,U,1)
S F=$P(^APCM25OB(APCMIC,0),U,9)
D S^APCM25E1(APCMRPT,APCMIC,$P(APCMEP,U,1),APCMP,APCMRPTT,APCMTIME,F)
D SETLIST^APCM25E1
Q
HASDEMO(P,BD,ED,T,DODV) ;
NEW PL,G,R,E,D,C,Y,X,B,Z
S C=0
S T=$G(T)
S DODV=$G(DODV)
S (PL,G,R,E,D)=""
;preferred language
S X=0 F S X=$O(^AUPNPAT(P,86,X)) Q:X'=+X!(PL]"") D
.S B=$P(^AUPNPAT(P,86,X,0),U)
.;Q:B>ED
.S C=C+1,PL="Preferred Language"
S G=$P(^DPT(P,0),U,2) I G]"" S C=C+1,G="Gender"
I $T(RACE^AGUTL)]"" S R=$$RACE^AGUTL(P)
I R S C=C+1,R="Race" I 1
E S R=$$VAL^XBDIQ1(2,P,.06) I R]"" S C=C+1,R="Race"
S Z=0 F S Z=$O(^DPT(P,.06,Z)) Q:Z'=+Z!(E]"") D
.S E=$P($G(^DPT(P,.06,Z,0)),U,1)
.Q:E=""
.S E="Ethnicity",C=C+1
.Q
I $P(^DPT(P,0),U,3)]"" S D="DOB",C=C+1
I T=2,$G(DODV) G HASDEMOH
I C=5 Q 1_U_"Has: "_PL_";"_G_";"_R_";"_E_";"_D
Q 0_U_"Has: "_PL_";"_G_";"_R_";"_E_";"_D
HASDEMOH ;did patient die in the hospital during report period? if so is dod and underlying cause there?
NEW VDOD,L,PCD
S PCD=""
S VDOD=$$DATE^APCM1UTL($P($P(^AUPNVINP(DODV,0),U,1),"."))
I VDOD]"" S C=C+1,VDOD="DIED IN HOSP "_VDOD
S L=$$VAL^XBDIQ1(9000010.02,DODV,2101)
I L]"" S C=C+1,PCD="PCD"
I C=7 Q 1_U_"Has: "_PL_";"_G_";"_R_";"_E_";"_D_";"_VDOD_";"_PCD
Q 0_U_"Has: "_PL_";"_G_";"_R_";"_E_";"_D_";"_VDOD_";"_PCD
;
PL ;EP - CALCULATE PROBLEM LIST
;for each provider or for the facility find out if this
;patient had a visit of A, O, R, S to this provider or facility
;if so, then check to see if they any problems on their problem list (skip deleted) or a NAP documented in report period
NEW APCMP
S (APCMD1,APCMN1)=0
I APCMRPTT=1 D Q
.S APCMP=0 F S APCMP=$O(APCMPRV(APCMP)) Q:APCMP'=+APCMP D
..Q:'$D(APCMHVTP(APCMP)) ;no visits to this provider for this patient so don't bother, the patient is not in the denominator
..D PL1
..Q
I APCMRPTT=2 D
.S APCMP=APCMFAC
.Q:'$D(APCMHVTP(APCMP))
.D PL1
.Q
Q
PL1 ;set denominator value into field
S F=$P(^APCM25OB(APCMIC,0),U,8) ;denom field for this measure
D S^APCM25E1(APCMRPT,APCMIC,1,APCMP,APCMRPTT,APCMTIME,F)
S APCMVALU="VISIT: "_$$DATE^APCM1UTL(APCMHVTP(APCMP))
;numerator?
S APCMEP=$$HASPL(DFN,APCMBDAT,APCMEDAT)
S APCMVALU=APCMVALU_"|||"_$P(APCMEP,U,2)_"|||"_$P(APCMEP,U,1)
S F=$P(^APCM25OB(APCMIC,0),U,9)
D S^APCM25E1(APCMRPT,APCMIC,$P(APCMEP,U,1),APCMP,APCMRPTT,APCMTIME,F)
D SETLIST^APCM25E1
Q
HASPL(P,BD,ED) ;does patient have a problem entered before end of report period
;
NEW A,B,C,D,E
S E=""
S A=0 F S A=$O(^AUPNPROB("AC",P,A)) Q:A'=+A!(E]"") D
.;if date entered is after the ED don't count it
.Q:'$D(^AUPNPROB(A,0))
.Q:$P(^AUPNPROB(A,0),U,8)>ED ;after end date of report period
.I $P(^AUPNPROB(A,0),U,12)'="D" S E=1_U_"Problem Entry: "_$$VAL^XBDIQ1(9000011,A,.01)_" entered on "_$$VAL^XBDIQ1(9000011,A,.08) Q
.;since it's deleted, deletion date must not be before time period
.S D=$P($P($G(^AUPNPROB(A,2)),U,2),".") ;date deleted
.Q:D>ED
.Q:D<BD
.S E="1^Problem Entry: "_$$VAL^XBDIQ1(9000011,A,.01)_" entered on "_$$VAL^XBDIQ1(9000011,A,.08)
I E]"" Q E
;no problems on PL so how about a NAP before end of time period
S C=$O(^AUTTCRA("B","NO ACTIVE PROBLEMS",0))
I 'C Q ""
S A=0 F S A=$O(^AUPNVRUP("AC",P,A)) Q:A'=+A!(E]"") D
.Q:'$D(^AUPNVRUP(A,0)) ;oops
.Q:$P(^AUPNVRUP(A,0),U,1)'=C ;not NAP
.S D=$$VD^APCLV($P(^AUPNVRUP(A,0),U,3))
.Q:D>ED
.S E="1^No Active Problems on "_$$DATE^APCM1UTL(D)
Q E
; Return boolean flag indicating valid patient
PATVRY(RX,PAT) ;EP
Q:PAT="*" 1
Q +$P($G(^PSRX(RX,0)),U,2)=PAT
; Return release date for dispense
DSPRDT(RX,TYP,SIEN) ;EP
Q $S($G(SIEN):+$P($G(^PSRX(RX,$S(TYP="ADP":"P",1:1),SIEN,0)),U,$S(TYP="ADP":19,1:18)),1:+$P(^PSRX(RX,2),U,13))
EMAR ;EP
;for each provider count each Visit that HAS a v referral
K ^TMP($J,"TRANS")
NEW EMAR
D EMAR1
NEW APCMP,N,F,O,Y
I APCMRPTT=2 S APCMP=APCMFAC D
.I $$AVC^APCM25EM(APCMBDAT,APCMEDAT,APCMFAC)<10 D
..S F=$P(^APCM25OB(APCMIC,0),U,11) D S^APCM25E1(APCMRPT,APCMIC,"Facility is excluded from this measure as the average daily census was <10 during the previous year.",APCMP,APCMRPTT,APCMTIME,F,1)
.S F=$P(^APCM25OB(APCMIC,0),U,8) ;denom field for this measure
.S N=$P(EMAR,U,1) ;returns
.D S^APCM25E1(APCMRPT,APCMIC,N,APCMP,APCMRPTT,APCMTIME,F)
.;now set patient list for this provider
.S P=0 F S P=$O(^TMP($J,"BCMA","TRUD",P)) Q:P'=+P D
..S APCMVALU="# orders: "_$P(^TMP($J,"BCMA","TRUD",P),U,1)_"|||"_" # w/100%eMAR: "_+$P(^TMP($J,"BCMA","TRUD",P),U,2)_"|||1"
..S DFN=P
..D SETLIST^APCM25E1
.;numerator?
.S F=$P(^APCM25OB(APCMIC,0),U,9)
.S N=$P(EMAR,U,2)
.D S^APCM25E1(APCMRPT,APCMIC,N,APCMP,APCMRPTT,APCMTIME,F)
K ^TMP($J)
Q
EMAR1 ;EP - ep toc
START ;Set beginning/ending sort dates for ORDERS
NEW CNT,CNTT,CNTTR,CPS55,CPSDATE,CPSDFN,CPSEND,CPSFRE,CPSN,CPSN1,CPSNUM,CPSPOS,CPSPSB
NEW CPSQ,CPSRAT,CPSS1,CPSSCH,CPSTART,CPSTOP,CPSTYPE,CPSVOL
S CPSTART=APCMBDAT
S CPSEND=APCMEDAT
S EMAR=""
S (CNT("UNIT DOSE","TR"),CNT("UNIT DOSE"))=0
K ^TMP($J)
P55 ;LOOP 55 UNIT DOSE
S CPSDATE=CPSTART F S CPSDATE=$O(^PS(55,"AUDS",CPSDATE)) Q:$P(CPSDATE,".")>CPSEND!('+CPSDATE)!(CPSDATE>$$NOW^XLFDT()) D
.S CPSDFN=0 F S CPSDFN=$O(^PS(55,"AUDS",CPSDATE,CPSDFN)) Q:'+CPSDFN D
..S CPS55=0 F S CPS55=$O(^PS(55,"AUDS",CPSDATE,CPSDFN,CPS55)) Q:'+CPS55 D
...;COUNT POSSIBLE DOSES DUE FOR ORDER.
...S CPSPOS=0
...S CPSFRE=$P($G(^PS(55,CPSDFN,5,+CPS55,2)),U,6),CPSTOP=$P($G(^PS(55,CPSDFN,5,+CPS55,2)),U,4)
...S CPSSCH=$P($G(^PS(55,CPSDFN,5,+CPS55,0)),U,7)
...Q:CPSTOP<CPSDATE
...I CPSFRE="D"&(CPSSCH="C") S CPSN=$L($P($G(^PS(55,CPSDFN,5,+CPS55,2)),U,1),"-") S X2=CPSDATE,X1=$S(CPSTOP<DT:DT,1:CPSTOP) D ^%DTC S CPSPOS=CPSN*X
...I +CPSFRE&(CPSSCH="C") D
....S CPSS1=$$FMDIFF^XLFDT($S(CPSTOP>$$NOW^XLFDT():$$NOW^XLFDT(),$P(CPSTOP,".")>CPSEND:CPSEND_".24",1:CPSTOP),CPSDATE,2),CPSS1=CPSS1\60
....S CPSPOS=CPSS1\CPSFRE ;POSSIBLE DOSES?
....I CPSFRE>CPSS1 S CPSPOS=1 ;FREQ IS GREATER SO ONLY ONE POSSIBLE
....;S CPSS1=0,CPSS1=(24-$E($P(CPSDATE,".",2),1,2))*60 ;MINS FOR FIRST DATE l
....;IF CPSTOP>DT D NOW^%DTC S CPSS1=CPSS1+($E($P(%,".",2),1,2)*60) ; MINS FOR MIDNIGHT LAST DATE l
....;IF CPSTOP<DT S CPSS1=CPSS1+($E($P(CPSTOP,".",2),1,2)*60) ;MINS FOR MIDNIGHT LAST DATE l
....;S X1=CPSDATE,X2=+1 D C^%DTC S X2=X,X1=$S(CPSTOP>DT:DT,1:CPSTOP) D ^%DTC S CPSPOS=((X*1440)+CPSS1)/CPSFRE l
....;S X1=DT,X2=+1 D C^%DTC S CPSNDT=X S X2=CPSDATE,X1=$S(CPSTOP>DT:CPSNDT,1:CPSTOP) D ^%DTC S CPSPOS=((X*1440)+CPSS1)/CPSFRE
...;I DUZ=2881 W !,"PATIENT: ",$P(^DPT(CPSDFN,0),U,1),?30,"ORDER: ",$P($G(^PS(55,CPSDFN,5,+CPS55,0)),U,1),?45,"SCHEDULE TYPE: ",CPSSCH,!,"START: ",$$FMTE^XLFDT(CPSDATE),?30,"STOP: ",$$FMTE^XLFDT(CPSTOP),?60,"FREQUENCY: ",CPSFRE
...I CPSSCH="C"!(CPSSCH="O") S CNT("UNIT DOSE")=CNT("UNIT DOSE")+1,$P(^TMP($J,"BCMA","TRUD",CPSDFN),U,1)=$P($G(^TMP($J,"BCMA","TRUD",CPSDFN)),U,1)+1
...;LOOK 53.79 FOR DOSE TRACKED.
...I CPSSCH="O" S CPSPOS=1 ;PRNS TO ONE
...Q:+CPSPOS<0!(CPSPOS=0)
...S CPSQ=$S(CPSSCH="O":1,CPSSCH="C":1,1:0)
...Q:CPSQ=0
...;W !,CPSSCH
...S (CPSPSB,CPSN1)=0 F S CPSN1=$O(^PSB(53.79,"AORDX",CPSDFN,CPS55_"U",CPSN1)) Q:'+CPSN1 S CPSPSB=CPSPSB+1
...;I DUZ=2881 W !,"POSSIBLE DOSES: ",CPSPOS,?30,"# IN EMAR: ",CPSPSB,?50,"MET 100%: ",$S(CPSPSB<CPSPOS:"NO",1:"YES"),!
...Q:CPSPSB<CPSPOS
...S CNT("UNIT DOSE","TR")=CNT("UNIT DOSE","TR")+1 S $P(^TMP($J,"BCMA","TRUD",CPSDFN),U,2)=$P(^TMP($J,"BCMA","TRUD",CPSDFN),U,2)+1
...;W !,CPS55,U,CPSPOS,U,CPSPSB,U,CPSSCH
IV ;LOOP IVS
S (CNT("IV","TR"),CNT("IV"))=0
S CPSDATE=CPSTART F S CPSDATE=$O(^PS(55,"AIVS",CPSDATE)) Q:CPSDATE>CPSEND!('+CPSDATE) D
.S CPSDFN=0 F S CPSDFN=$O(^PS(55,"AIVS",CPSDATE,CPSDFN)) Q:'+CPSDFN D
..S CPS55=0 F S CPS55=$O(^PS(55,"AIVS",CPSDATE,CPSDFN,CPS55)) Q:'+CPS55 D
...S CNT("IV")=CNT("IV")+1,(CPSPSB,CPSPOS)=0,$P(^TMP($J,"BCMA","TRUD",CPSDFN),U,1)=$P($G(^TMP($J,"BCMA","TRUD",CPSDFN)),U,1)+1
...S CPSTYPE=$P($G(^PS(55,CPSDFN,"IV",CPS55,0)),U,4)
...I CPSTYPE="P"!(CPSTYPE="S") D
....S CPSFRE=$P($G(^PS(55,CPSDFN,"IV",CPS55,0)),U,15) I +CPSFRE S CPSTOP=$P($G(^PS(55,CPSDFN,"IV",CPS55,0)),U,3) S X2=CPSDATE,X1=$S($P(CPSTOP,".")>CPSEND:CPSEND_".24",CPSTOP>$$NOW^XLFDT():$$NOW^XLFDT(),1:CPSTOP) D ^%DTC S CPSPOS=(X*1440)/CPSFRE
....I CPSFRE="O" S CPSPOS=1 ;ONCE
...;COUND TOTAL NUMBER OF IV BAGS FOR ORDER
...I $D(^PS(55,CPSDFN,"IV",+CPS55,"BCMA"))&(CPSTYPE'="P")&(CPSTYPE'="S") S (CPSPOS,CPSNUM)=0 F S CPSNUM=$O(^PS(55,CPSDFN,"IV",+CPS55,"BCMA",CPSNUM)) Q:'+CPSNUM S CPSPOS=CPSPOS+1
...;NO LABELS
...I '$D(^PS(55,CPSDFN,"IV",+CPS55,"BCMA"))&(CPSTYPE'="P")&(CPSTYPE'="S") D
....S CPSVOL=$P($G(^PS(55,CPSDFN,"IV",CPS55,"SOL",1,0)),U,2),CPSRAT=$P($G(^PS(55,CPSDFN,"IV",CPS55,0)),U,8)
....S CPSTOP=$P($G(^PS(55,CPSDFN,"IV",CPS55,0)),U,3)
....S CPSS1=0,CPSS1=(24-$E($P(CPSDATE,".",2),1,2))*60 ;MINS FOR FIRST DATE
....IF CPSTOP>DT D NOW^%DTC S CPSS1=CPSS1+($E($P(%,".",2),1,2)*60) ; MINS FOR MIDNIGHT LAST DATE
....IF CPSTOP<DT S CPSS1=CPSS1+($E($P(CPSTOP,".",2),1,2)*60) ;MINS FOR MIDNIGHT LAST DATE
....S X1=CPSDATE,X2=+1 D C^%DTC S X2=X,X1=$S(CPSTOP>DT:DT,1:CPSTOP) D ^%DTC S CPSPOS=(((((+CPSRAT*24)*X)+CPSS1)+CPSS1)\+CPSVOL)
...Q:'+CPSPOS&('+$G(CPSRAT)) ;NO POSSIBLE FOUND AND NO INFUSTION RATE BAIL THIS ONE.
...;LOOK IN BCMA FOR IVS
...S (CPSNUM,CPSPSB)=0 F S CPSNUM=$O(^PSB(53.79,"AUID",CPSDFN,CPS55_"V",CPSNUM)) Q:'+CPSNUM S CPSPSB=CPSPSB+1
...;I DUZ=2881 W !,"IV ORDER: ",CPS55,?20,"PATIENT: ",$P(^DPT(CPSDFN,0),U,1),!,"POSSIBLE: ",CPSPOS,?20,"IN EMAR: ",CPSPSB
...Q:CPSPSB<CPSPOS
...S CNT("IV","TR")=CNT("IV","TR")+1 S $P(^TMP($J,"BCMA","TRUD",CPSDFN),U,2)=$P(^TMP($J,"BCMA","TRUD",CPSDFN),U,2)+1
..;NEXT FIND BCMA TOTAL MEDS GIVE ON UD AND MATCH IV ORDERS.
PRT ;
S (CNTT,CNTTR)=0
;W !,?5,"Meaningfull Use Stage II Report From " S Y=CPSTART D DD^%DT W Y_" TO " S Y=CPSEND D DD^%DT W Y
;D NOW^%DTC S Y=% D DD^%DT W !,?45,"Run Date/Time:"_Y
;W !,"Order Type",?15,"Total Orders",?30," %100 Tracked"
;W ! F J=1:1:IOM W "-"
;W ! F I="UNIT DOSE","IV" W I,?17,$G(CNT(I)),?35,$G(CNT(I,"TR")),! S CNTT=CNTT+$G(CNT(I)),CNTTR=CNTTR+$G(CNT(I,"TR"))
;W ! F J=1:1:IOM W "-"
;W !,?17,CNTT,?35,CNTTR
F I="UNIT DOSE","IV" S CNTT=CNTT+$G(CNT(I)),CNTTR=CNTTR+$G(CNT(I,"TR"))
S EMAR=CNTT_U_CNTTR ;_U_CNTTR/CNTT
EXIT ;
Q
APCM25E2 ; IHS/CMI/LAB - IHS MU ;
+1 ;;1.0;MU PERFORMANCE REPORTS;**7**;MAR 26, 2012;Build 15
+2 ;;;;;;Build 3
DEMO ;EP - CALCULATE DEMOGRAPHICS
+1 ;for each provider or for the facility find out if this
+2 ;patient had a visit of A, O, R, S to this provider or facility
+3 ;if so, then check to see if they had dob, preferred language, gender, race, ethnicity recorded
+4 NEW APCMP
+5 SET (APCMD1,APCMN1)=0
+6 IF APCMRPTT=1
Begin DoDot:1
+7 SET APCMP=0
FOR
SET APCMP=$ORDER(APCMPRV(APCMP))
IF APCMP'=+APCMP
QUIT
Begin DoDot:2
+8 ;DID NOT SEE THIS PATIENT
IF '$DATA(APCMHVTP(APCMP))
QUIT
+9 DO DEMO1
End DoDot:2
End DoDot:1
QUIT
+10 IF APCMRPTT=2
Begin DoDot:1
+11 SET APCMP=APCMFAC
+12 IF '$DATA(APCMHVTP(APCMP))
QUIT
+13 DO DEMO1
+14 QUIT
End DoDot:1
+15 QUIT
DEMO1 ;set denominator value into field
+1 ;denom field for this measure
SET F=$PIECE(^APCM25OB(APCMIC,0),U,8)
+2 DO S^APCM25E1(APCMRPT,APCMIC,1,APCMP,APCMRPTT,APCMTIME,F)
+3 SET APCMVALU="VISIT: "_$$DATE^APCM1UTL(APCMHVTP(APCMP))
+4 ;numerator?
+5 SET APCMEP=$$HASDEMO(DFN,APCMBDAT,APCMEDAT,APCMRPTT,$GET(APCMVDOD))
+6 SET APCMVALU=APCMVALU_"|||"_$SELECT($PIECE(APCMEP,U,1)=1:"MEETS OBJECTIVE: ",1:"DOES NOT MEET OBJECTIVE: ")_$PIECE(APCMEP,U,2)_"|||"_$PIECE(APCMEP,U,1)
+7 SET F=$PIECE(^APCM25OB(APCMIC,0),U,9)
+8 DO S^APCM25E1(APCMRPT,APCMIC,$PIECE(APCMEP,U,1),APCMP,APCMRPTT,APCMTIME,F)
+9 DO SETLIST^APCM25E1
+10 QUIT
HASDEMO(P,BD,ED,T,DODV) ;
+1 NEW PL,G,R,E,D,C,Y,X,B,Z
+2 SET C=0
+3 SET T=$GET(T)
+4 SET DODV=$GET(DODV)
+5 SET (PL,G,R,E,D)=""
+6 ;preferred language
+7 SET X=0
FOR
SET X=$ORDER(^AUPNPAT(P,86,X))
IF X'=+X!(PL]"")
QUIT
Begin DoDot:1
+8 SET B=$PIECE(^AUPNPAT(P,86,X,0),U)
+9 ;Q:B>ED
+10 SET C=C+1
SET PL="Preferred Language"
End DoDot:1
+11 SET G=$PIECE(^DPT(P,0),U,2)
IF G]""
SET C=C+1
SET G="Gender"
+12 IF $TEXT(RACE^AGUTL)]""
SET R=$$RACE^AGUTL(P)
+13 IF R
SET C=C+1
SET R="Race"
IF 1
+14 IF '$TEST
SET R=$$VAL^XBDIQ1(2,P,.06)
IF R]""
SET C=C+1
SET R="Race"
+15 SET Z=0
FOR
SET Z=$ORDER(^DPT(P,.06,Z))
IF Z'=+Z!(E]"")
QUIT
Begin DoDot:1
+16 SET E=$PIECE($GET(^DPT(P,.06,Z,0)),U,1)
+17 IF E=""
QUIT
+18 SET E="Ethnicity"
SET C=C+1
+19 QUIT
End DoDot:1
+20 IF $PIECE(^DPT(P,0),U,3)]""
SET D="DOB"
SET C=C+1
+21 IF T=2
IF $GET(DODV)
GOTO HASDEMOH
+22 IF C=5
QUIT 1_U_"Has: "_PL_";"_G_";"_R_";"_E_";"_D
+23 QUIT 0_U_"Has: "_PL_";"_G_";"_R_";"_E_";"_D
HASDEMOH ;did patient die in the hospital during report period? if so is dod and underlying cause there?
+1 NEW VDOD,L,PCD
+2 SET PCD=""
+3 SET VDOD=$$DATE^APCM1UTL($PIECE($PIECE(^AUPNVINP(DODV,0),U,1),"."))
+4 IF VDOD]""
SET C=C+1
SET VDOD="DIED IN HOSP "_VDOD
+5 SET L=$$VAL^XBDIQ1(9000010.02,DODV,2101)
+6 IF L]""
SET C=C+1
SET PCD="PCD"
+7 IF C=7
QUIT 1_U_"Has: "_PL_";"_G_";"_R_";"_E_";"_D_";"_VDOD_";"_PCD
+8 QUIT 0_U_"Has: "_PL_";"_G_";"_R_";"_E_";"_D_";"_VDOD_";"_PCD
+9 ;
PL ;EP - CALCULATE PROBLEM LIST
+1 ;for each provider or for the facility find out if this
+2 ;patient had a visit of A, O, R, S to this provider or facility
+3 ;if so, then check to see if they any problems on their problem list (skip deleted) or a NAP documented in report period
+4 NEW APCMP
+5 SET (APCMD1,APCMN1)=0
+6 IF APCMRPTT=1
Begin DoDot:1
+7 SET APCMP=0
FOR
SET APCMP=$ORDER(APCMPRV(APCMP))
IF APCMP'=+APCMP
QUIT
Begin DoDot:2
+8 ;no visits to this provider for this patient so don't bother, the patient is not in the denominator
IF '$DATA(APCMHVTP(APCMP))
QUIT
+9 DO PL1
+10 QUIT
End DoDot:2
End DoDot:1
QUIT
+11 IF APCMRPTT=2
Begin DoDot:1
+12 SET APCMP=APCMFAC
+13 IF '$DATA(APCMHVTP(APCMP))
QUIT
+14 DO PL1
+15 QUIT
End DoDot:1
+16 QUIT
PL1 ;set denominator value into field
+1 ;denom field for this measure
SET F=$PIECE(^APCM25OB(APCMIC,0),U,8)
+2 DO S^APCM25E1(APCMRPT,APCMIC,1,APCMP,APCMRPTT,APCMTIME,F)
+3 SET APCMVALU="VISIT: "_$$DATE^APCM1UTL(APCMHVTP(APCMP))
+4 ;numerator?
+5 SET APCMEP=$$HASPL(DFN,APCMBDAT,APCMEDAT)
+6 SET APCMVALU=APCMVALU_"|||"_$PIECE(APCMEP,U,2)_"|||"_$PIECE(APCMEP,U,1)
+7 SET F=$PIECE(^APCM25OB(APCMIC,0),U,9)
+8 DO S^APCM25E1(APCMRPT,APCMIC,$PIECE(APCMEP,U,1),APCMP,APCMRPTT,APCMTIME,F)
+9 DO SETLIST^APCM25E1
+10 QUIT
HASPL(P,BD,ED) ;does patient have a problem entered before end of report period
+1 ;
+2 NEW A,B,C,D,E
+3 SET E=""
+4 SET A=0
FOR
SET A=$ORDER(^AUPNPROB("AC",P,A))
IF A'=+A!(E]"")
QUIT
Begin DoDot:1
+5 ;if date entered is after the ED don't count it
+6 IF '$DATA(^AUPNPROB(A,0))
QUIT
+7 ;after end date of report period
IF $PIECE(^AUPNPROB(A,0),U,8)>ED
QUIT
+8 IF $PIECE(^AUPNPROB(A,0),U,12)'="D"
SET E=1_U_"Problem Entry: "_$$VAL^XBDIQ1(9000011,A,.01)_" entered on "_$$VAL^XBDIQ1(9000011,A,.08)
QUIT
+9 ;since it's deleted, deletion date must not be before time period
+10 ;date deleted
SET D=$PIECE($PIECE($GET(^AUPNPROB(A,2)),U,2),".")
+11 IF D>ED
QUIT
+12 IF D<BD
QUIT
+13 SET E="1^Problem Entry: "_$$VAL^XBDIQ1(9000011,A,.01)_" entered on "_$$VAL^XBDIQ1(9000011,A,.08)
End DoDot:1
+14 IF E]""
QUIT E
+15 ;no problems on PL so how about a NAP before end of time period
+16 SET C=$ORDER(^AUTTCRA("B","NO ACTIVE PROBLEMS",0))
+17 IF 'C
QUIT ""
+18 SET A=0
FOR
SET A=$ORDER(^AUPNVRUP("AC",P,A))
IF A'=+A!(E]"")
QUIT
Begin DoDot:1
+19 ;oops
IF '$DATA(^AUPNVRUP(A,0))
QUIT
+20 ;not NAP
IF $PIECE(^AUPNVRUP(A,0),U,1)'=C
QUIT
+21 SET D=$$VD^APCLV($PIECE(^AUPNVRUP(A,0),U,3))
+22 IF D>ED
QUIT
+23 SET E="1^No Active Problems on "_$$DATE^APCM1UTL(D)
End DoDot:1
+24 QUIT E
+25 ; Return boolean flag indicating valid patient
PATVRY(RX,PAT) ;EP
+1 IF PAT="*"
QUIT 1
+2 QUIT +$PIECE($GET(^PSRX(RX,0)),U,2)=PAT
+3 ; Return release date for dispense
DSPRDT(RX,TYP,SIEN) ;EP
+1 QUIT $SELECT($GET(SIEN):+$PIECE($GET(^PSRX(RX,$SELECT(TYP="ADP":"P",1:1),SIEN,0)),U,$SELECT(TYP="ADP":19,1:18)),1:+$PIECE(^PSRX(RX,2),U,13))
EMAR ;EP
+1 ;for each provider count each Visit that HAS a v referral
+2 KILL ^TMP($JOB,"TRANS")
+3 NEW EMAR
+4 DO EMAR1
+5 NEW APCMP,N,F,O,Y
+6 IF APCMRPTT=2
SET APCMP=APCMFAC
Begin DoDot:1
+7 IF $$AVC^APCM25EM(APCMBDAT,APCMEDAT,APCMFAC)<10
Begin DoDot:2
+8 SET F=$PIECE(^APCM25OB(APCMIC,0),U,11)
DO S^APCM25E1(APCMRPT,APCMIC,"Facility is excluded from this measure as the average daily census was <10 during the previous year.",APCMP,APCMRPTT,APCMTIME,F,1)
End DoDot:2
+9 ;denom field for this measure
SET F=$PIECE(^APCM25OB(APCMIC,0),U,8)
+10 ;returns
SET N=$PIECE(EMAR,U,1)
+11 DO S^APCM25E1(APCMRPT,APCMIC,N,APCMP,APCMRPTT,APCMTIME,F)
+12 ;now set patient list for this provider
+13 SET P=0
FOR
SET P=$ORDER(^TMP($JOB,"BCMA","TRUD",P))
IF P'=+P
QUIT
Begin DoDot:2
+14 SET APCMVALU="# orders: "_$PIECE(^TMP($JOB,"BCMA","TRUD",P),U,1)_"|||"_" # w/100%eMAR: "_+$PIECE(^TMP($JOB,"BCMA","TRUD",P),U,2)_"|||1"
+15 SET DFN=P
+16 DO SETLIST^APCM25E1
End DoDot:2
+17 ;numerator?
+18 SET F=$PIECE(^APCM25OB(APCMIC,0),U,9)
+19 SET N=$PIECE(EMAR,U,2)
+20 DO S^APCM25E1(APCMRPT,APCMIC,N,APCMP,APCMRPTT,APCMTIME,F)
End DoDot:1
+21 KILL ^TMP($JOB)
+22 QUIT
EMAR1 ;EP - ep toc
START ;Set beginning/ending sort dates for ORDERS
+1 NEW CNT,CNTT,CNTTR,CPS55,CPSDATE,CPSDFN,CPSEND,CPSFRE,CPSN,CPSN1,CPSNUM,CPSPOS,CPSPSB
+2 NEW CPSQ,CPSRAT,CPSS1,CPSSCH,CPSTART,CPSTOP,CPSTYPE,CPSVOL
+3 SET CPSTART=APCMBDAT
+4 SET CPSEND=APCMEDAT
+5 SET EMAR=""
+6 SET (CNT("UNIT DOSE","TR"),CNT("UNIT DOSE"))=0
+7 KILL ^TMP($JOB)
P55 ;LOOP 55 UNIT DOSE
+1 SET CPSDATE=CPSTART
FOR
SET CPSDATE=$ORDER(^PS(55,"AUDS",CPSDATE))
IF $PIECE(CPSDATE,".")>CPSEND!('+CPSDATE)!(CPSDATE>$$NOW^XLFDT())
QUIT
Begin DoDot:1
+2 SET CPSDFN=0
FOR
SET CPSDFN=$ORDER(^PS(55,"AUDS",CPSDATE,CPSDFN))
IF '+CPSDFN
QUIT
Begin DoDot:2
+3 SET CPS55=0
FOR
SET CPS55=$ORDER(^PS(55,"AUDS",CPSDATE,CPSDFN,CPS55))
IF '+CPS55
QUIT
Begin DoDot:3
+4 ;COUNT POSSIBLE DOSES DUE FOR ORDER.
+5 SET CPSPOS=0
+6 SET CPSFRE=$PIECE($GET(^PS(55,CPSDFN,5,+CPS55,2)),U,6)
SET CPSTOP=$PIECE($GET(^PS(55,CPSDFN,5,+CPS55,2)),U,4)
+7 SET CPSSCH=$PIECE($GET(^PS(55,CPSDFN,5,+CPS55,0)),U,7)
+8 IF CPSTOP<CPSDATE
QUIT
+9 IF CPSFRE="D"&(CPSSCH="C")
SET CPSN=$LENGTH($PIECE($GET(^PS(55,CPSDFN,5,+CPS55,2)),U,1),"-")
SET X2=CPSDATE
SET X1=$SELECT(CPSTOP<DT:DT,1:CPSTOP)
DO ^%DTC
SET CPSPOS=CPSN*X
+10 IF +CPSFRE&(CPSSCH="C")
Begin DoDot:4
+11 SET CPSS1=$$FMDIFF^XLFDT($SELECT(CPSTOP>$$NOW^XLFDT():$$NOW^XLFDT(),$PIECE(CPSTOP,".")>CPSEND:CPSEND_".24",1:CPSTOP),CPSDATE,2)
SET CPSS1=CPSS1\60
+12 ;POSSIBLE DOSES?
SET CPSPOS=CPSS1\CPSFRE
+13 ;FREQ IS GREATER SO ONLY ONE POSSIBLE
IF CPSFRE>CPSS1
SET CPSPOS=1
+14 ;S CPSS1=0,CPSS1=(24-$E($P(CPSDATE,".",2),1,2))*60 ;MINS FOR FIRST DATE l
+15 ;IF CPSTOP>DT D NOW^%DTC S CPSS1=CPSS1+($E($P(%,".",2),1,2)*60) ; MINS FOR MIDNIGHT LAST DATE l
+16 ;IF CPSTOP<DT S CPSS1=CPSS1+($E($P(CPSTOP,".",2),1,2)*60) ;MINS FOR MIDNIGHT LAST DATE l
+17 ;S X1=CPSDATE,X2=+1 D C^%DTC S X2=X,X1=$S(CPSTOP>DT:DT,1:CPSTOP) D ^%DTC S CPSPOS=((X*1440)+CPSS1)/CPSFRE l
+18 ;S X1=DT,X2=+1 D C^%DTC S CPSNDT=X S X2=CPSDATE,X1=$S(CPSTOP>DT:CPSNDT,1:CPSTOP) D ^%DTC S CPSPOS=((X*1440)+CPSS1)/CPSFRE
End DoDot:4
+19 ;I DUZ=2881 W !,"PATIENT: ",$P(^DPT(CPSDFN,0),U,1),?30,"ORDER: ",$P($G(^PS(55,CPSDFN,5,+CPS55,0)),U,1),?45,"SCHEDULE TYPE: ",CPSSCH,!,"START: ",$$FMTE^XLFDT(CPSDATE),?30,"STOP: ",$$FMTE^XLFDT(CPSTOP),?60,"FREQUENCY: ",CPSFRE
+20 IF CPSSCH="C"!(CPSSCH="O")
SET CNT("UNIT DOSE")=CNT("UNIT DOSE")+1
SET $PIECE(^TMP($JOB,"BCMA","TRUD",CPSDFN),U,1)=$PIECE($GET(^TMP($JOB,"BCMA","TRUD",CPSDFN)),U,1)+1
+21 ;LOOK 53.79 FOR DOSE TRACKED.
+22 ;PRNS TO ONE
IF CPSSCH="O"
SET CPSPOS=1
+23 IF +CPSPOS<0!(CPSPOS=0)
QUIT
+24 SET CPSQ=$SELECT(CPSSCH="O":1,CPSSCH="C":1,1:0)
+25 IF CPSQ=0
QUIT
+26 ;W !,CPSSCH
+27 SET (CPSPSB,CPSN1)=0
FOR
SET CPSN1=$ORDER(^PSB(53.79,"AORDX",CPSDFN,CPS55_"U",CPSN1))
IF '+CPSN1
QUIT
SET CPSPSB=CPSPSB+1
+28 ;I DUZ=2881 W !,"POSSIBLE DOSES: ",CPSPOS,?30,"# IN EMAR: ",CPSPSB,?50,"MET 100%: ",$S(CPSPSB<CPSPOS:"NO",1:"YES"),!
+29 IF CPSPSB<CPSPOS
QUIT
+30 SET CNT("UNIT DOSE","TR")=CNT("UNIT DOSE","TR")+1
SET $PIECE(^TMP($JOB,"BCMA","TRUD",CPSDFN),U,2)=$PIECE(^TMP($JOB,"BCMA","TRUD",CPSDFN),U,2)+1
+31 ;W !,CPS55,U,CPSPOS,U,CPSPSB,U,CPSSCH
End DoDot:3
End DoDot:2
End DoDot:1
IV ;LOOP IVS
+1 SET (CNT("IV","TR"),CNT("IV"))=0
+2 SET CPSDATE=CPSTART
FOR
SET CPSDATE=$ORDER(^PS(55,"AIVS",CPSDATE))
IF CPSDATE>CPSEND!('+CPSDATE)
QUIT
Begin DoDot:1
+3 SET CPSDFN=0
FOR
SET CPSDFN=$ORDER(^PS(55,"AIVS",CPSDATE,CPSDFN))
IF '+CPSDFN
QUIT
Begin DoDot:2
+4 SET CPS55=0
FOR
SET CPS55=$ORDER(^PS(55,"AIVS",CPSDATE,CPSDFN,CPS55))
IF '+CPS55
QUIT
Begin DoDot:3
+5 SET CNT("IV")=CNT("IV")+1
SET (CPSPSB,CPSPOS)=0
SET $PIECE(^TMP($JOB,"BCMA","TRUD",CPSDFN),U,1)=$PIECE($GET(^TMP($JOB,"BCMA","TRUD",CPSDFN)),U,1)+1
+6 SET CPSTYPE=$PIECE($GET(^PS(55,CPSDFN,"IV",CPS55,0)),U,4)
+7 IF CPSTYPE="P"!(CPSTYPE="S")
Begin DoDot:4
+8 SET CPSFRE=$PIECE($GET(^PS(55,CPSDFN,"IV",CPS55,0)),U,15)
IF +CPSFRE
SET CPSTOP=$PIECE($GET(^PS(55,CPSDFN,"IV",CPS55,0)),U,3)
SET X2=CPSDATE
SET X1=$SELECT($PIECE(CPSTOP,".")>CPSEND:CPSEND_".24",CPSTOP>$$NOW^XLFDT():$$NOW^XLFDT(),1:CPSTOP)
DO ^%DTC
SET CPSPOS=(X*1440)/CPSFRE
+9 ;ONCE
IF CPSFRE="O"
SET CPSPOS=1
End DoDot:4
+10 ;COUND TOTAL NUMBER OF IV BAGS FOR ORDER
+11 IF $DATA(^PS(55,CPSDFN,"IV",+CPS55,"BCMA"))&(CPSTYPE'="P")&(CPSTYPE'="S")
SET (CPSPOS,CPSNUM)=0
FOR
SET CPSNUM=$ORDER(^PS(55,CPSDFN,"IV",+CPS55,"BCMA",CPSNUM))
IF '+CPSNUM
QUIT
SET CPSPOS=CPSPOS+1
+12 ;NO LABELS
+13 IF '$DATA(^PS(55,CPSDFN,"IV",+CPS55,"BCMA"))&(CPSTYPE'="P")&(CPSTYPE'="S")
Begin DoDot:4
+14 SET CPSVOL=$PIECE($GET(^PS(55,CPSDFN,"IV",CPS55,"SOL",1,0)),U,2)
SET CPSRAT=$PIECE($GET(^PS(55,CPSDFN,"IV",CPS55,0)),U,8)
+15 SET CPSTOP=$PIECE($GET(^PS(55,CPSDFN,"IV",CPS55,0)),U,3)
+16 ;MINS FOR FIRST DATE
SET CPSS1=0
SET CPSS1=(24-$EXTRACT($PIECE(CPSDATE,".",2),1,2))*60
+17 ; MINS FOR MIDNIGHT LAST DATE
IF CPSTOP>DT
DO NOW^%DTC
SET CPSS1=CPSS1+($EXTRACT($PIECE(%,".",2),1,2)*60)
+18 ;MINS FOR MIDNIGHT LAST DATE
IF CPSTOP<DT
SET CPSS1=CPSS1+($EXTRACT($PIECE(CPSTOP,".",2),1,2)*60)
+19 SET X1=CPSDATE
SET X2=+1
DO C^%DTC
SET X2=X
SET X1=$SELECT(CPSTOP>DT:DT,1:CPSTOP)
DO ^%DTC
SET CPSPOS=(((((+CPSRAT*24)*X)+CPSS1)+CPSS1)\+CPSVOL)
End DoDot:4
+20 ;NO POSSIBLE FOUND AND NO INFUSTION RATE BAIL THIS ONE.
IF '+CPSPOS&('+$GET(CPSRAT))
QUIT
+21 ;LOOK IN BCMA FOR IVS
+22 SET (CPSNUM,CPSPSB)=0
FOR
SET CPSNUM=$ORDER(^PSB(53.79,"AUID",CPSDFN,CPS55_"V",CPSNUM))
IF '+CPSNUM
QUIT
SET CPSPSB=CPSPSB+1
+23 ;I DUZ=2881 W !,"IV ORDER: ",CPS55,?20,"PATIENT: ",$P(^DPT(CPSDFN,0),U,1),!,"POSSIBLE: ",CPSPOS,?20,"IN EMAR: ",CPSPSB
+24 IF CPSPSB<CPSPOS
QUIT
+25 SET CNT("IV","TR")=CNT("IV","TR")+1
SET $PIECE(^TMP($JOB,"BCMA","TRUD",CPSDFN),U,2)=$PIECE(^TMP($JOB,"BCMA","TRUD",CPSDFN),U,2)+1
End DoDot:3
+26 ;NEXT FIND BCMA TOTAL MEDS GIVE ON UD AND MATCH IV ORDERS.
End DoDot:2
End DoDot:1
PRT ;
+1 SET (CNTT,CNTTR)=0
+2 ;W !,?5,"Meaningfull Use Stage II Report From " S Y=CPSTART D DD^%DT W Y_" TO " S Y=CPSEND D DD^%DT W Y
+3 ;D NOW^%DTC S Y=% D DD^%DT W !,?45,"Run Date/Time:"_Y
+4 ;W !,"Order Type",?15,"Total Orders",?30," %100 Tracked"
+5 ;W ! F J=1:1:IOM W "-"
+6 ;W ! F I="UNIT DOSE","IV" W I,?17,$G(CNT(I)),?35,$G(CNT(I,"TR")),! S CNTT=CNTT+$G(CNT(I)),CNTTR=CNTTR+$G(CNT(I,"TR"))
+7 ;W ! F J=1:1:IOM W "-"
+8 ;W !,?17,CNTT,?35,CNTTR
+9 FOR I="UNIT DOSE","IV"
SET CNTT=CNTT+$GET(CNT(I))
SET CNTTR=CNTTR+$GET(CNT(I,"TR"))
+10 ;_U_CNTTR/CNTT
SET EMAR=CNTT_U_CNTTR
EXIT ;
+1 QUIT
