APCM13E6.m

APCM13E6 ;IHS/CMI/LAB - IHS MU; 

 ;;1.0;IHS MU PERFORMANCE REPORTS;**2,4,5**;MAR 26, 2012;Build 5

 ;;;;;;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(^APCM13OB(APCMIC,0),U,11) D  Q

 ..D S^APCM13E1(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(^APCM13OB(APCMIC,0),U,8)  ;denom field for this measure

 D S^APCM13E1(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(^APCM13OB(APCMIC,0),U,9)

 D S^APCM13E1(APCMRPT,APCMIC,$P(APCMEP,U,1),APCMP,APCMRPTT,APCMTIME,F)

 D SETLIST^APCM13E1

 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)  ;return # of visits^# w/M-MR

 .;set denominator value into field

 .S F=$P(^APCM13OB(APCMIC,0),U,8)  ;denom field for this measure

 .D S^APCM13E1(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(^APCM13OB(APCMIC,0),U,9)

 .D S^APCM13E1(APCMRPT,APCMIC,$P(APCMEP,U,2),APCMP,APCMRPTT,APCMTIME,F)

 .Q:$P(APCMEP,U,1)=0

 .D SETLIST^APCM13E1

 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) ;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

 .I '$$HOSER(V,R) Q  ;not correct service category/ER VISIT

 .I $P(^AUPNVSIT(V,0),U,7)="H" Q:'$$TRANS(V)

 .I $$CLINIC^APCLV(V,"C")=30 Q:'$$ERTRANS(V)

 .S $P(PWH,U,1)=$P(PWH,U,1)+1

 .;was there a PAT ED M-MR on the date of the visit through 1 day after the visit

 .S Y="EDUC("

 .S Z=P_"^ALL EDUC;DURING "_$$FMTE^XLFDT($$VD^APCLV(V))_"-"_$$FMTE^XLFDT($$VD^APCLV(V),1) S E=$$START1^APCLDF(Z,Y)

 .I '$D(EDUC(1)) S $P(PWH,U,3)=$P(PWH,U,3)_$$DATE^APCM1UTL($$VD^APCLV(V))_":NO M-MR" Q

 .S (Z,B,D)=0,%="",T="" F  S Z=$O(EDUC(Z)) Q:Z'=+Z!(B)  D

 ..S A=$P(^AUPNVPED(+$P(EDUC(Z),U,4),0),U)

 ..Q:'A

 ..Q:'$D(^AUTTEDT(A,0))

 ..S T=$P(^AUTTEDT(A,0),U,2)

 ..Q:T'="M-MR"

 ..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=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

ECHI ;EP - electronic copy of HI

 NEW APCMP,APCMECV

 K APCMECV

 S (APCMD1,APCMN1)=0

 I APCMRPTT=2 S APCMP=APCMFAC  D

 .I $D(APCMECHI(APCMP,APCMTIME)) S F=$P(^APCM13OB(APCMIC,0),U,11) D  Q

 ..D S^APCM13E1(APCMRPT,APCMIC,"Facility is excluded from this measure as no patients requested a copy of their health information during the EHR reporting period.",APCMP,APCMRPTT,APCMTIME,F,1) Q

 .D ALLV^APCLAPIU(DFN,$$FMADD^XLFDT(APCMEDAT,-365),APCMEDAT,"APCMECV")

 .S APCMHV=$$HADVH^APCM13CI(DFN,APCMP,$$FMADD^XLFDT(APCMEDAT,-365),APCMEDAT,.APCMECV)

 .I 'APCMHV Q  ;no visits to this FACILITY THAT ARE H/30/80 for this patient so don't bother, the patient is not in the denominator

 .;set denominator value into field

 .S APCMEP=$$HASECHI^APCM13E4(DFN,APCMBDAT,$$BDB^APCM13E4(APCMEDAT,-4))  ;"" if no requests so not in denom

 .Q:APCMEP=""

 .S F=$P(^APCM13OB(APCMIC,0),U,8)  ;denom field for this measure

 .D S^APCM13E1(APCMRPT,APCMIC,$P(APCMEP,U),APCMP,APCMRPTT,APCMTIME,F)

 .S APCMVALU="VISIT: "_$$DATE^APCM1UTL(APCMHV)

 .;numerator?

 .S APCMVALU=APCMVALU_"|||"_$S($P(APCMEP,U,2):"MET: ",1:"NOT MET: ")_$P(APCMEP,U,3)_"|||"_$P(APCMEP,U,2)

 .S F=$P(^APCM13OB(APCMIC,0),U,9)

 .D S^APCM13E1(APCMRPT,APCMIC,$P(APCMEP,U,2),APCMP,APCMRPTT,APCMTIME,F)

 .D SETLIST^APCM13E1

 K APCMECV

 Q

SC ;EP - REFERRAL, SUMMARY OF CARE

 NEW APCMP

 S (APCMD1,APCMN1)=0

 I APCMRPTT=2 S APCMP=APCMFAC  D

 .I $D(APCMRCIS(APCMP,APCMTIME)) S F=$P(^APCM13OB(APCMIC,0),U,11) D  Q

 ..D S^APCM13E1(APCMRPT,APCMIC,"Hospital is excluded from this measure as they did not make any referrals for patients they saw during the report period.",APCMP,APCMRPTT,APCMTIME,F,1) Q

 .Q:'$D(APCMHVTP(APCMP))  ;no visits to this provider for this patient so don't bother, the patient is not in the denominator

 .;set denominator value into field

 .S APCMEP=$$HASC32H(DFN,APCMBDAT,$$FMADD^XLFDT(APCMEDAT),APCMFAC,.APCMVSTS)  ;# referrals^# w/c32 documentation

 .Q:'$P(APCMEP,U,1)

 .S F=$P(^APCM13OB(APCMIC,0),U,8)  ;denom field for this measure

 .D S^APCM13E1(APCMRPT,APCMIC,$P(APCMEP,U,1),APCMP,APCMRPTT,APCMTIME,F)

 .;S APCMVALU="VISIT: "_$$DATE^APCM1UTL(APCMHVTP(APCMP))

 .S APCMVALU="# ref: "_$P(APCMEP,U,1)_" - # w/C32: "_+$P(APCMEP,U,2)_" "_$P(APCMEP,U,4)_"|||"_$P(APCMEP,U,3)_"|||"_$S('(+$P(APCMEP,U,1)):0,+$P(APCMEP,U,1)=+$P(APCMEP,U,2):1,1:0)

 .;numerator?

 .S F=$P(^APCM13OB(APCMIC,0),U,9)

 .D S^APCM13E1(APCMRPT,APCMIC,$P(APCMEP,U,2),APCMP,APCMRPTT,APCMTIME,F)

 .D SETLIST^APCM13E1

 Q

HASC32H(P,BD,ED,R,VSTS) ;does patient have a referral with c32

 ;

 NEW A,B,C,D,E,ROI,X,ROII,VDS

 S ROI=""  ;set to 1 if had a good request

 S ROII="" ;set to date of reques

 S VDS=""

 S D=$$FMADD^XLFDT(BD,-1)

 S X=0 F  S X=$O(VSTS(X)) Q:X'=+X  D

 .S V=$P(VSTS(X),U,5)

 .Q:$P(^AUPNVSIT(V,0),U,6)'=R

 .Q:'$$HOSER^APCM13E6(V,R)

 .I $P(^AUPNVSIT(V,0),U,7)="H" Q:'$$TRANSOUT(V)

 .I $$CLINIC^APCLV(V,"C")=30 Q:'$$ERTRANSO(V)

 .S O=$$FMADD^XLFDT($$VD^APCLV(V),-1),E=$$DSCHDATE^APCM13E6(V)

 .I VDS="" S VDS="Visits: "

 .S VDS=VDS_$$DATE^APCM1UTL($$VD^APCLV(V))_";"

 .F  S O=$O(^BMCREF("AA",P,O)) Q:O'=+O!(O>E)  D

 ..S Q=0 F  S Q=$O(^BMCREF("AA",P,O,Q)) Q:Q'=+Q  D

 ...S S=$P(^BMCREF(Q,0),U,15)

 ...I S'="A",S'="C1" Q  ;not a A or C1

 ...Q:$P(^BMCREF(Q,0),U,4)="N"

 ...Q:$P(^BMCREF(Q,0),U,5)'=R

 ...S $P(ROI,U,1)=$P(ROI,U,1)+1

 ...;now check to see if a C32 was printed

 ...S Y=0 F  S Y=$O(^BMCREF(Q,6,"B",Y)) Q:Y'=+Y  D

 ....I $P(^AUPNVSIT(V,0),U,7)="H" D  Q

 .....I $P(Y,".")'<$$FMADD^XLFDT($$DSCHDATE^APCM13E6(V),-1),$P(Y,".")'>$$DSCHDATE^APCM13E6(V) D  Q

 ......S $P(ROI,U,2)=$P(ROI,U,2)+1,ROII=ROII_"RI "_$$DATE^APCM1UTL(O)_" C32 "_$$DATE^APCM1UTL(Y)_";" Q

 ....D  Q

 .....I $P(Y,".")'<$$VD^APCLV(V),$P(Y,".")'>$$DSCHDATE^APCM13E6(V) D

 ......S $P(ROI,U,2)=$P(ROI,U,2)+1,ROII=ROII_"RI "_$$DATE^APCM1UTL(O)_" C32 "_$$DATE^APCM1UTL(Y)_";" Q

 ....S ROII=ROII_"RI "_$$DATE^APCM1UTL(O)_" C32 None;"

 S $P(ROI,U,3)=ROII

 Q ROI_U_VDS

ECDI ;EP - electronic copy of discharge instructions

 NEW APCMP,APCMZ,APCMEP

 I APCMRPTT=2 D

 .S APCMP=APCMFAC

 .I $D(APCMNOEC(APCMP,APCMTIME)) S F=$P(^APCM13OB(APCMIC,0),U,11) D  Q

 ..D S^APCM13E1(APCMRPT,APCMIC,"Facility is excluded from this measure as it did not have any requests from patients for and electronic copy of their discharge instructions during the EHR reporting period.",APCMP,APCMRPTT,APCMTIME,F,1) Q

 .S APCMEP=$$HASECDI(DFN,APCMBDAT,APCMEDAT,APCMP,.APCMVSTS)  ;return # of visits^# w/M-MR

 .;set denominator value into field

 .I APCMEP="" Q

 .S F=$P(^APCM13OB(APCMIC,0),U,8)  ;denom field for this measure

 .D S^APCM13E1(APCMRPT,APCMIC,1,APCMP,APCMRPTT,APCMTIME,F)

 .S APCMVALU=$P(APCMEP,U,2)_"|||"_$P(APCMEP,U,3)_"|||"_$S($P(APCMEP,U,1):1,1:0)

 .;numerator?

 .S F=$P(^APCM13OB(APCMIC,0),U,9)

 .D S^APCM13E1(APCMRPT,APCMIC,$P(APCMEP,U,1),APCMP,APCMRPTT,APCMTIME,F)

 .D SETLIST^APCM13E1

 Q

HASECDI(P,BD,ED,R,VSTS) ;does patient have a M-MR on each visit?

 ;

 NEW A,B,C,D,E,X,Y,V,PWH,T,W,Z,Q,ECDI

 ;LOOP THROUGH ALL VISITS AND FIND AT LEAST ONE WITH ECDI TUI NOTES

 S PWH="",ECDI=""

 S X=0 F  S X=$O(VSTS(X)) Q:X'=+X!(PWH)  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 '$$HOSER(V,R) Q  ;not correct service category/ER VISIT

 .I $P(^AUPNVSIT(V,0),U,7)="H" Q:'$$DISCHOUT(V)

 .I $P(^AUPNVSIT(V,0),U,7)="H" S Q="" D  Q:'Q

 ..S Z=$O(^AUPNVINP("AD",V,0)) I 'Z Q

 ..Q:'$D(^AUPNVINP(Z,0))

 ..Q:$P($P(^AUPNVINP(Z,0),U),".")>ED  ;discharged after report period

 ..S Q=1

 .S T=$$TIUDCEL(V) Q:T=""  ;no tiu notes for discharge instructions

 .;set denominator

 .I $$UP^XLFSTR($P(T,U))="E-COPY DISCHARGE INSTR RECEIVED" S PWH=1_U_"Adm/Visit Date: "_$$DATE^APCM1UTL($$VD^APCLV(V))_U_"Electronic Copy: "_$P(T,U)_" on "_$$DATE^APCM1UTL($P(T,U,2)) Q

 .S ECDI=0_U_$$DATE^APCM1UTL($$VD^APCLV(V))_U_"Electronic Copy: "_$P(T,U)_" on "_$$DATE^APCM1UTL($P(T,U,2))

 .Q

 I PWH Q PWH

 Q ECDI

DISCHOUT(%) ;

 NEW A

 S A=$$DSCHTYPE^APCLV(%,"C")

 I A=1 Q 1

 I A=2 Q 1

 I A=3 Q 1

 Q 0

 ;

TIUDCEL(%) ;any electronic dc instruction TIU Notes

 NEW A,B,C,VD,DSC,DSC1,P,D

 S VD=$$VD^APCLV(%)  ;admission date

 S DSC=$$DSCHDATE(%)

 S DSC1=$$FMADD^XLFDT(DSC,1)  ;day after discharge

 S P=$P(^AUPNVSIT(%,0),U,5)

 S A=0,B="" F  S A=$O(^AUPNVNOT("AC",P,A)) Q:A'=+A!(B]"")  D

 .Q:'$D(^AUPNVNOT(A,0))

 .Q:$P(^AUPNVNOT(A,0),U,4)  ;retracted

 .S D=$P($P($G(^AUPNVNOT(A,12)),U,1),".")  ;event date

 .Q:D>DSC1  ;after day after discharge

 .Q:D<DSC  ;before discharge date

 .S C=$$VAL^XBDIQ1(9000010.28,A,.01)

 .I $$UP^XLFSTR(C)="E-COPY DISCHARGE INSTR RECEIVED" S B=C_U_D Q

 .I $$UP^XLFSTR(C)="E-COPY DISCHARGE INSTR NOT RECEIVED" S B=C_U_D Q

 Q B

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

APCM13E6  ;IHS/CMI/LAB - IHS MU; 

 +1       ;;1.0;IHS MU PERFORMANCE REPORTS;**2,4,5**;MAR 26, 2012;Build 5

 +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(^APCM13OB(APCMIC,0),U,11)

                       Begin DoDot:2

 +6                        DO S^APCM13E1(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(^APCM13OB(APCMIC,0),U,8)

 +3        DO S^APCM13E1(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(^APCM13OB(APCMIC,0),U,9)

 +9        DO S^APCM13E1(APCMRPT,APCMIC,$PIECE(APCMEP,U,1),APCMP,APCMRPTT,APCMTIME,F)

 +10       DO SETLIST^APCM13E1

 +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)

 +9       ;set denominator value into field

 +10      ;denom field for this measure

                   SET F=$PIECE(^APCM13OB(APCMIC,0),U,8)

 +11               DO S^APCM13E1(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(^APCM13OB(APCMIC,0),U,9)

 +15               DO S^APCM13E1(APCMRPT,APCMIC,$PIECE(APCMEP,U,2),APCMP,APCMRPTT,APCMTIME,F)

 +16               IF $PIECE(APCMEP,U,1)=0

                       QUIT 

 +17               DO SETLIST^APCM13E1

               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) ;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      ;not correct service category/ER VISIT

                   IF '$$HOSER(V,R)

                       QUIT 

 +11               IF $PIECE(^AUPNVSIT(V,0),U,7)="H"

                       IF '$$TRANS(V)

                           QUIT 

 +12               IF $$CLINIC^APCLV(V,"C")=30

                       IF '$$ERTRANS(V)

                           QUIT 

 +13               SET $PIECE(PWH,U,1)=$PIECE(PWH,U,1)+1

 +14      ;was there a PAT ED M-MR on the date of the visit through 1 day after the visit

 +15               SET Y="EDUC("

 +16               SET Z=P_"^ALL EDUC;DURING "_$$FMTE^XLFDT($$VD^APCLV(V))_"-"_$$FMTE^XLFDT($$VD^APCLV(V),1)

                   SET E=$$START1^APCLDF(Z,Y)

 +17               IF '$DATA(EDUC(1))

                       SET $PIECE(PWH,U,3)=$PIECE(PWH,U,3)_$$DATE^APCM1UTL($$VD^APCLV(V))_":NO M-MR"

                       QUIT 

 +18               SET (Z,B,D)=0

                   SET %=""

                   SET T=""

                   FOR 

                       SET Z=$ORDER(EDUC(Z))

                       IF Z'=+Z!(B)

                           QUIT 

                       Begin DoDot:2

 +19                       SET A=$PIECE(^AUPNVPED(+$PIECE(EDUC(Z),U,4),0),U)

 +20                       IF 'A

                               QUIT 

 +21                       IF '$DATA(^AUTTEDT(A,0))

                               QUIT 

 +22                       SET T=$PIECE(^AUTTEDT(A,0),U,2)

 +23                       IF T'="M-MR"

                               QUIT 

 +24                       SET B=1

                           SET $PIECE(PWH,U,2)=$PIECE(PWH,U,2)+1

                       End DoDot:2

 +25               SET $PIECE(PWH,U,3)=$PIECE(PWH,U,3)_$$DATE^APCM1UTL($$VD^APCLV(V))_":"_$SELECT(B:"M-MR",1:"NO M-MR")_";"