APCM14E6 ;IHS/CMI/LAB - IHS MU;
;;1.0;IHS MU PERFORMANCE REPORTS;**5,6**;MAR 26, 2012;Build 65
;;;;;;Build 3
ADV ;EP - CALCULATE adv directives
NEW APCMP,APCMZ
S (APCMD1,APCMN1)=0
I APCMRPTT=2 D
.S APCMP=APCMFAC
.I $D(APCMHO65(APCMP,APCMTIME)) S F=$P(^APCM14OB(APCMIC,0),U,11) D Q
..D S^APCM14E1(APCMRPT,APCMIC,"Hospital is excluded from this measure as it did not admit anyone >=65 during the EHR Reporting Period.",APCMP,APCMRPTT,APCMTIME,F,1) Q
.S APCMZ=$$HASADM65(DFN,APCMP,.APCMVSTS)
.Q:APCMZ="" ;NO ADMISSION
.D ADV1
.Q
Q
HASADM65(P,R,VSTS) ;
NEW X,Y,Z,V,G
S G=""
S X=0 F S X=$O(VSTS(X)) Q:X'=+X!(G) D
.S V=$P(VSTS(X),U,5)
.I '$D(^AUPNVSIT(V,0)) Q
.I $P(^AUPNVSIT(V,0),U,11) Q
.I $P(^AUPNVSIT(V,0),U,7)'="H" Q ;not correct service category
.Q:$P(^AUPNVSIT(V,0),U,6)'=APCMP ;not this facility
.Q:$$AGE^AUPNPAT(P,$$VD^APCLV(V))<65 ;not 65 on date of admission
.S G=$$VD^APCLV(V)
Q G
ADV1 ;
;set denominator value into field
S F=$P(^APCM14OB(APCMIC,0),U,8) ;denom field for this measure
D S^APCM14E1(APCMRPT,APCMIC,1,APCMP,APCMRPTT,APCMTIME,F)
S APCMVALU="Admission: "_$$DATE^APCM1UTL(APCMZ)_" Age: "_$$AGE^AUPNPAT(DFN,APCMZ)
;numerator?
S APCMEP=$$HASADV(DFN,APCMEDAT)
S APCMVALU=APCMVALU_"|||"_$P(APCMEP,U,2)_"|||"_$P(APCMEP,U,1)
S F=$P(^APCM14OB(APCMIC,0),U,9)
D S^APCM14E1(APCMRPT,APCMIC,$P(APCMEP,U,1),APCMP,APCMRPTT,APCMTIME,F)
D SETLIST^APCM14E1
Q
HASADV(P,ED) ;does patient have an ADVANCE DIRECTIVE before end of report period
;
NEW A,B,C,D,E,X
;check advance directive file
S E=""
S X=0 F S X=$O(^AUPNADVD(P,11,X)) Q:X'=+X!(E) D
.Q:'$D(^AUPNADVD(P,11,X,0)) ;no zero node?
.S D=$P(^AUPNADVD(P,11,X,0),U,1)
.I D>ED Q ;after report period
.S B=$P(^AUPNADVD(P,11,X,0),U,2)
.Q:B=""
.S E=1_U_"Advance Directives: "_$S(B="Y":"YES",1:"NO")_" entered on "_$$DATE^APCM1UTL(D) Q
I E]"" Q E
;now check for TIU Note title before ED of A
S X=0 F S X=$O(^AUPNVNOT("AC",P,X)) Q:X'=+X!(E) D
.S B=$$VAL^XBDIQ1(9000010.28,X,.01)
.Q:$$UP^XLFSTR(B)'="ADVANCE DIRECTIVE"
.S D=$$VD^APCLV($P(^AUPNVNOT(X,0),U,3))
.Q:D>ED
.S E=1_U_"Advance Directives: TIU document entered on "_$$DATE^APCM1UTL(D) Q
Q E
MR ;EP - med reconciliation
;for each provider or for the facility find out if this
;patient had a er visit or an admission of transferred
;if so, then check to see if they have m-mr anytime before end of report period
NEW APCMP
S (APCMD1,APCMN1)=0
I APCMRPTT=2 S APCMP=APCMFAC D
.Q:'$D(APCMHVTP(APCMP)) ;no ADMISSIONS/ER TO THIS FACILITY SO SKIP THIS OBJ
.S APCMEP=$$HASMMR(DFN,APCMBDAT,APCMEDAT,APCMP,.APCMVSTS,APCMMETH) ;return # of visits^# w/M-MR
.;set denominator value into field
.S F=$P(^APCM14OB(APCMIC,0),U,8) ;denom field for this measure
.D S^APCM14E1(APCMRPT,APCMIC,$P(APCMEP,U,1),APCMP,APCMRPTT,APCMTIME,F)
.;numerator?
.S APCMVALU="# of visits: "_$P(APCMEP,U,1)_" - # w/ M-MR: "_+$P(APCMEP,U,2)_"|||"_$P(APCMEP,U,3)_"|||"_$S($P(APCMEP,U,1)=$P(APCMEP,U,2):1,1:0)
.S F=$P(^APCM14OB(APCMIC,0),U,9)
.D S^APCM14E1(APCMRPT,APCMIC,$P(APCMEP,U,2),APCMP,APCMRPTT,APCMTIME,F)
.Q:$P(APCMEP,U,1)=0
.D SETLIST^APCM14E1
Q
HOSER(Z,R) ;EP
I $P(^AUPNVSIT(Z,0),U,6)'=R Q 0 ;not correct facility
I $P(^AUPNVSIT(Z,0),U,7)="H" Q 1
NEW C
I "A"'[$P(^AUPNVSIT(Z,0),U,7) Q 0
S C=$$CLINIC^APCLV(Z,"C")
I C=30 Q 1
;I C=80 Q 1
Q 0
DSCHDATE(V) ;EP
I 'V Q ""
I '$D(^AUPNVSIT(V)) Q ""
NEW Y,Z,D
S D=""
I $P(^AUPNVSIT(V,0),U,7)="H" D Q D
.S Z=$O(^AUPNVINP("AD",V,0))
.I 'Z S D=$$VD^APCLV(V) Q
.S Y=$P($P(^AUPNVINP(Z,0),U),".")
.S D=Y
S Z=$O(^AUPNVER("AD",V,0))
I 'Z Q $$VD^APCLV(V)
I '$D(^AUPNVER(Z,0)) Q $$VD^APCLV(V)
S Y=$P($P(^AUPNVER(Z,0),U,13),".")
I Y="" Q $$VD^APCLV(V)
Q $P(Y,".")
HASMMR(P,BD,ED,R,VSTS,APCMMETH) ;does patient have a M-MR on each visit?
;
NEW A,B,C,D,E,X,Y,V,PWH,T,W,Z,Q,EDUC
;LOOP THROUGH ALL VISITS AND COUNT VISIT AND M-MR'S
S PWH="0^0"
S X=0 F S X=$O(VSTS(X)) Q:X'=+X 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
.Q:$P(^AUPNVSIT(V,0),U,6)'=R
.I APCMMETH="E" D Q:'G
..I '$$HOSER(V,R) Q ;not correct service category/ER VISIT
..S G=1
.I APCMMETH="O" Q:"OH"'[$P(^AUPNVSIT(V,0),U,7)
.I $P(^AUPNVSIT(V,0),U,7)="H"!($P(^AUPNVSIT(V,0),U,7)="O") Q:'$$TRANS(V)
.I $$CLINIC^APCLV(V,"C")=30 Q:'$$ERTRANS(V)
.S $P(PWH,U,1)=$P(PWH,U,1)+1
.;V UPDATED REVIEWED SNOMED DURING REPORT PERIOD
.S Z="",B=""
.S W=0 F S W=$O(^AUPNVRUP("AC",P,W)) Q:W'=+W!(Z) D
..S Y=0 F S Y=$O(^AUPNVRUP(W,26,Y)) Q:Y'=+Y!(Z) D
...I $P($G(^AUPNVRUP(W,26,Y,0)),U,1)'=428191000124101 Q
...;getevent date/time (1201)
...S E=""
...S D=$P($$GET1^DIQ(9000010.54,W,1201,"I"),".")
...I D<BD Q
...I D>ED Q
SN ...S Z=1
...S B=1 S $P(PWH,U,2)=$P(PWH,U,2)+1
.S $P(PWH,U,3)=$P(PWH,U,3)_$$DATE^APCM1UTL($$VD^APCLV(V))_":"_$S(B:"M-MR",1:"NO M-MR")_";"
.Q
Q PWH
TRANS(%) ;
NEW A
S A=$$ADMTYPE^APCLV(%,"C")
I A="" S A=$O(^DGPM("AVISIT",%,0)) I A S A=$$GET1^DIQ(405,A,.04,"I") I A S A=$$GET1^DIQ(405.1,A,9999999.1)
I A=2 Q 1
I A=3 Q 1
I A=4 Q 1
Q 0
;
ERTRANS(%) ;
NEW E
S E=$O(^AMERVSIT("AD",%,0))
I 'E Q 0 ;no visit in ER Visit
I '$P($G(^AMERVSIT(E,17)),U,1) Q 0
Q 1
TRANSOUT(%) ;
NEW A
S A=$$DSCHTYPE^APCLV(%,"C")
I A=2 Q 1
Q 0
;
ERTRANSO(%) ;
NEW E,J
S E=$O(^AMERVSIT("AD",%,0))
I 'E Q 0 ;no visit in ER Visit
S J=$$VAL^XBDIQ1(9009080,E,6.1)
I J="REFERRED TO ANOTHER SERVICE" Q 1
I J="TRANSFER TO ANOTHER FACILITY" Q 1
Q 0
APCM14E6 ;IHS/CMI/LAB - IHS MU;
+1 ;;1.0;IHS MU PERFORMANCE REPORTS;**5,6**;MAR 26, 2012;Build 65
+2 ;;;;;;Build 3
ADV ;EP - CALCULATE adv directives
+1 NEW APCMP,APCMZ
+2 SET (APCMD1,APCMN1)=0
+3 IF APCMRPTT=2
Begin DoDot:1
+4 SET APCMP=APCMFAC
+5 IF $DATA(APCMHO65(APCMP,APCMTIME))
SET F=$PIECE(^APCM14OB(APCMIC,0),U,11)
Begin DoDot:2
+6 DO S^APCM14E1(APCMRPT,APCMIC,"Hospital is excluded from this measure as it did not admit anyone >=65 during the EHR Reporting Period.",APCMP,APCMRPTT,APCMTIME,F,1)
QUIT
End DoDot:2
QUIT
+7 SET APCMZ=$$HASADM65(DFN,APCMP,.APCMVSTS)
+8 ;NO ADMISSION
IF APCMZ=""
QUIT
+9 DO ADV1
+10 QUIT
End DoDot:1
+11 QUIT
HASADM65(P,R,VSTS) ;
+1 NEW X,Y,Z,V,G
+2 SET G=""
+3 SET X=0
FOR
SET X=$ORDER(VSTS(X))
IF X'=+X!(G)
QUIT
Begin DoDot:1
+4 SET V=$PIECE(VSTS(X),U,5)
+5 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+6 IF $PIECE(^AUPNVSIT(V,0),U,11)
QUIT
+7 ;not correct service category
IF $PIECE(^AUPNVSIT(V,0),U,7)'="H"
QUIT
+8 ;not this facility
IF $PIECE(^AUPNVSIT(V,0),U,6)'=APCMP
QUIT
+9 ;not 65 on date of admission
IF $$AGE^AUPNPAT(P,$$VD^APCLV(V))<65
QUIT
+10 SET G=$$VD^APCLV(V)
End DoDot:1
+11 QUIT G
ADV1 ;
+1 ;set denominator value into field
+2 ;denom field for this measure
SET F=$PIECE(^APCM14OB(APCMIC,0),U,8)
+3 DO S^APCM14E1(APCMRPT,APCMIC,1,APCMP,APCMRPTT,APCMTIME,F)
+4 SET APCMVALU="Admission: "_$$DATE^APCM1UTL(APCMZ)_" Age: "_$$AGE^AUPNPAT(DFN,APCMZ)
+5 ;numerator?
+6 SET APCMEP=$$HASADV(DFN,APCMEDAT)
+7 SET APCMVALU=APCMVALU_"|||"_$PIECE(APCMEP,U,2)_"|||"_$PIECE(APCMEP,U,1)
+8 SET F=$PIECE(^APCM14OB(APCMIC,0),U,9)
+9 DO S^APCM14E1(APCMRPT,APCMIC,$PIECE(APCMEP,U,1),APCMP,APCMRPTT,APCMTIME,F)
+10 DO SETLIST^APCM14E1
+11 QUIT
HASADV(P,ED) ;does patient have an ADVANCE DIRECTIVE before end of report period
+1 ;
+2 NEW A,B,C,D,E,X
+3 ;check advance directive file
+4 SET E=""
+5 SET X=0
FOR
SET X=$ORDER(^AUPNADVD(P,11,X))
IF X'=+X!(E)
QUIT
Begin DoDot:1
+6 ;no zero node?
IF '$DATA(^AUPNADVD(P,11,X,0))
QUIT
+7 SET D=$PIECE(^AUPNADVD(P,11,X,0),U,1)
+8 ;after report period
IF D>ED
QUIT
+9 SET B=$PIECE(^AUPNADVD(P,11,X,0),U,2)
+10 IF B=""
QUIT
+11 SET E=1_U_"Advance Directives: "_$SELECT(B="Y":"YES",1:"NO")_" entered on "_$$DATE^APCM1UTL(D)
QUIT
End DoDot:1
+12 IF E]""
QUIT E
+13 ;now check for TIU Note title before ED of A
+14 SET X=0
FOR
SET X=$ORDER(^AUPNVNOT("AC",P,X))
IF X'=+X!(E)
QUIT
Begin DoDot:1
+15 SET B=$$VAL^XBDIQ1(9000010.28,X,.01)
+16 IF $$UP^XLFSTR(B)'="ADVANCE DIRECTIVE"
QUIT
+17 SET D=$$VD^APCLV($PIECE(^AUPNVNOT(X,0),U,3))
+18 IF D>ED
QUIT
+19 SET E=1_U_"Advance Directives: TIU document entered on "_$$DATE^APCM1UTL(D)
QUIT
End DoDot:1
+20 QUIT E
MR ;EP - med reconciliation
+1 ;for each provider or for the facility find out if this
+2 ;patient had a er visit or an admission of transferred
+3 ;if so, then check to see if they have m-mr anytime before end of report period
+4 NEW APCMP
+5 SET (APCMD1,APCMN1)=0
+6 IF APCMRPTT=2
SET APCMP=APCMFAC
Begin DoDot:1
+7 ;no ADMISSIONS/ER TO THIS FACILITY SO SKIP THIS OBJ
IF '$DATA(APCMHVTP(APCMP))
QUIT
+8 ;return # of visits^# w/M-MR
SET APCMEP=$$HASMMR(DFN,APCMBDAT,APCMEDAT,APCMP,.APCMVSTS,APCMMETH)
+9 ;set denominator value into field
+10 ;denom field for this measure
SET F=$PIECE(^APCM14OB(APCMIC,0),U,8)
+11 DO S^APCM14E1(APCMRPT,APCMIC,$PIECE(APCMEP,U,1),APCMP,APCMRPTT,APCMTIME,F)
+12 ;numerator?
+13 SET APCMVALU="# of visits: "_$PIECE(APCMEP,U,1)_" - # w/ M-MR: "_+$PIECE(APCMEP,U,2)_"|||"_$PIECE(APCMEP,U,3)_"|||"_$SELECT($PIECE(APCMEP,U,1)=$PIECE(APCMEP,U,2):1,1:0)
+14 SET F=$PIECE(^APCM14OB(APCMIC,0),U,9)
+15 DO S^APCM14E1(APCMRPT,APCMIC,$PIECE(APCMEP,U,2),APCMP,APCMRPTT,APCMTIME,F)
+16 IF $PIECE(APCMEP,U,1)=0
QUIT
+17 DO SETLIST^APCM14E1
End DoDot:1
+18 QUIT
HOSER(Z,R) ;EP
+1 ;not correct facility
IF $PIECE(^AUPNVSIT(Z,0),U,6)'=R
QUIT 0
+2 IF $PIECE(^AUPNVSIT(Z,0),U,7)="H"
QUIT 1
+3 NEW C
+4 IF "A"'[$PIECE(^AUPNVSIT(Z,0),U,7)
QUIT 0
+5 SET C=$$CLINIC^APCLV(Z,"C")
+6 IF C=30
QUIT 1
+7 ;I C=80 Q 1
+8 QUIT 0
DSCHDATE(V) ;EP
+1 IF 'V
QUIT ""
+2 IF '$DATA(^AUPNVSIT(V))
QUIT ""
+3 NEW Y,Z,D
+4 SET D=""
+5 IF $PIECE(^AUPNVSIT(V,0),U,7)="H"
Begin DoDot:1
+6 SET Z=$ORDER(^AUPNVINP("AD",V,0))
+7 IF 'Z
SET D=$$VD^APCLV(V)
QUIT
+8 SET Y=$PIECE($PIECE(^AUPNVINP(Z,0),U),".")
+9 SET D=Y
End DoDot:1
QUIT D
+10 SET Z=$ORDER(^AUPNVER("AD",V,0))
+11 IF 'Z
QUIT $$VD^APCLV(V)
+12 IF '$DATA(^AUPNVER(Z,0))
QUIT $$VD^APCLV(V)
+13 SET Y=$PIECE($PIECE(^AUPNVER(Z,0),U,13),".")
+14 IF Y=""
QUIT $$VD^APCLV(V)
+15 QUIT $PIECE(Y,".")
HASMMR(P,BD,ED,R,VSTS,APCMMETH) ;does patient have a M-MR on each visit?
+1 ;
+2 NEW A,B,C,D,E,X,Y,V,PWH,T,W,Z,Q,EDUC
+3 ;LOOP THROUGH ALL VISITS AND COUNT VISIT AND M-MR'S
+4 SET PWH="0^0"
+5 SET X=0
FOR
SET X=$ORDER(VSTS(X))
IF X'=+X
QUIT
Begin DoDot:1
+6 SET G=0
+7 SET V=$PIECE(VSTS(X),U,5)
+8 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+9 ;deleted
IF $PIECE(^AUPNVSIT(V,0),U,11)
QUIT
+10 IF $PIECE(^AUPNVSIT(V,0),U,6)'=R
QUIT
+11 IF APCMMETH="E"
Begin DoDot:2
+12 ;not correct service category/ER VISIT
IF '$$HOSER(V,R)
QUIT
+13 SET G=1
End DoDot:2
IF 'G
QUIT
+14 IF APCMMETH="O"
IF "OH"'[$PIECE(^AUPNVSIT(V,0),U,7)
QUIT
+15 IF $PIECE(^AUPNVSIT(V,0),U,7)="H"!($PIECE(^AUPNVSIT(V,0),U,7)="O")
IF '$$TRANS(V)
QUIT
+16 IF $$CLINIC^APCLV(V,"C")=30
IF '$$ERTRANS(V)
QUIT
+17 SET $PIECE(PWH,U,1)=$PIECE(PWH,U,1)+1
+18 ;V UPDATED REVIEWED SNOMED DURING REPORT PERIOD
+19 SET Z=""
SET B=""
+20 SET W=0
FOR
SET W=$ORDER(^AUPNVRUP("AC",P,W))
IF W'=+W!(Z)
QUIT
Begin DoDot:2
+21 SET Y=0
FOR
SET Y=$ORDER(^AUPNVRUP(W,26,Y))
IF Y'=+Y!(Z)
QUIT
Begin DoDot:3
+22 IF $PIECE($GET(^AUPNVRUP(W,26,Y,0)),U,1)'=428191000124101
QUIT
+23 ;getevent date/time (1201)
+24 SET E=""
+25 SET D=$PIECE($$GET1^DIQ(9000010.54,W,1201,"I"),".")
+26 IF D<BD
QUIT
+27 IF D>ED
QUIT
SN SET Z=1
+1 SET B=1
SET $PIECE(PWH,U,2)=$PIECE(PWH,U,2)+1
End DoDot:3
End DoDot:2
+2 SET $PIECE(PWH,U,3)=$PIECE(PWH,U,3)_$$DATE^APCM1UTL($$VD^APCLV(V))_":"_$SELECT(B:"M-MR",1:"NO M-MR")_";"
+3 QUIT
End DoDot:1
+4 QUIT PWH
TRANS(%) ;
+1 NEW A
+2 SET A=$$ADMTYPE^APCLV(%,"C")
+3 IF A=""
SET A=$ORDER(^DGPM("AVISIT",%,0))
IF A
SET A=$$GET1^DIQ(405,A,.04,"I")
IF A
SET A=$$GET1^DIQ(405.1,A,9999999.1)
+4 IF A=2
QUIT 1
+5 IF A=3
QUIT 1
+6 IF A=4
QUIT 1
+7 QUIT 0
+8 ;
ERTRANS(%) ;
+1 NEW E
+2 SET E=$ORDER(^AMERVSIT("AD",%,0))
+3 ;no visit in ER Visit
IF 'E
QUIT 0
+4 IF '$PIECE($GET(^AMERVSIT(E,17)),U,1)
QUIT 0
+5 QUIT 1
TRANSOUT(%) ;
+1 NEW A
+2 SET A=$$DSCHTYPE^APCLV(%,"C")
+3 IF A=2
QUIT 1
+4 QUIT 0
+5 ;
ERTRANSO(%) ;
+1 NEW E,J
+2 SET E=$ORDER(^AMERVSIT("AD",%,0))
+3 ;no visit in ER Visit
IF 'E
QUIT 0
+4 SET J=$$VAL^XBDIQ1(9009080,E,6.1)
+5 IF J="REFERRED TO ANOTHER SERVICE"
QUIT 1
+6 IF J="TRANSFER TO ANOTHER FACILITY"
QUIT 1
+7 QUIT 0
