Routine: APCM14E2

APCM14E2 ; IHS/CMI/LAB - IHS MU ;

 ;;1.0;IHS MU PERFORMANCE REPORTS;**5,6**;MAR 26, 2012;Build 65

 ;;;;;;Build 3

HOSP(O,FAC) ;

 NEW V,L,C

 S V=$$VAL^XBDIQ1(100,O,23)

 I V="IV MEDICATIONS" Q 1

 I V="UNIT DOSE MEDICATIONS" Q 1

 I V="INPATIENT MEDICATIONS" Q 1

 I V'="OUTPATIENT MEDICATIONS" Q 0

 S L=$P($G(^OR(100,O,0)),U,10)

 I L,$D(^SC(L,0)) S C=$P(^SC(L,0),U,15) I C,C'=FAC Q 0

 I L,$D(^SC(L,0)) S C=$P(^SC(L,0),U,7) I C,$P($G(^DIC(40.7,C,0)),U,2)=30 Q 1

Q 0

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 ""

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

DEMO1 ;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="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(^APCM14OB(APCMIC,0),U,9)

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

 D SETLIST^APCM14E1

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

PL1 ;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="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(^APCM14OB(APCMIC,0),U,9)

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

 D SETLIST^APCM14E1

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

MEDL ;EP - CALCULATE MEDICATION 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

;d

 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 MEDL1

..Q

.Q

 I APCMRPTT=2 D

 .S APCMP=APCMFAC

 .Q:'$D(APCMHVTP(APCMP))

 .D MEDL1

.Q

MEDL1 ;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="VISIT: "_$$DATE^APCM1UTL(APCMHVTP(APCMP))

 ;numerator?

 S APCMEP=$$HASML(DFN,APCMBDAT,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

HASML(P,BDT,EDT) ;EP

 N RXIEN,ACTIEN,RTSDT,FILLDT,A0,FDTLP,IEN,G,DC,EXP,SDT,X,I,DRG,L,V,EXDT,IFN,ID,D365

 ;between BD and ED

 I '$G(P) Q ""

 I '$G(BDT) Q ""

 I '$G(EDT) Q ""

 I '$D(^AUPNPAT(P,0)) Q ""

 S G=""

NAM ;look for "No Active Medications" anytime during the report period

 S C=$O(^AUTTCRA("B","NO ACTIVE MEDICATIONS",0))

 I 'C G RXS

 ;GET most recent visit date

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

 .Q:'$D(^AUPNVRUP(A,0))  ;oops

 .Q:$P(^AUPNVRUP(A,0),U,1)'=C  ;not NAM

 .S D=$$VD^APCLV($P(^AUPNVRUP(A,0),U,3))

 .Q:D<BDT  ;before beg date

 .Q:D>EDT  ;after end date

 .S G="1^No Active Medications on "_$$DATE^APCM1UTL(D)

 I G Q G

RXS ;

 S G=""

 S D365=$$FMADD^XLFDT(BDT,-365)

 S EXDT=$$FMADD^XLFDT(BDT,-(365*3))

 F  S EXDT=$O(^PS(55,P,"P","A",EXDT)) Q:'EXDT!(G]"")  S IFN=0 F  S IFN=$O(^PS(55,P,"P","A",EXDT,IFN)) Q:'IFN!(G]"")  D:$D(^PSRX(IFN,0))

 .Q:$P($G(^PSRX(IFN,"STA")),"^")=13  ;deleted

 .Q:'$P(^PSRX(IFN,0),U,6)   ; Prescription must have a drug

 .S ID=$P(^PSRX(IFN,0),U,13)  ;issue date

 .Q:ID<D365

 .Q:ID>EDT

 .S DC=$P($G(^PSRX(IFN,3)),U,5)  ;dc date

 .I DC]"" Q:DC<BDT  ;IF DC'ED DATE IF MUST BE ON OR AFTER 1ST DATE OF TIME PERIOD

 .S G=1_U_$$DATE^APCM1UTL(ID)_" Rx: "_$P(^PSRX(IFN,0),U,1) Q

 I G]"" Q G

 ;now check NVA meds

NVA ; Set Non-VA Med Orders in the ^TMP Global

 S G=""

 F I=0:0 S I=$O(^PS(55,P,"NVA",I)) Q:'I!(G]"")  S X=$G(^PS(55,P,"NVA",I,0)) D

 .Q:'$P(X,"^")

 .S DRG=$S($P(X,"^",2):$P($G(^PSDRUG($P(X,"^",2),0)),"^"),1:$P(^PS(50.7,$P(X,"^"),0),"^")_" "_$P(^PS(50.606,$P(^PS(50.7,$P(X,"^"),0),"^",2),0),"^"))

 .I $P(X,"^",7),$P(X,"^",7)<BDT Q  ;DC'ED

 .S SDT=$P(X,"^",10) I 'SDT Q  ;NO documented date

 .I SDT>EDT Q  ;documented date after end date

 .Q:$P(X,U,6)]""

 .S G=1_U_"NVA: "_$$DATE^APCM1UTL($P(X,U,10))_" Item: "_DRG

 I G]"" Q G

Q G

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

APCM14E2  ; IHS/CMI/LAB - IHS MU ;

 +1       ;;1.0;IHS MU PERFORMANCE REPORTS;**5,6**;MAR 26, 2012;Build 65

 +2       ;;;;;;Build 3

HOSP(O,FAC) ;

 +1        NEW V,L,C

 +2        SET V=$$VAL^XBDIQ1(100,O,23)

 +3        IF V="IV MEDICATIONS"

               QUIT 1

 +4        IF V="UNIT DOSE MEDICATIONS"

               QUIT 1

 +5        IF V="INPATIENT MEDICATIONS"

               QUIT 1

 +6        IF V'="OUTPATIENT MEDICATIONS"

               QUIT 0

 +7        SET L=$PIECE($GET(^OR(100,O,0)),U,10)

 +8        IF L

               IF $DATA(^SC(L,0))

                   SET C=$PIECE(^SC(L,0),U,15)

                   IF C

                       IF C'=FAC

                           QUIT 0

 +9        IF L

               IF $DATA(^SC(L,0))

                   SET C=$PIECE(^SC(L,0),U,7)

                   IF C

                       IF $PIECE($GET(^DIC(40.7,C,0)),U,2)=30

                           QUIT 1

 +10       QUIT 0

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 ""

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(^APCM14OB(APCMIC,0),U,8)

 +2        DO S^APCM14E1(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(^APCM14OB(APCMIC,0),U,9)

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

 +9        DO SETLIST^APCM14E1

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

 +2        DO S^APCM14E1(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(^APCM14OB(APCMIC,0),U,9)

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

 +9        DO SETLIST^APCM14E1

 +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

MEDL      ;EP - CALCULATE MEDICATION 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       ;d

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

 +10                       QUIT

                       End DoDot:2

 +11               QUIT

               End DoDot:1

               QUIT

 +12       IF APCMRPTT=2

               Begin DoDot:1

 +13               SET APCMP=APCMFAC

 +14               IF '$DATA(APCMHVTP(APCMP))

                       QUIT

 +15               DO MEDL1

 +16               QUIT

               End DoDot:1

 +17       QUIT

MEDL1     ;set denominator value into field

 +1       ;denom field for this measure

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

 +2        DO S^APCM14E1(APCMRPT,APCMIC,1,APCMP,APCMRPTT,APCMTIME,F)

 +3        SET APCMVALU="VISIT: "_$$DATE^APCM1UTL(APCMHVTP(APCMP))

 +4       ;numerator?

 +5        SET APCMEP=$$HASML(DFN,APCMBDAT,APCMEDAT)

 +6        SET APCMVALU=APCMVALU_"|||"_$PIECE(APCMEP,U,2)_"|||"_$PIECE(APCMEP,U,1)

 +7        SET F=$PIECE(^APCM14OB(APCMIC,0),U,9)

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

 +9        DO SETLIST^APCM14E1

 +10       QUIT

HASML(P,BDT,EDT) ;EP

 +1        NEW RXIEN,ACTIEN,RTSDT,FILLDT,A0,FDTLP,IEN,G,DC,EXP,SDT,X,I,DRG,L,V,EXDT,IFN,ID,D365

 +2       ;between BD and ED

 +3        IF '$GET(P)

               QUIT ""

 +4        IF '$GET(BDT)

               QUIT ""

 +5        IF '$GET(EDT)

               QUIT ""

 +6        IF '$DATA(^AUPNPAT(P,0))

               QUIT ""

 +7        SET G=""

NAM       ;look for "No Active Medications" anytime during the report period

 +1        SET C=$ORDER(^AUTTCRA("B","NO ACTIVE MEDICATIONS",0))

 +2        IF 'C

               GOTO RXS

 +3       ;GET most recent visit date

 +4        SET A=0

FOR

               SET A=$ORDER(^AUPNVRUP("AC",P,A))

               IF A'=+A!(G]"")

                   QUIT

               Begin DoDot:1

 +5       ;oops

                   IF '$DATA(^AUPNVRUP(A,0))

                       QUIT

 +6       ;not NAM

                   IF $PIECE(^AUPNVRUP(A,0),U,1)'=C

                       QUIT

 +7                SET D=$$VD^APCLV($PIECE(^AUPNVRUP(A,0),U,3))

 +8       ;before beg date

                   IF D<BDT

                       QUIT

 +9       ;after end date

                   IF D>EDT

                       QUIT

 +10               SET G="1^No Active Medications on "_$$DATE^APCM1UTL(D)

               End DoDot:1

 +11       IF G

               QUIT G

RXS       ;

 +1        SET G=""

 +2        SET D365=$$FMADD^XLFDT(BDT,-365)

 +3        SET EXDT=$$FMADD^XLFDT(BDT,-(365*3))

 +4        FOR

               SET EXDT=$ORDER(^PS(55,P,"P","A",EXDT))

               IF 'EXDT!(G]"")

                   QUIT

               SET IFN=0

FOR

                   SET IFN=$ORDER(^PS(55,P,"P","A",EXDT,IFN))

                   IF 'IFN!(G]"")

                       QUIT

                   IF $DATA(^PSRX(IFN,0))

                       Begin DoDot:1

 +5       ;deleted

                           IF $PIECE($GET(^PSRX(IFN,"STA")),"^")=13

                               QUIT

 +6       ; Prescription must have a drug

                           IF '$PIECE(^PSRX(IFN,0),U,6)

                               QUIT

 +7       ;issue date

                           SET ID=$PIECE(^PSRX(IFN,0),U,13)

 +8                        IF ID<D365

                               QUIT

 +9                        IF ID>EDT

                               QUIT

 +10      ;dc date

                           SET DC=$PIECE($GET(^PSRX(IFN,3)),U,5)

 +11      ;IF DC'ED DATE IF MUST BE ON OR AFTER 1ST DATE OF TIME PERIOD

                           IF DC]""

                               IF DC<BDT

                                   QUIT

 +12                       SET G=1_U_$$DATE^APCM1UTL(ID)_" Rx: "_$PIECE(^PSRX(IFN,0),U,1)

                           QUIT

                       End DoDot:1

 +13       IF G]""

               QUIT G

 +14      ;now check NVA meds

NVA       ; Set Non-VA Med Orders in the ^TMP Global

 +1        SET G=""

 +2        FOR I=0:0

               SET I=$ORDER(^PS(55,P,"NVA",I))

               IF 'I!(G]"")

                   QUIT

               SET X=$GET(^PS(55,P,"NVA",I,0))

               Begin DoDot:1

 +3                IF '$PIECE(X,"^")

                       QUIT

 +4                SET DRG=$SELECT($PIECE(X,"^",2):$PIECE($GET(^PSDRUG($PIECE(X,"^",2),0)),"^"),1:$PIECE(^PS(50.7,$PIECE(X,"^"),0),"^")_" "_$PIECE(^PS(50.606,$PIECE(^PS(50.7,$PIECE(X,"^"),0),"^",2),0),"^"))

 +5       ;DC'ED

                   IF $PIECE(X,"^",7)

                       IF $PIECE(X,"^",7)<BDT

                           QUIT

 +6       ;NO documented date

                   SET SDT=$PIECE(X,"^",10)

                   IF 'SDT

                       QUIT

 +7       ;documented date after end date

                   IF SDT>EDT

                       QUIT

 +8                IF $PIECE(X,U,6)]""

                       QUIT

 +9                SET G=1_U_"NVA: "_$$DATE^APCM1UTL($PIECE(X,U,10))_" Item: "_DRG

               End DoDot:1

 +10       IF G]""

               QUIT G

 +11       QUIT G

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

APCM14E2.m