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
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
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(^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
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
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
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
Q
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))
