APCM14E9 ;IHS/CMI/LAB - IHS MU;
;;1.0;IHS MU PERFORMANCE REPORTS;**5,6**;MAR 26, 2012;Build 65
;;;;;;Build 3
CPOE ;EP - CALCULATE EPRESCRIBING
;for each provider or for the facility count all prescriptions that meet criteria and if it is not written it meets numerator
K ^TMP($J,"PATSRX")
K APCMRXS
D TOTRX
K ^TMP($J,"ORDERSPROCESSED")
NEW APCMP,N,F
S (APCMD1,APCMN1)=0
I APCMRPTT=1 S APCMP=0 F S APCMP=$O(APCMPRV(APCMP)) Q:APCMP'=+APCMP D
.I $P($G(APCMRXS(APCMP)),U,1)<100 S F=$P(^APCM14OB(APCMIC,0),U,11) D
..D S^APCM14E1(APCMRPT,APCMIC,"Provider is excluded from this measure as he/she had < 100 medication orders during the EHR reporting period.",APCMP,APCMRPTT,APCMTIME,F,1)
D .;set denominator value into field
.S F=$P(^APCM14OB(APCMIC,0),U,8) ;denom field for this measure
.S N=$P($G(APCMRXS(APCMP)),U,1) ;returns # of prescriptions^# not written by nature of order
.D S^APCM14E1(APCMRPT,APCMIC,N,APCMP,APCMRPTT,APCMTIME,F)
.;now set patient list for this provider
.S P=0 F S P=$O(^TMP($J,"PATSRX",APCMP,P)) Q:P'=+P D
..S D=$P(^TMP($J,"PATSRX",APCMP,P),U,1),N=$P(^TMP($J,"PATSRX",APCMP,P),U,2) S APCMVALU="# Orders: "_D_"|||"_"# CPOE: "_N_" # NOT CPOE: "_(D-N)
..S DFN=P D SETLIST^APCM14E1
.;numerator?
.S F=$P(^APCM14OB(APCMIC,0),U,9)
.S N=$P($G(APCMRXS(APCMP)),U,2)
.D S^APCM14E1(APCMRPT,APCMIC,N,APCMP,APCMRPTT,APCMTIME,F)
I APCMRPTT=2 D
.S APCMP=APCMFAC
.S F=$P(^APCM14OB(APCMIC,0),U,8) ;denom field for this measure
.S N=$P($G(APCMRXS(APCMFAC)),U,1) ;returns # of prescriptions^# not written by nature of order
.D S^APCM14E1(APCMRPT,APCMIC,N,APCMFAC,APCMRPTT,APCMTIME,F)
.;now set patient list for this FACILITY
.S P=0 F S P=$O(^TMP($J,"PATSRX",APCMFAC,P)) Q:P'=+P D
..S D=$P(^TMP($J,"PATSRX",APCMFAC,P),U,1),N=$P(^TMP($J,"PATSRX",APCMFAC,P),U,2) S APCMVALU="# Orders: "_D_"|||"_"# CPOE: "_N_" # NOT CPOE: "_(D-N)
..S DFN=P D SETLIST^APCM14E1
.;numerator?
.S F=$P(^APCM14OB(APCMIC,0),U,9)
.S N=$P($G(APCMRXS(APCMFAC)),U,2)
.D S^APCM14E1(APCMRPT,APCMIC,N,APCMFAC,APCMRPTT,APCMTIME,F)
K ^TMP($J,"PATSRX")
Q
TOTRX ;EP - did patient have a RX in file 52 with an issue date
;between BD and ED
;SET ARRAY APCMRXS to APCMRXS(prov ien)=denom^numer
K ^TMP($J,"ORDERSPROCESSED")
NEW ID,C,Y,X,D,S,N,A,B,R,PAT,G,ORIEN,ORPFILE,ORPTST,ORNS,PATLOC,ORACT0,ORORD,ORDEB
S ID=$$FMADD^XLFDT(APCMBDAT,-1),ID=ID_".9999"
F S ID=$O(^OR(100,"AF",ID)) Q:ID'=+ID!($P(ID,".")>APCMEDAT) D
.S ORIEN=0 F S ORIEN=$O(^OR(100,"AF",ID,ORIEN)) Q:ORIEN'=+ORIEN D
..Q:$D(^TMP($J,"ORDERSPROCESSED",ORIEN))
..S ^TMP($J,"ORDERSPROCESSED",ORIEN)=""
..S ORPFILE=$P($G(^OR(100,ORIEN,0)),"^",2) Q:ORPFILE="" ;Quit if no object of order
..Q:$P(ORPFILE,";",2)'["DPT" ;only patient orders
..S PAT=+$P($G(^OR(100,ORIEN,0)),U,2) ;GET Patient DFN
..Q:$$DEMO^APCLUTL(PAT,APCMDEMO) ;Quit if demo patient
..Q:+$P($G(^OR(100,ORIEN,3)),"^",11)'=0 ;190 quit if order type not standard
..S ORPTST=$P($G(^OR(100,ORIEN,0)),"^",12) ;patient status (in/out)
..S ORNS=$$NMSP($P($G(^OR(100,ORIEN,0)),"^",14)) ;get package namespace
..I ORNS'="PS" Q ;if not getting all types of orders then quit if order is not from pharmacy
..S ORACT0=$G(^OR(100,ORIEN,8,1,0))
..Q:$P(ORACT0,U,1)'=ID
..S ORORD=$P(ORACT0,"^",12) ;ORORD holds nature of order ien
..Q:ORORD=4 ;skip service corrections
..S ORPVID=$P(ORACT0,"^",3)
..S G=0
..I APCMRPTT=1 D
...Q:ORPTST'="O" ;Quit if patient status is not outpatient and in EP report
...S ORPVID=$P(ORACT0,"^",3) Q:'$D(APCMPRV(ORPVID)) ;quit if ordering provider doesn't match user selected provider
...S PATLOC=+$P($G(^OR(100,ORIEN,0)),U,10)
...S C="" I PATLOC,$D(^SC(PATLOC,0)) S C=$P(^SC(PATLOC,0),U,7) I C Q:$P($G(^DIC(40.7,C,0)),U,2)=30 ;IF ER IN HOSP LOC Q
...S G=1
..I APCMRPTT=2 D
...I ORPTST="I" S G=1 Q
...Q:APCMMETH="O"
...S PATLOC=+$P($G(^OR(100,ORIEN,0)),U,10)
...Q:'PATLOC
...S C="" I PATLOC,$D(^SC(PATLOC,0)) S C=$P(^SC(PATLOC,0),U,7) I C Q:$P($G(^DIC(40.7,C,0)),U,2)'=30 ;IF NOT ER IN HOSP LOC Q
...I PATLOC,$D(^SC(PATLOC,0)) S C=$P(^SC(PATLOC,0),U,4) I C,C'=APCMFAC Q
...S G=1
..Q:'G
..S ORORD=$P(ORACT0,"^",12) ;ORORD holds nature of order ien
..;SET DENOM COUNT FOR THIS EP = INCREMENT BY 1
..I APCMRPTT=1 S $P(APCMRXS(ORPVID),U,1)=$P($G(APCMRXS(ORPVID)),U,1)+1,$P(^TMP($J,"PATSRX",ORPVID,PAT),U,1)=$P($G(^TMP($J,"PATSRX",ORPVID,PAT)),U,1)+1
..I APCMRPTT=2 S $P(APCMRXS(APCMFAC),U,1)=$P($G(APCMRXS(APCMFAC)),U,1)+1,$P(^TMP($J,"PATSRX",APCMFAC,PAT),U,1)=$P($G(^TMP($J,"PATSRX",APCMFAC,PAT)),U,1)+1
..;
..;now check to see if it has a nature of order IS equal to 1-written if so, quit and don't set numerator
..I ORORD=1 Q ;this is a written order so do not put in numerator
..S ORDEB=$P(^OR(100,ORIEN,8,1,0),"^",13) ;this is the person who entered the order (ENTERED BY)
..;Q:'$$ORES(ORDEB,$P(ID,".",1)) ;quit if this person does not have ORES or ORESLE on date of order so don't count in numerator
..; DUZ=2793 W " NUMER"
..I APCMRPTT=1 S $P(APCMRXS(ORPVID),U,2)=$P(APCMRXS(ORPVID),U,2)+1,$P(^TMP($J,"PATSRX",ORPVID,PAT),U,2)=$P($G(^TMP($J,"PATSRX",ORPVID,PAT)),U,2)+1
..I APCMRPTT=2 S $P(APCMRXS(APCMFAC),U,2)=$P($G(APCMRXS(APCMFAC)),U,2)+1,$P(^TMP($J,"PATSRX",APCMFAC,PAT),U,2)=$P($G(^TMP($J,"PATSRX",APCMFAC,PAT)),U,2)+1
Q
NMSP(PKG) ; -- Returns package namespace from pointer
N Y S Y=$$GET1^DIQ(9.4,+PKG_",",1)
S:$E(Y,1,2)="PS" Y="PS" S:Y="GMRV" Y="OR"
Q Y
;
ORES(R,D) ;EP - DID PROVIDER HAVE ORES OR ORESLE ON DATE D
I '$G(R) Q ""
I '$D(^VA(200,R,0)) Q ""
NEW K,J
S K=$O(^DIC(19.1,"B","ORES",0))
S J=$O(^DIC(19.1,"B","ORELSE",0))
I $D(^VA(200,R,51,K,0)),$P(^VA(200,R,51,K,0),U,3)'>D Q 1
I $D(^VA(200,R,51,J,0)),$P(^VA(200,R,51,J,0),U,3)'>D Q 1
Q ""
PEA ;EP - PATIENT ELECTRONIC ACCESS
;does visit have AF-PHR or HIE logged for that visit
NEW APCMP
S (APCMD1,APCMN1)=0
I APCMRPTT=1 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
.;numerator?
.S APCMEP=$$HASPEA(DFN,APCMBDAT,APCMEDAT,APCMP,1,.APCMVSTS) ;return # of visits^# w/AF-PHR or logged in HIE log
.;set denominator value into field
.S APCMTV=$P(APCMEP,U),APCMTE=$P(APCMEP,U,2)
.S F=$P(^APCM14OB(APCMIC,0),U,8) ;denom field for this measure
.D S^APCM14E1(APCMRPT,APCMIC,1,APCMP,APCMRPTT,APCMTIME,F)
.;numerator?
.S APCMVALU="# visits: "_$P(APCMEP,U,1)_" # elec access: "_+$P(APCMEP,U,2)_" |||"_$P(APCMEP,U,3)_" "_$P(APCMEP,U,4)_"|||"_$S($P(APCMEP,U,2):1,1:0)
.S F=$P(^APCM14OB(APCMIC,0),U,9)
.D S^APCM14E1(APCMRPT,APCMIC,$S(APCMTE:1,1:0),APCMP,APCMRPTT,APCMTIME,F)
.;measure b - did they access in ehr report period
.I $G(APCMATTE("S1.020.EP.1",APCMP))="Yes" S F=$P(^APCM14OB($O(^APCM14OB("B","S1.020.EP.1",0)),0),U,11) D
..D S^APCM14E1(APCMRPT,$O(^APCM14OB("B","S1.020.EP.1",0)),"Yes",APCMP,APCMRPTT,APCMTIME,F,1)
.S V="" I $T(PHR^BPHRMUPM)]"" D PHR^BPHRMUPM(DFN,APCMBDAT,DT,.V)
.;I DUZ=2793 S V="1^3130812^1^3130812^1^3130812"
.S APCMVALU="# visits: "_$P(APCMEP,U,1)_" # elec access: "_+$P(APCMEP,U,2)_" |||"_$P(APCMEP,U,3)_" "_$P(APCMEP,U,4)_" accessed PHR: "_$$DATE^APCM1UTL($P(V,U,4))_"|||"_$S($P(APCMEP,U,2):1,1:0)_"|||"_$P(V,U,3)
.;set measure B
.S Y=$O(^APCM14OB("B","S1.020.EP.1",0))
.S F=$P(^APCM14OB(Y,0),U,8)
.D S^APCM14E1(APCMRPT,Y,1,APCMP,APCMRPTT,APCMTIME,F)
.S F=$P(^APCM14OB(Y,0),U,9)
.D S^APCM14E1(APCMRPT,Y,$P(V,U,3),APCMP,APCMRPTT,APCMTIME,F)
.Q:$P(APCMEP,U,1)=0
.D SETLIST^APCM14E1
I APCMRPTT=2 D
.S APCMP=APCMFAC
.;GET ARRAY OF DISCHARGES/ER VISITS
.NEW APCMHERL,CNT,APCMHER
.K APCMHER
.S CNT=0
.S X=0 F S X=$O(^AUPNVINP("AC",DFN,X)) Q:X'=+X D
..Q:'$D(^AUPNVINP(X,0))
..S D=$P($P(^AUPNVINP(X,0),U,1),".")
..Q:D<APCMBDAT
..Q:D>APCMEDAT
..Q:$$LOCENC^APCLV($P(^AUPNVINP(X,0),U,3))'=APCMFAC
..Q:$$SC^APCLV($P(^AUPNVINP(X,0),U,3))'="H" ;don't count Events
..S CNT=CNT+1
..S $P(APCMHER(CNT),U,5)=$P(^AUPNVINP(X,0),U,3) ;visit array
.;IF ED METHOD ;NOW GET ALL ER VISITS
.I APCMMETH="E" D
..S X=0 F S X=$O(APCMVSTS(X)) Q:X'=+X D
...S V=$P(APCMVSTS(X),U,5)
...Q:$$CLINIC^APCLV(V,"C")'=30
...Q:$$LOCENC^APCLV(V)'=APCMFAC
...Q:$$SC^APCLV(V)'="A"
...S CNT=CNT+1
...S $P(APCMHER(CNT),U,5)=V
.I APCMMETH="O" D
..S X=0 F S X=$O(APCMVSTS(X)) Q:X'=+X D
...S V=$P(APCMVSTS(X),U,5)
...Q:$$SC^APCLV(V)'="O"
...S CNT=CNT+1
...S $P(APCMHER(CNT),U,5)=V
.I '$D(APCMHER) Q ;no visits
.S APCMEP=$$HASPEA(DFN,APCMBDAT,APCMEDAT,APCMP,2,.APCMHER) ;return # of visits^# w/AF-PHR or logged in HIE log
.;set denominator value into field
.S APCMTV=$P(APCMEP,U),APCMTE=$P(APCMEP,U,2)
.S F=$P(^APCM14OB(APCMIC,0),U,8) ;denom field for this measure
.D S^APCM14E1(APCMRPT,APCMIC,1,APCMP,APCMRPTT,APCMTIME,F)
.;numerator?
.S APCMVALU="# visits: "_$P(APCMEP,U,1)_" # elec access: "_+$P(APCMEP,U,2)_" |||"_$P(APCMEP,U,3)_" "_$P(APCMEP,U,4)_"|||"_$S($P(APCMEP,U,2):1,1:0)
.S F=$P(^APCM14OB(APCMIC,0),U,9)
.D S^APCM14E1(APCMRPT,APCMIC,$S(APCMTE:1,1:0),APCMP,APCMRPTT,APCMTIME,F)
.;measure b - did they access in ehr report period
.I $G(APCMATTE("S1.025.H.1",APCMP))="Yes" S F=$P(^APCM14OB($O(^APCM14OB("B","S1.025.H.1",0)),0),U,11) D
..D S^APCM14E1(APCMRPT,$O(^APCM14OB("B","S1.025.H.1",0)),"Yes",APCMP,APCMRPTT,APCMTIME,F,1)
.S V="" I $T(PHR^BPHRMUPM)]"" D PHR^BPHRMUPM(DFN,APCMBDAT,DT,.V)
.;I DUZ=2793 S V="1^3130812^1^3130812^1^3130812"
.S APCMVALU="# visits: "_$P(APCMEP,U,1)_" # elec access: "_+$P(APCMEP,U,2)_" |||"_$P(APCMEP,U,3)_" "_$P(APCMEP,U,4)_" accessed PHR: "_$$DATE^APCM1UTL($P(V,U,4))_"|||"_$S($P(APCMEP,U,2):1,1:0)_"|||"_$P(V,U,3)
.;set measure B
.S Y=$O(^APCM14OB("B","S1.025.H.1",0))
.S F=$P(^APCM14OB(Y,0),U,8)
.D S^APCM14E1(APCMRPT,Y,1,APCMP,APCMRPTT,APCMTIME,F)
.S F=$P(^APCM14OB(Y,0),U,9)
.D S^APCM14E1(APCMRPT,Y,$P(V,U,3),APCMP,APCMRPTT,APCMTIME,F)
.Q:$P(APCMEP,U,1)=0
.D SETLIST^APCM14E1
.Q
Q
HASPEA(P,BD,ED,R,RPT,VSTS) ;did a ccda get transmitted for each visit? return #visits^#w/ccda
;
NEW A,B,C,D,E,X,Y,V,PWH,T,W,Z,Q,PED,EDUC
;LOOP THROUGH ALL VISITS AND COUNT VISIT AND ccda'S
S PWH="0^0"
;check 89 multiple in AUPNPAT for a YES in .02 field
S Z=0 F S Z=$O(^AUPNPAT(P,89,Z)) Q:Z'=+Z I $P($G(^AUPNPAT(P,89,Z,0)),U,2) D
.Q:$P(^AUPNPAT(P,89,Z,0),U,1)>ED ;after report period
.S $P(PWH,U,3)="PT REG HANDOUT on "_$$DATE^APCM1UTL($P(^AUPNPAT(P,89,Z,0),U,1))
;if no handout, check education for AF-PHR
I $P(PWH,U,3)="" D
.K EDUC
.S Y="EDUC("
.S Z=P_"^ALL EDUC AF-PHR;DURING "_$$FMTE^XLFDT($$DOB^AUPNPAT(P))_"-"_$$FMTE^XLFDT(ED) S E=$$START1^APCLDF(Z,Y)
.I $D(EDUC(1)) D
..S $P(PWH,U,3)="AF-PHR on "_$$DATE^APCM1UTL($P(EDUC(1),U,1))
.Q
S X=0 F S X=$O(VSTS(X)) Q:X'=+X!($P(PWH,U,2)) D
.S G=0
.S V=$P(VSTS(X),U,5)
.I '$D(^AUPNVSIT(V,0)) Q
.I $P(^AUPNVSIT(V,0),U,11) Q ;deleted
.I RPT=2 G SETD
.I "AOSM"'[$P(^AUPNVSIT(V,0),U,7) Q ;not correct service category/OFFICE VISIT
.S Y=0 F S Y=$O(^AUPNVPRV("AD",V,Y)) Q:Y'=+Y!(G) D
..I $P($G(^AUPNVPRV(Y,0)),U)'=R Q
..Q:$P(^AUPNVPRV(Y,0),U,4)'="P"
..S G=1
.Q:'G ;not a visit to this provider
.S C=$$CLINIC^APCLV(V,"C")
.Q:C=30 ;NO ER
.Q:C=77 ;NO CASE MANAGEMENT
.Q:C=76 ;no lab
.Q:C=63 ;NO RAD
.Q:C=39 ;NO PHARMACY
SETD .S $P(PWH,U,1)=$P(PWH,U,1)+1
.;RIGHT HERE CHECK DAVID'S API, if date returned was within 4 business days count it and go on to check for patient ed - IT IS HOSP USE 3 DAYS AFTER DISCHARGE
.S B=""
.I RPT=1 S D=$$GET1^DIQ(9000010,V,1109,"I")
.I RPT=2 D
..I $P(^AUPNVSIT(V,0),U,7)="H" S D=$$DDTM^APCLV(V) Q
..S D=$$ERDDT(V)
..I D="" S D=$$GET1^DIQ(9000010,V,1109,"I")
.;I DUZ=2793 S B=$$VDTM^APCLV(V) ;LORI
.I $T(AUDITHIE^BCCDUTIL)]"" S B=$$AUDITHIE^BCCDUTIL(V,D)
.;I DUZ=2793 S B=3130725.111
.I B="" Q ;doesn't fit numerator as it was never transmitted
.;now check date B against date D to see if it is 4 business days FOR RPT 1, 36 hours for rpt 2
.I RPT=1 S E=$$BD^APCM14E4(D,4) ;get date that is 4 business days from D
.I RPT=2 S E=$$FMDIFF^XLFDT(B,D,2),E=E/60,E=E/60
.I RPT=1,B>E Q ;more that 4 business days/36 HOURS
.I RPT=2,E>36 Q
.Q:$P(PWH,U,3)="" ;doesn't have other stuff so don't count in numerator
.S $P(PWH,U,4)="Visit "_$$DATE^APCM1UTL($$VD^APCLV(V))_" w/HIE Date "_$$DATE^APCM1UTL(B)
.S $P(PWH,U,2)=$P(PWH,U,2)+1
Q PWH
ERDDT(V) ;EP - get ER departure date/time
I '$G(V) Q ""
NEW X,Y
S X=$O(^AUPNVER("AD",V,0))
I 'X Q ""
Q $$GET1^DIQ(9000010.29,X,.13,"I")
APCM14E9 ;IHS/CMI/LAB - IHS MU;
+1 ;;1.0;IHS MU PERFORMANCE REPORTS;**5,6**;MAR 26, 2012;Build 65
+2 ;;;;;;Build 3
CPOE ;EP - CALCULATE EPRESCRIBING
+1 ;for each provider or for the facility count all prescriptions that meet criteria and if it is not written it meets numerator
+2 KILL ^TMP($JOB,"PATSRX")
+3 KILL APCMRXS
+4 DO TOTRX
+5 KILL ^TMP($JOB,"ORDERSPROCESSED")
+6 NEW APCMP,N,F
+7 SET (APCMD1,APCMN1)=0
+8 IF APCMRPTT=1
SET APCMP=0
FOR
SET APCMP=$ORDER(APCMPRV(APCMP))
IF APCMP'=+APCMP
QUIT
Begin DoDot:1
+9 IF $PIECE($GET(APCMRXS(APCMP)),U,1)<100
SET F=$PIECE(^APCM14OB(APCMIC,0),U,11)
Begin DoDot:2
+10 DO S^APCM14E1(APCMRPT,APCMIC,"Provider is excluded from this measure as he/she had < 100 medication orders during the EHR reporting period.",APCMP,APCMRPTT,APCMTIME,F,1)
End DoDot:2
D ;set denominator value into field
+1 ;denom field for this measure
SET F=$PIECE(^APCM14OB(APCMIC,0),U,8)
+2 ;returns # of prescriptions^# not written by nature of order
SET N=$PIECE($GET(APCMRXS(APCMP)),U,1)
+3 DO S^APCM14E1(APCMRPT,APCMIC,N,APCMP,APCMRPTT,APCMTIME,F)
+4 ;now set patient list for this provider
+5 SET P=0
FOR
SET P=$ORDER(^TMP($JOB,"PATSRX",APCMP,P))
IF P'=+P
QUIT
Begin DoDot:2
+6 SET D=$PIECE(^TMP($JOB,"PATSRX",APCMP,P),U,1)
SET N=$PIECE(^TMP($JOB,"PATSRX",APCMP,P),U,2)
SET APCMVALU="# Orders: "_D_"|||"_"# CPOE: "_N_" # NOT CPOE: "_(D-N)
+7 SET DFN=P
DO SETLIST^APCM14E1
End DoDot:2
+8 ;numerator?
+9 SET F=$PIECE(^APCM14OB(APCMIC,0),U,9)
+10 SET N=$PIECE($GET(APCMRXS(APCMP)),U,2)
+11 DO S^APCM14E1(APCMRPT,APCMIC,N,APCMP,APCMRPTT,APCMTIME,F)
End DoDot:1
+12 IF APCMRPTT=2
Begin DoDot:1
+13 SET APCMP=APCMFAC
+14 ;denom field for this measure
SET F=$PIECE(^APCM14OB(APCMIC,0),U,8)
+15 ;returns # of prescriptions^# not written by nature of order
SET N=$PIECE($GET(APCMRXS(APCMFAC)),U,1)
+16 DO S^APCM14E1(APCMRPT,APCMIC,N,APCMFAC,APCMRPTT,APCMTIME,F)
+17 ;now set patient list for this FACILITY
+18 SET P=0
FOR
SET P=$ORDER(^TMP($JOB,"PATSRX",APCMFAC,P))
IF P'=+P
QUIT
Begin DoDot:2
+19 SET D=$PIECE(^TMP($JOB,"PATSRX",APCMFAC,P),U,1)
SET N=$PIECE(^TMP($JOB,"PATSRX",APCMFAC,P),U,2)
SET APCMVALU="# Orders: "_D_"|||"_"# CPOE: "_N_" # NOT CPOE: "_(D-N)
+20 SET DFN=P
DO SETLIST^APCM14E1
End DoDot:2
+21 ;numerator?
+22 SET F=$PIECE(^APCM14OB(APCMIC,0),U,9)
+23 SET N=$PIECE($GET(APCMRXS(APCMFAC)),U,2)
+24 DO S^APCM14E1(APCMRPT,APCMIC,N,APCMFAC,APCMRPTT,APCMTIME,F)
End DoDot:1
+25 KILL ^TMP($JOB,"PATSRX")
+26 QUIT
TOTRX ;EP - did patient have a RX in file 52 with an issue date
+1 ;between BD and ED
+2 ;SET ARRAY APCMRXS to APCMRXS(prov ien)=denom^numer
+3 KILL ^TMP($JOB,"ORDERSPROCESSED")
+4 NEW ID,C,Y,X,D,S,N,A,B,R,PAT,G,ORIEN,ORPFILE,ORPTST,ORNS,PATLOC,ORACT0,ORORD,ORDEB
+5 SET ID=$$FMADD^XLFDT(APCMBDAT,-1)
SET ID=ID_".9999"
+6 FOR
SET ID=$ORDER(^OR(100,"AF",ID))
IF ID'=+ID!($PIECE(ID,".")>APCMEDAT)
QUIT
Begin DoDot:1
+7 SET ORIEN=0
FOR
SET ORIEN=$ORDER(^OR(100,"AF",ID,ORIEN))
IF ORIEN'=+ORIEN
QUIT
Begin DoDot:2
+8 IF $DATA(^TMP($JOB,"ORDERSPROCESSED",ORIEN))
QUIT
+9 SET ^TMP($JOB,"ORDERSPROCESSED",ORIEN)=""
+10 ;Quit if no object of order
SET ORPFILE=$PIECE($GET(^OR(100,ORIEN,0)),"^",2)
IF ORPFILE=""
QUIT
+11 ;only patient orders
IF $PIECE(ORPFILE,";",2)'["DPT"
QUIT
+12 ;GET Patient DFN
SET PAT=+$PIECE($GET(^OR(100,ORIEN,0)),U,2)
+13 ;Quit if demo patient
IF $$DEMO^APCLUTL(PAT,APCMDEMO)
QUIT
+14 ;190 quit if order type not standard
IF +$PIECE($GET(^OR(100,ORIEN,3)),"^",11)'=0
QUIT
+15 ;patient status (in/out)
SET ORPTST=$PIECE($GET(^OR(100,ORIEN,0)),"^",12)
+16 ;get package namespace
SET ORNS=$$NMSP($PIECE($GET(^OR(100,ORIEN,0)),"^",14))
+17 ;if not getting all types of orders then quit if order is not from pharmacy
IF ORNS'="PS"
QUIT
+18 SET ORACT0=$GET(^OR(100,ORIEN,8,1,0))
+19 IF $PIECE(ORACT0,U,1)'=ID
QUIT
+20 ;ORORD holds nature of order ien
SET ORORD=$PIECE(ORACT0,"^",12)
+21 ;skip service corrections
IF ORORD=4
QUIT
+22 SET ORPVID=$PIECE(ORACT0,"^",3)
+23 SET G=0
+24 IF APCMRPTT=1
Begin DoDot:3
+25 ;Quit if patient status is not outpatient and in EP report
IF ORPTST'="O"
QUIT
+26 ;quit if ordering provider doesn't match user selected provider
SET ORPVID=$PIECE(ORACT0,"^",3)
IF '$DATA(APCMPRV(ORPVID))
QUIT
+27 SET PATLOC=+$PIECE($GET(^OR(100,ORIEN,0)),U,10)
+28 ;IF ER IN HOSP LOC Q
SET C=""
IF PATLOC
IF $DATA(^SC(PATLOC,0))
SET C=$PIECE(^SC(PATLOC,0),U,7)
IF C
IF $PIECE($GET(^DIC(40.7,C,0)),U,2)=30
QUIT
+29 SET G=1
End DoDot:3
+30 IF APCMRPTT=2
Begin DoDot:3
+31 IF ORPTST="I"
SET G=1
QUIT
+32 IF APCMMETH="O"
QUIT
+33 SET PATLOC=+$PIECE($GET(^OR(100,ORIEN,0)),U,10)
+34 IF 'PATLOC
QUIT
+35 ;IF NOT ER IN HOSP LOC Q
SET C=""
IF PATLOC
IF $DATA(^SC(PATLOC,0))
SET C=$PIECE(^SC(PATLOC,0),U,7)
IF C
IF $PIECE($GET(^DIC(40.7,C,0)),U,2)'=30
QUIT
+36 IF PATLOC
IF $DATA(^SC(PATLOC,0))
SET C=$PIECE(^SC(PATLOC,0),U,4)
IF C
IF C'=APCMFAC
QUIT
+37 SET G=1
End DoDot:3
+38 IF 'G
QUIT
+39 ;ORORD holds nature of order ien
SET ORORD=$PIECE(ORACT0,"^",12)
+40 ;SET DENOM COUNT FOR THIS EP = INCREMENT BY 1
+41 IF APCMRPTT=1
SET $PIECE(APCMRXS(ORPVID),U,1)=$PIECE($GET(APCMRXS(ORPVID)),U,1)+1
SET $PIECE(^TMP($JOB,"PATSRX",ORPVID,PAT),U,1)=$PIECE($GET(^TMP($JOB,"PATSRX",ORPVID,PAT)),U,1)+1
+42 IF APCMRPTT=2
SET $PIECE(APCMRXS(APCMFAC),U,1)=$PIECE($GET(APCMRXS(APCMFAC)),U,1)+1
SET $PIECE(^TMP($JOB,"PATSRX",APCMFAC,PAT),U,1)=$PIECE($GET(^TMP($JOB,"PATSRX",APCMFAC,PAT)),U,1)+1
+43 ;
+44 ;now check to see if it has a nature of order IS equal to 1-written if so, quit and don't set numerator
+45 ;this is a written order so do not put in numerator
IF ORORD=1
QUIT
+46 ;this is the person who entered the order (ENTERED BY)
SET ORDEB=$PIECE(^OR(100,ORIEN,8,1,0),"^",13)
+47 ;Q:'$$ORES(ORDEB,$P(ID,".",1)) ;quit if this person does not have ORES or ORESLE on date of order so don't count in numerator
+48 ; DUZ=2793 W " NUMER"
+49 IF APCMRPTT=1
SET $PIECE(APCMRXS(ORPVID),U,2)=$PIECE(APCMRXS(ORPVID),U,2)+1
SET $PIECE(^TMP($JOB,"PATSRX",ORPVID,PAT),U,2)=$PIECE($GET(^TMP($JOB,"PATSRX",ORPVID,PAT)),U,2)+1
+50 IF APCMRPTT=2
SET $PIECE(APCMRXS(APCMFAC),U,2)=$PIECE($GET(APCMRXS(APCMFAC)),U,2)+1
SET $PIECE(^TMP($JOB,"PATSRX",APCMFAC,PAT),U,2)=$PIECE($GET(^TMP($JOB,"PATSRX",APCMFAC,PAT)),U,2)+1
End DoDot:2
End DoDot:1
+51 QUIT
NMSP(PKG) ; -- Returns package namespace from pointer
+1 NEW Y
SET Y=$$GET1^DIQ(9.4,+PKG_",",1)
+2 IF $EXTRACT(Y,1,2)="PS"
SET Y="PS"
IF Y="GMRV"
SET Y="OR"
+3 QUIT Y
+4 ;
ORES(R,D) ;EP - DID PROVIDER HAVE ORES OR ORESLE ON DATE D
+1 IF '$GET(R)
QUIT ""
+2 IF '$DATA(^VA(200,R,0))
QUIT ""
+3 NEW K,J
+4 SET K=$ORDER(^DIC(19.1,"B","ORES",0))
+5 SET J=$ORDER(^DIC(19.1,"B","ORELSE",0))
+6 IF $DATA(^VA(200,R,51,K,0))
IF $PIECE(^VA(200,R,51,K,0),U,3)'>D
QUIT 1
+7 IF $DATA(^VA(200,R,51,J,0))
IF $PIECE(^VA(200,R,51,J,0),U,3)'>D
QUIT 1
+8 QUIT ""
PEA ;EP - PATIENT ELECTRONIC ACCESS
+1 ;does visit have AF-PHR or HIE logged for that visit
+2 NEW APCMP
+3 SET (APCMD1,APCMN1)=0
+4 IF APCMRPTT=1
SET APCMP=0
FOR
SET APCMP=$ORDER(APCMPRV(APCMP))
IF APCMP'=+APCMP
QUIT
Begin DoDot:1
+5 ;no visits to this provider for this patient so don't bother, the patient is not in the denominator
IF '$DATA(APCMHVTP(APCMP))
QUIT
+6 ;numerator?
+7 ;return # of visits^# w/AF-PHR or logged in HIE log
SET APCMEP=$$HASPEA(DFN,APCMBDAT,APCMEDAT,APCMP,1,.APCMVSTS)
+8 ;set denominator value into field
+9 SET APCMTV=$PIECE(APCMEP,U)
SET APCMTE=$PIECE(APCMEP,U,2)
+10 ;denom field for this measure
SET F=$PIECE(^APCM14OB(APCMIC,0),U,8)
+11 DO S^APCM14E1(APCMRPT,APCMIC,1,APCMP,APCMRPTT,APCMTIME,F)
+12 ;numerator?
+13 SET APCMVALU="# visits: "_$PIECE(APCMEP,U,1)_" # elec access: "_+$PIECE(APCMEP,U,2)_" |||"_$PIECE(APCMEP,U,3)_" "_$PIECE(APCMEP,U,4)_"|||"_$SELECT($PIECE(APCMEP,U,2):1,1:0)
+14 SET F=$PIECE(^APCM14OB(APCMIC,0),U,9)
+15 DO S^APCM14E1(APCMRPT,APCMIC,$SELECT(APCMTE:1,1:0),APCMP,APCMRPTT,APCMTIME,F)
+16 ;measure b - did they access in ehr report period
+17 IF $GET(APCMATTE("S1.020.EP.1",APCMP))="Yes"
SET F=$PIECE(^APCM14OB($ORDER(^APCM14OB("B","S1.020.EP.1",0)),0),U,11)
Begin DoDot:2
+18 DO S^APCM14E1(APCMRPT,$ORDER(^APCM14OB("B","S1.020.EP.1",0)),"Yes",APCMP,APCMRPTT,APCMTIME,F,1)
End DoDot:2
+19 SET V=""
IF $TEXT(PHR^BPHRMUPM)]""
DO PHR^BPHRMUPM(DFN,APCMBDAT,DT,.V)
+20 ;I DUZ=2793 S V="1^3130812^1^3130812^1^3130812"
+21 SET APCMVALU="# visits: "_$PIECE(APCMEP,U,1)_" # elec access: "_+$PIECE(APCMEP,U,2)_" |||"_$PIECE(APCMEP,U,3)_" "_$PIECE(APCMEP,U,4)_" accessed PHR: "_$$DATE^APCM1UTL($PIECE(V,U,4))_"|||"_$SELECT($PIECE(APCMEP,U,2):1,1:0)_"|||"_$PIE
CE(V,U,3)
+22 ;set measure B
+23 SET Y=$ORDER(^APCM14OB("B","S1.020.EP.1",0))
+24 SET F=$PIECE(^APCM14OB(Y,0),U,8)
+25 DO S^APCM14E1(APCMRPT,Y,1,APCMP,APCMRPTT,APCMTIME,F)
+26 SET F=$PIECE(^APCM14OB(Y,0),U,9)
+27 DO S^APCM14E1(APCMRPT,Y,$PIECE(V,U,3),APCMP,APCMRPTT,APCMTIME,F)
+28 IF $PIECE(APCMEP,U,1)=0
QUIT
+29 DO SETLIST^APCM14E1
End DoDot:1
+30 IF APCMRPTT=2
Begin DoDot:1
+31 SET APCMP=APCMFAC
+32 ;GET ARRAY OF DISCHARGES/ER VISITS
+33 NEW APCMHERL,CNT,APCMHER
+34 KILL APCMHER
+35 SET CNT=0
+36 SET X=0
FOR
SET X=$ORDER(^AUPNVINP("AC",DFN,X))
IF X'=+X
QUIT
Begin DoDot:2
+37 IF '$DATA(^AUPNVINP(X,0))
QUIT
+38 SET D=$PIECE($PIECE(^AUPNVINP(X,0),U,1),".")
+39 IF D<APCMBDAT
QUIT
+40 IF D>APCMEDAT
QUIT
+41 IF $$LOCENC^APCLV($PIECE(^AUPNVINP(X,0),U,3))'=APCMFAC
QUIT
+42 ;don't count Events
IF $$SC^APCLV($PIECE(^AUPNVINP(X,0),U,3))'="H"
QUIT
+43 SET CNT=CNT+1
+44 ;visit array
SET $PIECE(APCMHER(CNT),U,5)=$PIECE(^AUPNVINP(X,0),U,3)
End DoDot:2
+45 ;IF ED METHOD ;NOW GET ALL ER VISITS
+46 IF APCMMETH="E"
Begin DoDot:2
+47 SET X=0
FOR
SET X=$ORDER(APCMVSTS(X))
IF X'=+X
QUIT
Begin DoDot:3
+48 SET V=$PIECE(APCMVSTS(X),U,5)
+49 IF $$CLINIC^APCLV(V,"C")'=30
QUIT
+50 IF $$LOCENC^APCLV(V)'=APCMFAC
QUIT
+51 IF $$SC^APCLV(V)'="A"
QUIT
+52 SET CNT=CNT+1
+53 SET $PIECE(APCMHER(CNT),U,5)=V
End DoDot:3
End DoDot:2
+54 IF APCMMETH="O"
Begin DoDot:2
+55 SET X=0
FOR
SET X=$ORDER(APCMVSTS(X))
IF X'=+X
QUIT
Begin DoDot:3
+56 SET V=$PIECE(APCMVSTS(X),U,5)
+57 IF $$SC^APCLV(V)'="O"
QUIT
+58 SET CNT=CNT+1
+59 SET $PIECE(APCMHER(CNT),U,5)=V
End DoDot:3
End DoDot:2
+60 ;no visits
IF '$DATA(APCMHER)
QUIT
+61 ;return # of visits^# w/AF-PHR or logged in HIE log
SET APCMEP=$$HASPEA(DFN,APCMBDAT,APCMEDAT,APCMP,2,.APCMHER)
+62 ;set denominator value into field
+63 SET APCMTV=$PIECE(APCMEP,U)
SET APCMTE=$PIECE(APCMEP,U,2)
+64 ;denom field for this measure
SET F=$PIECE(^APCM14OB(APCMIC,0),U,8)
+65 DO S^APCM14E1(APCMRPT,APCMIC,1,APCMP,APCMRPTT,APCMTIME,F)
+66 ;numerator?
+67 SET APCMVALU="# visits: "_$PIECE(APCMEP,U,1)_" # elec access: "_+$PIECE(APCMEP,U,2)_" |||"_$PIECE(APCMEP,U,3)_" "_$PIECE(APCMEP,U,4)_"|||"_$SELECT($PIECE(APCMEP,U,2):1,1:0)
+68 SET F=$PIECE(^APCM14OB(APCMIC,0),U,9)
+69 DO S^APCM14E1(APCMRPT,APCMIC,$SELECT(APCMTE:1,1:0),APCMP,APCMRPTT,APCMTIME,F)
+70 ;measure b - did they access in ehr report period
+71 IF $GET(APCMATTE("S1.025.H.1",APCMP))="Yes"
SET F=$PIECE(^APCM14OB($ORDER(^APCM14OB("B","S1.025.H.1",0)),0),U,11)
Begin DoDot:2
+72 DO S^APCM14E1(APCMRPT,$ORDER(^APCM14OB("B","S1.025.H.1",0)),"Yes",APCMP,APCMRPTT,APCMTIME,F,1)
End DoDot:2
+73 SET V=""
IF $TEXT(PHR^BPHRMUPM)]""
DO PHR^BPHRMUPM(DFN,APCMBDAT,DT,.V)
+74 ;I DUZ=2793 S V="1^3130812^1^3130812^1^3130812"
+75 SET APCMVALU="# visits: "_$PIECE(APCMEP,U,1)_" # elec access: "_+$PIECE(APCMEP,U,2)_" |||"_$PIECE(APCMEP,U,3)_" "_$PIECE(APCMEP,U,4)_" accessed PHR: "_$$DATE^APCM1UTL($PIECE(V,U,4))_"|||"_$SELECT($PIECE(APCMEP,U,2):1,1:0)_"|||"_$PIECE(V
,U,3)
+76 ;set measure B
+77 SET Y=$ORDER(^APCM14OB("B","S1.025.H.1",0))
+78 SET F=$PIECE(^APCM14OB(Y,0),U,8)
+79 DO S^APCM14E1(APCMRPT,Y,1,APCMP,APCMRPTT,APCMTIME,F)
+80 SET F=$PIECE(^APCM14OB(Y,0),U,9)
+81 DO S^APCM14E1(APCMRPT,Y,$PIECE(V,U,3),APCMP,APCMRPTT,APCMTIME,F)
+82 IF $PIECE(APCMEP,U,1)=0
QUIT
+83 DO SETLIST^APCM14E1
+84 QUIT
End DoDot:1
+85 QUIT
HASPEA(P,BD,ED,R,RPT,VSTS) ;did a ccda get transmitted for each visit? return #visits^#w/ccda
+1 ;
+2 NEW A,B,C,D,E,X,Y,V,PWH,T,W,Z,Q,PED,EDUC
+3 ;LOOP THROUGH ALL VISITS AND COUNT VISIT AND ccda'S
+4 SET PWH="0^0"
+5 ;check 89 multiple in AUPNPAT for a YES in .02 field
+6 SET Z=0
FOR
SET Z=$ORDER(^AUPNPAT(P,89,Z))
IF Z'=+Z
QUIT
IF $PIECE($GET(^AUPNPAT(P,89,Z,0)),U,2)
Begin DoDot:1
+7 ;after report period
IF $PIECE(^AUPNPAT(P,89,Z,0),U,1)>ED
QUIT
+8 SET $PIECE(PWH,U,3)="PT REG HANDOUT on "_$$DATE^APCM1UTL($PIECE(^AUPNPAT(P,89,Z,0),U,1))
End DoDot:1
+9 ;if no handout, check education for AF-PHR
+10 IF $PIECE(PWH,U,3)=""
Begin DoDot:1
+11 KILL EDUC
+12 SET Y="EDUC("
+13 SET Z=P_"^ALL EDUC AF-PHR;DURING "_$$FMTE^XLFDT($$DOB^AUPNPAT(P))_"-"_$$FMTE^XLFDT(ED)
SET E=$$START1^APCLDF(Z,Y)
+14 IF $DATA(EDUC(1))
Begin DoDot:2
+15 SET $PIECE(PWH,U,3)="AF-PHR on "_$$DATE^APCM1UTL($PIECE(EDUC(1),U,1))
End DoDot:2
+16 QUIT
End DoDot:1
+17 SET X=0
FOR
SET X=$ORDER(VSTS(X))
IF X'=+X!($PIECE(PWH,U,2))
QUIT
Begin DoDot:1
+18 SET G=0
+19 SET V=$PIECE(VSTS(X),U,5)
+20 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+21 ;deleted
IF $PIECE(^AUPNVSIT(V,0),U,11)
QUIT
+22 IF RPT=2
GOTO SETD
+23 ;not correct service category/OFFICE VISIT
IF "AOSM"'[$PIECE(^AUPNVSIT(V,0),U,7)
QUIT
+24 SET Y=0
FOR
SET Y=$ORDER(^AUPNVPRV("AD",V,Y))
IF Y'=+Y!(G)
QUIT
Begin DoDot:2
+25 IF $PIECE($GET(^AUPNVPRV(Y,0)),U)'=R
QUIT
+26 IF $PIECE(^AUPNVPRV(Y,0),U,4)'="P"
QUIT
+27 SET G=1
End DoDot:2
+28 ;not a visit to this provider
IF 'G
QUIT
+29 SET C=$$CLINIC^APCLV(V,"C")
+30 ;NO ER
IF C=30
QUIT
+31 ;NO CASE MANAGEMENT
IF C=77
QUIT
+32 ;no lab
IF C=76
QUIT
+33 ;NO RAD
IF C=63
QUIT
+34 ;NO PHARMACY
IF C=39
QUIT
SETD SET $PIECE(PWH,U,1)=$PIECE(PWH,U,1)+1
+1 ;RIGHT HERE CHECK DAVID'S API, if date returned was within 4 business days count it and go on to check for patient ed - IT IS HOSP USE 3 DAYS AFTER DISCHARGE
+2 SET B=""
+3 IF RPT=1
SET D=$$GET1^DIQ(9000010,V,1109,"I")
+4 IF RPT=2
Begin DoDot:2
+5 IF $PIECE(^AUPNVSIT(V,0),U,7)="H"
SET D=$$DDTM^APCLV(V)
QUIT
+6 SET D=$$ERDDT(V)
+7 IF D=""
SET D=$$GET1^DIQ(9000010,V,1109,"I")
End DoDot:2
+8 ;I DUZ=2793 S B=$$VDTM^APCLV(V) ;LORI
+9 IF $TEXT(AUDITHIE^BCCDUTIL)]""
SET B=$$AUDITHIE^BCCDUTIL(V,D)
+10 ;I DUZ=2793 S B=3130725.111
+11 ;doesn't fit numerator as it was never transmitted
IF B=""
QUIT
+12 ;now check date B against date D to see if it is 4 business days FOR RPT 1, 36 hours for rpt 2
+13 ;get date that is 4 business days from D
IF RPT=1
SET E=$$BD^APCM14E4(D,4)
+14 IF RPT=2
SET E=$$FMDIFF^XLFDT(B,D,2)
SET E=E/60
SET E=E/60
+15 ;more that 4 business days/36 HOURS
IF RPT=1
IF B>E
QUIT
+16 IF RPT=2
IF E>36
QUIT
+17 ;doesn't have other stuff so don't count in numerator
IF $PIECE(PWH,U,3)=""
QUIT
+18 SET $PIECE(PWH,U,4)="Visit "_$$DATE^APCM1UTL($$VD^APCLV(V))_" w/HIE Date "_$$DATE^APCM1UTL(B)
+19 SET $PIECE(PWH,U,2)=$PIECE(PWH,U,2)+1
End DoDot:1
+20 QUIT PWH
ERDDT(V) ;EP - get ER departure date/time
+1 IF '$GET(V)
QUIT ""
+2 NEW X,Y
+3 SET X=$ORDER(^AUPNVER("AD",V,0))
+4 IF 'X
QUIT ""
+5 QUIT $$GET1^DIQ(9000010.29,X,.13,"I")
