APCM13E1 ; IHS/CMI/LAB - IHS MU 24 Feb 2013 10:32 AM ;
;;1.0;IHS MU PERFORMANCE REPORTS;**2,5,6**;MAR 26, 2012;Build 65
;
BQI(BQIGREF,APCMPRV) ;PEP-Call from iCare
; input
; BQIGREF - Global reference
; APCMPRV - Array of providers
;
PROC ;EP
S APCMBT=$H
D JRNL^APCM1UTL
S APCMJ=$J,APCMH=$H
D XTMP^APCM1UTL("APCM1D","MU Patient List")
;process each patient
;first gather up provider exclusions
I APCMRPTT=2 D G PROC1 ;hospital report doesn't need this stuff for exclusions
.K APCM2ON
.K APCMOFFV
.K APCM13ON
.K APCMTRAE
.K APCMIMME
.K APCMN565
.K APCMHO65
.K APCMRCIS
.K APCMNOEC
.S X=APCMFAC S APCMX=$$VSTH(APCMFAC,APCMBD,APCMED) D
..I '$P(APCMX,U,3) S APCM13ON(X,1)=""
..I '$P(APCMX,U,2) S APCM2ON(X,1)=""
..I '$P(APCMX,U,1) S APCMOFFV(X,1)=""
..I '$P(APCMX,U,4) S APCMTRAE(X,1)=""
..I '$P(APCMX,U,5) S APCMIMME(X,1)=""
..I '$P(APCMX,U,6) S APCMN565(X,1)=""
..I '$P(APCMX,U,7) S APCMHO65(X,1)=""
..I '$P(APCMX,U,8) S APCMRCIS(X,1)=""
..I '$P(APCMX,U,9) S APCMNOEC(X,1)=""
.I $G(APCMWPP) S X=APCMFAC S APCMX=$$VSTH(APCMFAC,APCMPBD,APCMPED) D
..I '$P(APCMX,U,3) S APCM13ON(X,2)=""
..I '$P(APCMX,U,2) S APCM2ON(X,2)=""
..I '$P(APCMX,U,1) S APCMOFFV(X,2)=""
..I '$P(APCMX,U,4) S APCMTRAE(X,2)=""
..I '$P(APCMX,U,5) S APCMIMME(X,2)=""
..I '$P(APCMX,U,6) S APCMN565(X,2)=""
..I '$P(APCMX,U,7) S APCMHO65(X,2)=""
..I '$P(APCMX,U,8) S APCMRCIS(X,2)=""
..I '$P(APCMX,U,9) S APCMNOEC(X,2)=""
.D ROIH^APCM13E7
K APCM100R
S X=0 F S X=$O(APCMPRV(X)) Q:X'=+X I '$$H100(X,APCMBD,APCMED) S APCM100R(X,1)=""
I $G(APCMWPP) S X=0 F S X=$O(APCMPRV(X)) Q:X'=+X I '$$H100(X,APCMPBD,APCMPED) S APCM100R(X,2)=""
K APCM2ON
K APCMOFFV
K APCM13ON
K APCMTRAE
K APCMIMME
K APCMN565
S X=0 F S X=$O(APCMPRV(X)) Q:X'=+X S APCMX=$$VST(X,APCMBD,APCMED) D
.I '$P(APCMX,U,3) S APCM13ON(X,1)=""
.I '$P(APCMX,U,2) S APCM2ON(X,1)=""
.I '$P(APCMX,U,1) S APCMOFFV(X,1)=""
.I '$P(APCMX,U,4) S APCMTRAE(X,1)=""
.I '$P(APCMX,U,5) S APCMIMME(X,1)=""
I $G(APCMWPP) S X=0 F S X=$O(APCMPRV(X)) Q:X'=+X S APCMX=$$VST(X,APCMPBD,APCMPED) D
.I '$P(APCMX,U,3) S APCM13ON(X,2)=""
.I '$P(APCMX,U,2) S APCM2ON(X,2)=""
.I '$P(APCMX,U,1) S APCMOFFV(X,2)=""
.I '$P(APCMX,U,4) S APCMTRAE(X,2)=""
.I '$P(APCMX,U,5) S APCMIMME(X,2)=""
N1 D ROI ;roi exclusions
D RCIS ;SUMMARY OF CARE EXCLUSIONS
;any patients 0-5 or >64?
S APCMN565(1)=1
S P=0 F S P=$O(^DPT(P)) Q:P'=+P!(APCMN565(1)=0) D
.S X=$$DOD^AUPNPAT(P)
.I X,X'>APCMED Q
.Q:$$DOB^AUPNPAT(P)>APCMBD ;born after time period begin date
.S X=$P($G(^AUPNPAT(P,41,DUZ(2),0)),U,3)
.I X,X'>APCMED Q
.S A=$$AGE^AUPNPAT(P,APCMBD)
.I A<6 S APCMN565(1)=0 Q
.I A>64 S APCMN565(1)=0 Q
;
G:'$G(APCMWPP) PROC1
S APCMN565(2)=1
S P=0 F S P=$O(^DPT(P)) Q:P'=+P!(APCMN565(2)=0) D
.S X=$$DOD^AUPNPAT(P)
.I X,X'>APCMPED Q
.Q:$$DOB^AUPNPAT(P)>APCMPBD ;born after time period begin date
.S X=$P($G(^AUPNPAT(P,41,DUZ(2),0)),U,3)
.I X,X'>APCMPED Q
.S A=$$AGE^AUPNPAT(P,APCMPBD)
.I A<6 S APCMN565(2)=0 Q
.I A>64 S APCMN565(2)=0 Q
PROC1 ;
S DFN=0 F S DFN=$O(^AUPNPAT(DFN)) Q:DFN'=+DFN D
.Q:'$D(^DPT(DFN,0))
.;I DUZ=2793 Q:'$D(^DIBT(4723,1,DFN))
.;Q:DFN'=118876
.;I APCLDEMO'="I" Q:$P($G(^DPT(DFN,0)),U)["DEMO,PATIENT"
.Q:$$DEMO^APCLUTL(DFN,$G(APCMDEMO))
.D PROCCY,PROCPY
N ;
;NOW DO ATTESTATION MEASURES
D PROCACY,PROCAPY
S APCMET=$H
Q
;
PROCCY ;EP - current time period
K ^TMP($J)
Q:'$D(^DPT(DFN,0))
Q:$P(^DPT(DFN,0),U,2)=""
S APCMEDAT=APCMED,APCMTIME=1,APCMBDAT=APCMBD,APCMGBL="^APCMM13C(",APCMFILN=9001301.0311
S APCMAGEB=$$AGE^AUPNPAT(DFN,APCMBDAT)
S APCMAGEE=$$AGE^AUPNPAT(DFN,APCMEDAT)
S APCMSEX=$P(^DPT(DFN,0),U,2)
;had visit to each provider?
D CALCIND
K ^TMP($J,"A")
Q
PROCPY ;
Q:'$G(APCMWPP)
K ^TMP($J)
Q:'$D(^DPT(DFN,0))
Q:$P(^DPT(DFN,0),U,2)=""
;Q:"FM"'[$P(^DPT(DFN,0),U,2)
S APCMEDAT=APCMPED,APCMTIME=2,APCMBDAT=APCMPBD,APCMGBL="^APCMM13P(",APCMFILN=9001301.0411
S APCMAGEB=$$AGE^AUPNPAT(DFN,APCMBDAT)
S APCMAGEE=$$AGE^AUPNPAT(DFN,APCMEDAT)
S APCMSEX=$P(^DPT(DFN,0),U,2)
D CALCIND
K ^TMP($J,"A")
Q
CALCIND ;
D CALCIND^APCM13CI
Q
PROCACY ;EP - current time period
S APCMEDAT=APCMED,APCMTIME=1,APCMBDAT=APCMBD,APCMGBL="^APCMM13C(",APCMFILN=9001301.0311
D CALCINDA^APCM13CI
Q
PROCAPY ;
Q:'$G(APCMWPP)
S APCMEDAT=APCMPED,APCMTIME=2,APCMBDAT=APCMPBD,APCMGBL="^APCMM13P(",APCMFILN=9001301.0411
D CALCINDA^APCM13CI
Q
S(RPT,IND,VALUE,PROV,RT,T,F,NT) ;EP - set counter
NEW N,P,Y,J
I VALUE="" Q ;no value to add
I RT=1 S I=PROV_";VA(200,"
I RT=2 S I=PROV_";AUTTLOC("
I T=1 D Q
.I $G(BQIGREF)'="" D Q
..NEW ID
..S ID=$P(^APCM13OB(IND,0),U,1)
..I $P(^APCM13OB(IND,0),U,8)=F S $P(@BQIGREF@(PROV,ID,"CURR"),U,1)=$P($G(@BQIGREF@(PROV,ID,"CURR")),U,1)+VALUE
..I $P(^APCM13OB(IND,0),U,9)=F S $P(@BQIGREF@(PROV,ID,"CURR"),U,2)=$P($G(@BQIGREF@(PROV,ID,"CURR")),U,2)+VALUE
..I $P(^APCM13OB(IND,0),U,11)=F S $P(@BQIGREF@(PROV,ID,"CURR"),U,3)=VALUE
..S $P(@BQIGREF@(PROV,ID,"CURR"),U,4)=$G(APCMVALU)
.S Y=$P(^DD(9001301.0311,F,0),U,4)
.S N=$P(Y,";")
.S P=$P(Y,";",2)
.S J=$O(^APCMM13C(RPT,11,"B",I,0))
.I 'J W APCMBOMB Q
.I VALUE?.N S $P(^APCMM13C(RPT,11,J,N),U,P)=$P($G(^APCMM13C(RPT,11,J,N)),U,P)+VALUE
.I VALUE'?.N S $P(^APCMM13C(RPT,11,J,N),U,P)=VALUE
.Q ;now set total multiple (1200) - NOW NO TOTAL PER TIFFANY
.Q:$G(NT)=1
.S Y=$P(^DD(9001301.0312,F,0),U,4)
.S N=$P(Y,";")
.S P=$P(Y,";",2)
.S J=$O(^APCMM13C(RPT,12,"B","TOTAL",0))
.I 'J S ^APCMM13C(RPT,12,0)="^9001301.0312A^1^1",^APCMM13C(RPT,12,1,0)="TOTAL",^APCMM13C(RPT,12,"B","TOTAL",1)="",J=1
.I VALUE?.N S $P(^APCMM13C(RPT,12,J,N),U,P)=$P($G(^APCMM13C(RPT,12,J,N)),U,P)+VALUE Q
.S $P(^APCMM13C(RPT,12,J,N),U,P)=VALUE
I T=2 D
.I $G(BQIGREF)'="" D Q
..NEW ID
..S ID=$P(^APCM13OB(IND,0),U,1)
..I $P(^APCM13OB(IND,0),U,8)=F S $P(@BQIGREF@(PROV,ID,"PREV"),U,1)=$P($G(@BQIGREF@(PROV,ID,"PREV")),U,1)+VALUE
..I $P(^APCM13OB(IND,0),U,9)=F S $P(@BQIGREF@(PROV,ID,"PREV"),U,2)=$P($G(@BQIGREF@(PROV,ID,"PREV")),U,2)+VALUE
..I $P(^APCM13OB(IND,0),U,11)=F S $P(@BQIGREF@(PROV,ID,"PREV"),U,3)=VALUE
..S $P(@BQIGREF@(PROV,ID,"PREV"),U,4)=$G(APCMVALU)
.S Y=$P(^DD(9001301.0411,F,0),U,4)
.S N=$P(Y,";")
.S P=$P(Y,";",2)
.S J=$O(^APCMM13P(RPT,11,"B",I,0))
.I 'J W APCMBOMB Q
.I VALUE?.N S $P(^APCMM13P(RPT,11,J,N),U,P)=$P($G(^APCMM13P(RPT,11,J,N)),U,P)+VALUE
.I VALUE'?.N S $P(^APCMM13P(RPT,11,J,N),U,P)=VALUE
.Q ; NOT TOTALS PER TIFFANY
.Q:$G(NT)=1 ;no totals
.S Y=$P(^DD(9001301.0412,F,0),U,4)
.S N=$P(Y,";")
.S P=$P(Y,";",2)
.S J=$O(^APCMM13P(RPT,12,"B","TOTAL",0))
.I 'J S ^APCMM13P(RPT,12,0)="^9001301.0412A^1^1",^APCMM13P(RPT,12,1,0)="TOTAL",^APCMM13P(RPT,12,"B","TOTAL",1)="",J=1
.I VALUE?.N S $P(^APCMM13P(RPT,12,J,N),U,P)=$P($G(^APCMM13P(RPT,12,J,N)),U,P)+VALUE Q
.I VALUE'?.N S $P(^APCMM13P(RPT,12,J,N),U,P)=VALUE
Q
SETLIST ;EP
NEW P,APCMX,APCMO
Q:APCMTIME'=1
Q:'$D(APCMINDL(APCMIC)) ;not a selected topic
S APCMX=0 F S APCMX=$O(APCMINDL(APCMIC,APCMX)) Q:APCMX'=+APCMX D
.X ^APCMM13L(APCMX,12) Q:'$T
.S APCMINDL(APCMIC,APCMX,APCMP)=$G(APCMINDL(APCMIC,APCMX,APCMP))+1
.S APCMO=$S(APCMRPTT=2:$P(^APCMM13L(APCMX,0),U,6),1:$P(^APCMM13L(APCMX,0),U,5))
.S P=$S(APCMRPTT=2:$P(^DIC(4,APCMP,0),U),1:$P(^VA(200,APCMP,0),U))
.S ^XTMP("APCM1D",APCMJ,APCMH,"LIST",$P(^APCM13OB(APCMIC,0),U,4),APCMIC,APCMO,APCMX,P,$S($P($G(^AUPNPAT(DFN,11)),U,18)]"":$P(^AUPNPAT(DFN,11),U,18),1:"UNKNOWN"),$P(^DPT(DFN,0),U,2),$$AGE^AUPNPAT(DFN,APCMBDAT),DFN)=$G(APCMVALU)
Q
H100(R,BD,ED) ;
NEW ID,C,Y,X,VMED,V
S C=0
S ID=$$FMADD^XLFDT(BD,-1)
F S ID=$O(^PSRX("AC",ID)) Q:ID'=+ID!(C>100)!(ID>ED) D
.S X=0 F S X=$O(^PSRX("AC",ID,X)) Q:X'=+X!(C>100) D
..Q:$P($G(^PSRX(X,0)),U,4)'=R
..Q:$P($G(^PSRX(X,"STA")),"^")=13
..;SKIP ER CLINIC OR H VISIT, GET VISIT FROM V MED
..S VMED=$P($G(^PSRX(X,999999911)),U,1)
..Q:'VMED
..S V=$P($G(^AUPNVMED(VMED,0)),U,3)
..Q:'V
..Q:'$D(^AUPNVSIT(V,0))
..Q:$P(^AUPNVSIT(V,0),U,7)="H"
..Q:$$CLINIC^APCLV(V,"C")=30
..S C=C+1
Q $S(C>100:1,1:"")
VST(R,BD,ED) ;did this provider see anyone over 2
NEW SD,A,B,C,G,V,T
S T=$O(^APCMMUCN("B","INTERIM STAGE 1 2013",0))
S SD=$$FMADD^XLFDT(BD,-1)
S SD=SD_".9999"
S G=""
F S SD=$O(^AUPNVSIT("B",SD)) Q:SD'=+SD!($P(SD,".")>ED)!($$GOTALL(G)) D
.S V=0 F S V=$O(^AUPNVSIT("B",SD,V)) Q:V'=+V!($$GOTALL(G)) D
..S B=0,C=0 F S B=$O(^AUPNVPRV("AD",V,B)) Q:B'=+B D
...Q:'$D(^AUPNVPRV(B,0))
...Q:$P(^AUPNVPRV(B,0),U,1)'=R
...Q:$P(^AUPNVPRV(B,0),U,4)'="P"
...S C=1
..Q:'C
..S $P(G,U,1)=1
..I $$AGE^AUPNPAT($P(^AUPNVSIT(V,0),U,5),$P(BD,"."))>2 S $P(G,U,2)=1
..I $$AGE^AUPNPAT($P(^AUPNVSIT(V,0),U,5),$P(BD,"."))>12 S $P(G,U,3)=1
..S C=$$CLINIC^APCLV(V,"C")
..I T,C]"",'$D(^APCMMUCN(T,14,"B",C)) S $P(G,U,4)=1 ;not an exclusion
..I $D(^AUPNVIMM("AD",V)) S $P(G,U,5)=1 ;not an exclusion for imm reg
..I $$DOB^AUPNPAT($P(^AUPNVSIT(V,0),U,5))>BD S A=$$AGE^AUPNPAT($P(^AUPNVSIT(V,0),U,5),BD) I A<6!(A>64) S $P(G,U,6)=1
Q G
;
GOTALL(%) ;EP
NEW Y
S Y=$P(%,U,1)+$P(%,U,2)+$P(%,U,3)+$P(%,U,4)+$P(%,U,5)+$P(%,U,6)
I Y=6 Q 1
Q 0
VSTH(R,BD,ED) ;did this HOSPITAL HAVE THESE VISITS
NEW SD,A,B,C,G,V,T,O,P,Q,E,J,S
S T=$O(^APCMMUCN("B","INTERIM STAGE 1 2013",0))
S SD=$$FMADD^XLFDT(BD,-1)
S SD=SD_".9999"
S G=""
F S SD=$O(^AUPNVSIT("B",SD)) Q:SD'=+SD!($P(SD,".")>ED)!($$GOTALLH(G)) D
.S V=0 F S V=$O(^AUPNVSIT("B",SD,V)) Q:V'=+V!($$GOTALLH(G)) D
..Q:$P(^AUPNVSIT(V,0),U,6)'=R
..Q:'$$HOSER^APCM13E6(V,R)
..S $P(G,U,1)=1
..S A=$$AGE^AUPNPAT($P(^AUPNVSIT(V,0),U,5),$P(BD,".")) I A>2 S $P(G,U,2)=1
..I A>12 S $P(G,U,3)=1
..;S C=$$CLINIC^APCLV(V,"C")
..;I T,C]"",'$D(^APCMMUCN(T,14,"B",C)) S $P(G,U,4)=1 ;not an exclusion
..S $P(G,U,4)=1
..I $D(^AUPNVIMM("AD",V)) S $P(G,U,5)=1 ;not an exclusion for imm reg
..;check age
..I A<6!(A>64) S $P(G,U,6)=1
..I $P(^AUPNVSIT(V,0),U,7)="H" S A=$$AGE^AUPNPAT($P(^AUPNVSIT(V,0),U,5),$$VD^APCLV(V)) I A>64 S $P(G,U,7)=1
..;was there any requests for electronic discharge instructions? check TIU notes
..I $$TIUDCEL(V) S $P(G,U,9)=1
..;is there a referral for this visit?
..S P=$P(^AUPNVSIT(V,0),U,5),J=""
..S O=$$FMADD^XLFDT($$VD^APCLV(V),-1),E=$$FMADD^XLFDT($$DSCHDATE^APCM13E6(V),1),J=""
..F S O=$O(^BMCREF("AA",P,O)) Q:O'=+O!(J)!(O>E) D
...S Q=0 F S Q=$O(^BMCREF("AA",P,O,Q)) Q:Q'=+Q!(J) 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 J=1
..I J=1 S $P(G,U,8)=1
Q G
TIUDCEL(%) ;any electronic dc instruction TIU Notes
NEW A,B,C
S A=0,B=0 F S A=$O(^AUPNVNOT("AD",%,A)) Q:A'=+A!(B) D
.S C=$$VAL^XBDIQ1(9000010.28,A,.01)
.I $$UP^XLFSTR(C)="E-COPY DISCHARGE INSTR RECEIVED" S B=1 Q
.I $$UP^XLFSTR(C)="E-COPY DISCHARGE INSTR NOT RECEIVED" S B=1 Q
Q B
GOTALLH(%) ;EP
NEW Y
S Y=$P(%,U,1)+$P(%,U,2)+$P(%,U,3)+$P(%,U,4)+$P(%,U,5)+$P(%,U,6)+$P(%,U,7)+$P(%,U,8)+$P(%,U,9)
I Y=9 Q 1
Q 0
ROI ;
NEW X
S X=$O(^APCM13OB("B","S1.011.EP",0))
I '$D(APCMIND(X)) Q ;don't bother as this measure isn't in the report
NEW APCMD,APCMX,APCMPAT,X,APCMP
K APCMECHI
S X=0 F S X=$O(APCMPRV(X)) Q:X'=+X S APCMECHI(X,1)=""
S X=0 F S X=$O(APCMPRV(X)) Q:X'=+X S APCMECHI(X,2)=""
;LOOP THROUGH ROI AND IF I FIND 1 FOR THE PROVIDER THEN KILL OFF APCMECHI - exclusion
S APCMD=$$FMADD^XLFDT(APCMBD,-1)
S APCM4D=$$FMADD^XLFDT(APCMED,-4)
F S APCMD=$O(^BRNREC("B",APCMD)) Q:APCMD'=+APCMD!(APCMD>APCM4D) D
.S APCMX=0 F S APCMX=$O(^BRNREC("B",APCMD,APCMX)) Q:APCMX'=+APCMX D
..Q:$P($G(^BRNREC(APCMX,11)),U,1)'="E" ;not an electronic request
..S APCMPAT=$P($G(^BRNREC(APCMX,0)),U,3)
..K APCMVSTS,APCMHVTP
..D ALLV^APCLAPIU(APCMPAT,$$FMADD^XLFDT(APCMED,-365),APCMED,"APCMVSTS")
..S APCMP=0 F S APCMP=$O(APCMPRV(APCMP)) Q:APCMP'=+APCMP D
...S APCMHV=$$HADV^APCM13CI(APCMPAT,APCMP,$$FMADD^XLFDT(APCMED,-365),APCMED,.APCMVSTS)
...Q:'APCMHV
...K APCMECHI(APCMP,1) ;had a visit with this patient and thus had a request, so no exclusion
Q:'$G(APCMWPP)
S APCMD=$$FMADD^XLFDT(APCMPBD,-1)
S APCM4D=$$FMADD^XLFDT(APCMPED,-4)
F S APCMD=$O(^BRNREC("B",APCMD)) Q:APCMD'=+APCMD!(APCMD>APCM4D) D
.S APCMX=0 F S APCMX=$O(^BRNREC("B",APCMD,APCMX)) Q:APCMX'=+APCMX D
..Q:$P($G(^BRNREC(APCMX,11)),U,1)'="E" ;not an electronic request
..S APCMPAT=$P($G(^BRNREC(APCMX,0)),U,3)
..K APCMVSTS,APCMHVTP
..D ALLV^APCLAPIU(APCMPAT,$$FMADD^XLFDT(APCMPED,-365),APCMPED,"APCMVSTS")
..S APCMP=0 F S APCMP=$O(APCMPRV(APCMP)) Q:APCMP'=+APCMP D
...S APCMHV=$$HADV^APCM13CI(APCMPAT,APCMP,$$FMADD^XLFDT(APCMPED,-365),APCMPED,.APCMVSTS)
...Q:'APCMHV
...K APCMECHI(APCMP,2) ;had a visit with this patient and thus had a request, so no exclusion
Q
RCIS ;did provider have any referrals for patients he/she saw
NEW X
S X=$O(^APCM13OB("B","S1.023.EP",0))
I '$D(APCMIND(X)) Q ;don't bother as this measure isn't in the report
NEW APCMD,APCMX,APCMPAT,X,APCMP
K APCMRCIS
S X=0 F S X=$O(APCMPRV(X)) Q:X'=+X S APCMRCIS(X,1)=""
S X=0 F S X=$O(APCMPRV(X)) Q:X'=+X S APCMRCIS(X,2)=""
;LOOP THROUGH ROI AND IF I FIND 1 FOR THE PROVIDER THEN KILL OFF APCMRCIS - exclusion
S APCMD=$$FMADD^XLFDT(APCMBD,-1)
F S APCMD=$O(^BMCREF("B",APCMD)) Q:APCMD'=+APCMD!(APCMD>APCMED) D
.S APCMX=0 F S APCMX=$O(^BMCREF("B",APCMD,APCMX)) Q:APCMX'=+APCMX D
..S APCMPAT=$P($G(^BMCREF(APCMX,0)),U,3)
..S R=$P(^BMCREF(APCMX,0),U,6)
..Q:R=""
..Q:'$D(APCMPRV(R)) ;NOT A PROVIDER WE WANT
..S S=$P(^BMCREF(APCMX,0),U,15)
..I S'="A",S'="C1" Q ;not a A or C1
..Q:$P(^BMCREF(APCMX,0),U,4)="N"
..;K APCMVSTS,APCMHVTP
..;D ALLV^APCLAPIU(APCMPAT,APCMBD,APCMED,"APCMVSTS")
..;S APCMP=0 F S APCMP=$O(APCMPRV(APCMP)) Q:APCMP'=+APCMP D
..;.S APCMHV=$$HADV^APCM13CI(APCMPAT,APCMP,APCMBD,APCMED,.APCMVSTS)
..;.Q:'APCMHV
..K APCMRCIS(R,1) ;had a visit with this patient and had a referral for this patient so no exclusion
Q:'$G(APCMWPP)
S APCMD=$$FMADD^XLFDT(APCMPBD,-1)
F S APCMD=$O(^BMCREF("B",APCMD)) Q:APCMD'=+APCMD!(APCMD>APCMPED) D
.S APCMX=0 F S APCMX=$O(^BMCREF("B",APCMD,APCMX)) Q:APCMX'=+APCMX D
..S APCMPAT=$P($G(^BMCREF(APCMX,0)),U,3)
..S R=$P(^BMCREF(APCMX,0),U,6)
..Q:R=""
..Q:'$D(APCMPRV(R)) ;NOT A PROVIDER WE WANT
..S S=$P(^BMCREF(APCMX,0),U,15)
..I S'="A",S'="C1" Q ;not a A or C1
..Q:$P(^BMCREF(APCMX,0),U,4)="N"
..;K APCMVSTS,APCMHVTP
..;D ALLV^APCLAPIU(APCMPAT,APCMPBD,APCMPED,"APCMVSTS")
..;S APCMP=0 F S APCMP=$O(APCMPRV(APCMP)) Q:APCMP'=+APCMP D
..;.S APCMHV=$$HADV^APCM13CI(APCMPAT,APCMP,APCMPBD,APCMPED,.APCMVSTS)
..;.Q:'APCMHV
..K APCMRCIS(R,2) ;had a visit with this patient and thus had a request, so no exclusion
Q
APCM13E1 ; IHS/CMI/LAB - IHS MU 24 Feb 2013 10:32 AM ;
+1 ;;1.0;IHS MU PERFORMANCE REPORTS;**2,5,6**;MAR 26, 2012;Build 65
+2 ;
BQI(BQIGREF,APCMPRV) ;PEP-Call from iCare
+1 ; input
+2 ; BQIGREF - Global reference
+3 ; APCMPRV - Array of providers
+4 ;
PROC ;EP
+1 SET APCMBT=$HOROLOG
+2 DO JRNL^APCM1UTL
+3 SET APCMJ=$JOB
SET APCMH=$HOROLOG
+4 DO XTMP^APCM1UTL("APCM1D","MU Patient List")
+5 ;process each patient
+6 ;first gather up provider exclusions
+7 ;hospital report doesn't need this stuff for exclusions
IF APCMRPTT=2
Begin DoDot:1
+8 KILL APCM2ON
+9 KILL APCMOFFV
+10 KILL APCM13ON
+11 KILL APCMTRAE
+12 KILL APCMIMME
+13 KILL APCMN565
+14 KILL APCMHO65
+15 KILL APCMRCIS
+16 KILL APCMNOEC
+17 SET X=APCMFAC
SET APCMX=$$VSTH(APCMFAC,APCMBD,APCMED)
Begin DoDot:2
+18 IF '$PIECE(APCMX,U,3)
SET APCM13ON(X,1)=""
+19 IF '$PIECE(APCMX,U,2)
SET APCM2ON(X,1)=""
+20 IF '$PIECE(APCMX,U,1)
SET APCMOFFV(X,1)=""
+21 IF '$PIECE(APCMX,U,4)
SET APCMTRAE(X,1)=""
+22 IF '$PIECE(APCMX,U,5)
SET APCMIMME(X,1)=""
+23 IF '$PIECE(APCMX,U,6)
SET APCMN565(X,1)=""
+24 IF '$PIECE(APCMX,U,7)
SET APCMHO65(X,1)=""
+25 IF '$PIECE(APCMX,U,8)
SET APCMRCIS(X,1)=""
+26 IF '$PIECE(APCMX,U,9)
SET APCMNOEC(X,1)=""
End DoDot:2
+27 IF $GET(APCMWPP)
SET X=APCMFAC
SET APCMX=$$VSTH(APCMFAC,APCMPBD,APCMPED)
Begin DoDot:2
+28 IF '$PIECE(APCMX,U,3)
SET APCM13ON(X,2)=""
+29 IF '$PIECE(APCMX,U,2)
SET APCM2ON(X,2)=""
+30 IF '$PIECE(APCMX,U,1)
SET APCMOFFV(X,2)=""
+31 IF '$PIECE(APCMX,U,4)
SET APCMTRAE(X,2)=""
+32 IF '$PIECE(APCMX,U,5)
SET APCMIMME(X,2)=""
+33 IF '$PIECE(APCMX,U,6)
SET APCMN565(X,2)=""
+34 IF '$PIECE(APCMX,U,7)
SET APCMHO65(X,2)=""
+35 IF '$PIECE(APCMX,U,8)
SET APCMRCIS(X,2)=""
+36 IF '$PIECE(APCMX,U,9)
SET APCMNOEC(X,2)=""
End DoDot:2
+37 DO ROIH^APCM13E7
End DoDot:1
GOTO PROC1
+38 KILL APCM100R
+39 SET X=0
FOR
SET X=$ORDER(APCMPRV(X))
IF X'=+X
QUIT
IF '$$H100(X,APCMBD,APCMED)
SET APCM100R(X,1)=""
+40 IF $GET(APCMWPP)
SET X=0
FOR
SET X=$ORDER(APCMPRV(X))
IF X'=+X
QUIT
IF '$$H100(X,APCMPBD,APCMPED)
SET APCM100R(X,2)=""
+41 KILL APCM2ON
+42 KILL APCMOFFV
+43 KILL APCM13ON
+44 KILL APCMTRAE
+45 KILL APCMIMME
+46 KILL APCMN565
+47 SET X=0
FOR
SET X=$ORDER(APCMPRV(X))
IF X'=+X
QUIT
SET APCMX=$$VST(X,APCMBD,APCMED)
Begin DoDot:1
+48 IF '$PIECE(APCMX,U,3)
SET APCM13ON(X,1)=""
+49 IF '$PIECE(APCMX,U,2)
SET APCM2ON(X,1)=""
+50 IF '$PIECE(APCMX,U,1)
SET APCMOFFV(X,1)=""
+51 IF '$PIECE(APCMX,U,4)
SET APCMTRAE(X,1)=""
+52 IF '$PIECE(APCMX,U,5)
SET APCMIMME(X,1)=""
End DoDot:1
+53 IF $GET(APCMWPP)
SET X=0
FOR
SET X=$ORDER(APCMPRV(X))
IF X'=+X
QUIT
SET APCMX=$$VST(X,APCMPBD,APCMPED)
Begin DoDot:1
+54 IF '$PIECE(APCMX,U,3)
SET APCM13ON(X,2)=""
+55 IF '$PIECE(APCMX,U,2)
SET APCM2ON(X,2)=""
+56 IF '$PIECE(APCMX,U,1)
SET APCMOFFV(X,2)=""
+57 IF '$PIECE(APCMX,U,4)
SET APCMTRAE(X,2)=""
+58 IF '$PIECE(APCMX,U,5)
SET APCMIMME(X,2)=""
End DoDot:1
N1 ;roi exclusions
DO ROI
+1 ;SUMMARY OF CARE EXCLUSIONS
DO RCIS
+2 ;any patients 0-5 or >64?
+3 SET APCMN565(1)=1
+4 SET P=0
FOR
SET P=$ORDER(^DPT(P))
IF P'=+P!(APCMN565(1)=0)
QUIT
Begin DoDot:1
+5 SET X=$$DOD^AUPNPAT(P)
+6 IF X
IF X'>APCMED
QUIT
+7 ;born after time period begin date
IF $$DOB^AUPNPAT(P)>APCMBD
QUIT
+8 SET X=$PIECE($GET(^AUPNPAT(P,41,DUZ(2),0)),U,3)
+9 IF X
IF X'>APCMED
QUIT
+10 SET A=$$AGE^AUPNPAT(P,APCMBD)
+11 IF A<6
SET APCMN565(1)=0
QUIT
+12 IF A>64
SET APCMN565(1)=0
QUIT
End DoDot:1
+13 ;
+14 IF '$GET(APCMWPP)
GOTO PROC1
+15 SET APCMN565(2)=1
+16 SET P=0
FOR
SET P=$ORDER(^DPT(P))
IF P'=+P!(APCMN565(2)=0)
QUIT
Begin DoDot:1
+17 SET X=$$DOD^AUPNPAT(P)
+18 IF X
IF X'>APCMPED
QUIT
+19 ;born after time period begin date
IF $$DOB^AUPNPAT(P)>APCMPBD
QUIT
+20 SET X=$PIECE($GET(^AUPNPAT(P,41,DUZ(2),0)),U,3)
+21 IF X
IF X'>APCMPED
QUIT
+22 SET A=$$AGE^AUPNPAT(P,APCMPBD)
+23 IF A<6
SET APCMN565(2)=0
QUIT
+24 IF A>64
SET APCMN565(2)=0
QUIT
End DoDot:1
PROC1 ;
+1 SET DFN=0
FOR
SET DFN=$ORDER(^AUPNPAT(DFN))
IF DFN'=+DFN
QUIT
Begin DoDot:1
+2 IF '$DATA(^DPT(DFN,0))
QUIT
+3 ;I DUZ=2793 Q:'$D(^DIBT(4723,1,DFN))
+4 ;Q:DFN'=118876
+5 ;I APCLDEMO'="I" Q:$P($G(^DPT(DFN,0)),U)["DEMO,PATIENT"
+6 IF $$DEMO^APCLUTL(DFN,$GET(APCMDEMO))
QUIT
+7 DO PROCCY
DO PROCPY
End DoDot:1
N ;
+1 ;NOW DO ATTESTATION MEASURES
+2 DO PROCACY
DO PROCAPY
+3 SET APCMET=$HOROLOG
+4 QUIT
+5 ;
PROCCY ;EP - current time period
+1 KILL ^TMP($JOB)
+2 IF '$DATA(^DPT(DFN,0))
QUIT
+3 IF $PIECE(^DPT(DFN,0),U,2)=""
QUIT
+4 SET APCMEDAT=APCMED
SET APCMTIME=1
SET APCMBDAT=APCMBD
SET APCMGBL="^APCMM13C("
SET APCMFILN=9001301.0311
+5 SET APCMAGEB=$$AGE^AUPNPAT(DFN,APCMBDAT)
+6 SET APCMAGEE=$$AGE^AUPNPAT(DFN,APCMEDAT)
+7 SET APCMSEX=$PIECE(^DPT(DFN,0),U,2)
+8 ;had visit to each provider?
+9 DO CALCIND
+10 KILL ^TMP($JOB,"A")
+11 QUIT
PROCPY ;
+1 IF '$GET(APCMWPP)
QUIT
+2 KILL ^TMP($JOB)
+3 IF '$DATA(^DPT(DFN,0))
QUIT
+4 IF $PIECE(^DPT(DFN,0),U,2)=""
QUIT
+5 ;Q:"FM"'[$P(^DPT(DFN,0),U,2)
+6 SET APCMEDAT=APCMPED
SET APCMTIME=2
SET APCMBDAT=APCMPBD
SET APCMGBL="^APCMM13P("
SET APCMFILN=9001301.0411
+7 SET APCMAGEB=$$AGE^AUPNPAT(DFN,APCMBDAT)
+8 SET APCMAGEE=$$AGE^AUPNPAT(DFN,APCMEDAT)
+9 SET APCMSEX=$PIECE(^DPT(DFN,0),U,2)
+10 DO CALCIND
+11 KILL ^TMP($JOB,"A")
+12 QUIT
CALCIND ;
+1 DO CALCIND^APCM13CI
+2 QUIT
PROCACY ;EP - current time period
+1 SET APCMEDAT=APCMED
SET APCMTIME=1
SET APCMBDAT=APCMBD
SET APCMGBL="^APCMM13C("
SET APCMFILN=9001301.0311
+2 DO CALCINDA^APCM13CI
+3 QUIT
PROCAPY ;
+1 IF '$GET(APCMWPP)
QUIT
+2 SET APCMEDAT=APCMPED
SET APCMTIME=2
SET APCMBDAT=APCMPBD
SET APCMGBL="^APCMM13P("
SET APCMFILN=9001301.0411
+3 DO CALCINDA^APCM13CI
+4 QUIT
S(RPT,IND,VALUE,PROV,RT,T,F,NT) ;EP - set counter
+1 NEW N,P,Y,J
+2 ;no value to add
IF VALUE=""
QUIT
+3 IF RT=1
SET I=PROV_";VA(200,"
+4 IF RT=2
SET I=PROV_";AUTTLOC("
+5 IF T=1
Begin DoDot:1
+6 IF $GET(BQIGREF)'=""
Begin DoDot:2
+7 NEW ID
+8 SET ID=$PIECE(^APCM13OB(IND,0),U,1)
+9 IF $PIECE(^APCM13OB(IND,0),U,8)=F
SET $PIECE(@BQIGREF@(PROV,ID,"CURR"),U,1)=$PIECE($GET(@BQIGREF@(PROV,ID,"CURR")),U,1)+VALUE
+10 IF $PIECE(^APCM13OB(IND,0),U,9)=F
SET $PIECE(@BQIGREF@(PROV,ID,"CURR"),U,2)=$PIECE($GET(@BQIGREF@(PROV,ID,"CURR")),U,2)+VALUE
+11 IF $PIECE(^APCM13OB(IND,0),U,11)=F
SET $PIECE(@BQIGREF@(PROV,ID,"CURR"),U,3)=VALUE
+12 SET $PIECE(@BQIGREF@(PROV,ID,"CURR"),U,4)=$GET(APCMVALU)
End DoDot:2
QUIT
+13 SET Y=$PIECE(^DD(9001301.0311,F,0),U,4)
+14 SET N=$PIECE(Y,";")
+15 SET P=$PIECE(Y,";",2)
+16 SET J=$ORDER(^APCMM13C(RPT,11,"B",I,0))
+17 IF 'J
WRITE APCMBOMB
QUIT
+18 IF VALUE?.N
SET $PIECE(^APCMM13C(RPT,11,J,N),U,P)=$PIECE($GET(^APCMM13C(RPT,11,J,N)),U,P)+VALUE
+19 IF VALUE'?.N
SET $PIECE(^APCMM13C(RPT,11,J,N),U,P)=VALUE
+20 ;now set total multiple (1200) - NOW NO TOTAL PER TIFFANY
QUIT
+21 IF $GET(NT)=1
QUIT
+22 SET Y=$PIECE(^DD(9001301.0312,F,0),U,4)
+23 SET N=$PIECE(Y,";")
+24 SET P=$PIECE(Y,";",2)
+25 SET J=$ORDER(^APCMM13C(RPT,12,"B","TOTAL",0))
+26 IF 'J
SET ^APCMM13C(RPT,12,0)="^9001301.0312A^1^1"
SET ^APCMM13C(RPT,12,1,0)="TOTAL"
SET ^APCMM13C(RPT,12,"B","TOTAL",1)=""
SET J=1
+27 IF VALUE?.N
SET $PIECE(^APCMM13C(RPT,12,J,N),U,P)=$PIECE($GET(^APCMM13C(RPT,12,J,N)),U,P)+VALUE
QUIT
+28 SET $PIECE(^APCMM13C(RPT,12,J,N),U,P)=VALUE
End DoDot:1
QUIT
+29 IF T=2
Begin DoDot:1
+30 IF $GET(BQIGREF)'=""
Begin DoDot:2
+31 NEW ID
+32 SET ID=$PIECE(^APCM13OB(IND,0),U,1)
+33 IF $PIECE(^APCM13OB(IND,0),U,8)=F
SET $PIECE(@BQIGREF@(PROV,ID,"PREV"),U,1)=$PIECE($GET(@BQIGREF@(PROV,ID,"PREV")),U,1)+VALUE
+34 IF $PIECE(^APCM13OB(IND,0),U,9)=F
SET $PIECE(@BQIGREF@(PROV,ID,"PREV"),U,2)=$PIECE($GET(@BQIGREF@(PROV,ID,"PREV")),U,2)+VALUE
+35 IF $PIECE(^APCM13OB(IND,0),U,11)=F
SET $PIECE(@BQIGREF@(PROV,ID,"PREV"),U,3)=VALUE
+36 SET $PIECE(@BQIGREF@(PROV,ID,"PREV"),U,4)=$GET(APCMVALU)
End DoDot:2
QUIT
+37 SET Y=$PIECE(^DD(9001301.0411,F,0),U,4)
+38 SET N=$PIECE(Y,";")
+39 SET P=$PIECE(Y,";",2)
+40 SET J=$ORDER(^APCMM13P(RPT,11,"B",I,0))
+41 IF 'J
WRITE APCMBOMB
QUIT
+42 IF VALUE?.N
SET $PIECE(^APCMM13P(RPT,11,J,N),U,P)=$PIECE($GET(^APCMM13P(RPT,11,J,N)),U,P)+VALUE
+43 IF VALUE'?.N
SET $PIECE(^APCMM13P(RPT,11,J,N),U,P)=VALUE
+44 ; NOT TOTALS PER TIFFANY
QUIT
+45 ;no totals
IF $GET(NT)=1
QUIT
+46 SET Y=$PIECE(^DD(9001301.0412,F,0),U,4)
+47 SET N=$PIECE(Y,";")
+48 SET P=$PIECE(Y,";",2)
+49 SET J=$ORDER(^APCMM13P(RPT,12,"B","TOTAL",0))
+50 IF 'J
SET ^APCMM13P(RPT,12,0)="^9001301.0412A^1^1"
SET ^APCMM13P(RPT,12,1,0)="TOTAL"
SET ^APCMM13P(RPT,12,"B","TOTAL",1)=""
SET J=1
+51 IF VALUE?.N
SET $PIECE(^APCMM13P(RPT,12,J,N),U,P)=$PIECE($GET(^APCMM13P(RPT,12,J,N)),U,P)+VALUE
QUIT
+52 IF VALUE'?.N
SET $PIECE(^APCMM13P(RPT,12,J,N),U,P)=VALUE
End DoDot:1
+53 QUIT
SETLIST ;EP
+1 NEW P,APCMX,APCMO
+2 IF APCMTIME'=1
QUIT
+3 ;not a selected topic
IF '$DATA(APCMINDL(APCMIC))
QUIT
+4 SET APCMX=0
FOR
SET APCMX=$ORDER(APCMINDL(APCMIC,APCMX))
IF APCMX'=+APCMX
QUIT
Begin DoDot:1
+5 XECUTE ^APCMM13L(APCMX,12)
IF '$TEST
QUIT
+6 SET APCMINDL(APCMIC,APCMX,APCMP)=$GET(APCMINDL(APCMIC,APCMX,APCMP))+1
+7 SET APCMO=$SELECT(APCMRPTT=2:$PIECE(^APCMM13L(APCMX,0),U,6),1:$PIECE(^APCMM13L(APCMX,0),U,5))
+8 SET P=$SELECT(APCMRPTT=2:$PIECE(^DIC(4,APCMP,0),U),1:$PIECE(^VA(200,APCMP,0),U))
+9 SET ^XTMP("APCM1D",APCMJ,APCMH,"LIST",$PIECE(^APCM13OB(APCMIC,0),U,4),APCMIC,APCMO,APCMX,P,$SELECT($PIECE($GET(^AUPNPAT(DFN,11)),U,18)]"":$PIECE(^AUPNPAT(DFN,11),U,18),1:"UNKNOWN"),$PIECE(^DPT(DFN,0),U,2),$$AGE^AUPNPAT(DFN,APCMBDAT),DFN)
=...
... $GET(APCMVALU)
End DoDot:1
+10 QUIT
H100(R,BD,ED) ;
+1 NEW ID,C,Y,X,VMED,V
+2 SET C=0
+3 SET ID=$$FMADD^XLFDT(BD,-1)
+4 FOR
SET ID=$ORDER(^PSRX("AC",ID))
IF ID'=+ID!(C>100)!(ID>ED)
QUIT
Begin DoDot:1
+5 SET X=0
FOR
SET X=$ORDER(^PSRX("AC",ID,X))
IF X'=+X!(C>100)
QUIT
Begin DoDot:2
+6 IF $PIECE($GET(^PSRX(X,0)),U,4)'=R
QUIT
+7 IF $PIECE($GET(^PSRX(X,"STA")),"^")=13
QUIT
+8 ;SKIP ER CLINIC OR H VISIT, GET VISIT FROM V MED
+9 SET VMED=$PIECE($GET(^PSRX(X,999999911)),U,1)
+10 IF 'VMED
QUIT
+11 SET V=$PIECE($GET(^AUPNVMED(VMED,0)),U,3)
+12 IF 'V
QUIT
+13 IF '$DATA(^AUPNVSIT(V,0))
QUIT
+14 IF $PIECE(^AUPNVSIT(V,0),U,7)="H"
QUIT
+15 IF $$CLINIC^APCLV(V,"C")=30
QUIT
+16 SET C=C+1
End DoDot:2
End DoDot:1
+17 QUIT $SELECT(C>100:1,1:"")
VST(R,BD,ED) ;did this provider see anyone over 2
+1 NEW SD,A,B,C,G,V,T
+2 SET T=$ORDER(^APCMMUCN("B","INTERIM STAGE 1 2013",0))
+3 SET SD=$$FMADD^XLFDT(BD,-1)
+4 SET SD=SD_".9999"
+5 SET G=""
+6 FOR
SET SD=$ORDER(^AUPNVSIT("B",SD))
IF SD'=+SD!($PIECE(SD,".")>ED)!($$GOTALL(G))
QUIT
Begin DoDot:1
+7 SET V=0
FOR
SET V=$ORDER(^AUPNVSIT("B",SD,V))
IF V'=+V!($$GOTALL(G))
QUIT
Begin DoDot:2
+8 SET B=0
SET C=0
FOR
SET B=$ORDER(^AUPNVPRV("AD",V,B))
IF B'=+B
QUIT
Begin DoDot:3
+9 IF '$DATA(^AUPNVPRV(B,0))
QUIT
+10 IF $PIECE(^AUPNVPRV(B,0),U,1)'=R
QUIT
+11 IF $PIECE(^AUPNVPRV(B,0),U,4)'="P"
QUIT
+12 SET C=1
End DoDot:3
+13 IF 'C
QUIT
+14 SET $PIECE(G,U,1)=1
+15 IF $$AGE^AUPNPAT($PIECE(^AUPNVSIT(V,0),U,5),$PIECE(BD,"."))>2
SET $PIECE(G,U,2)=1
+16 IF $$AGE^AUPNPAT($PIECE(^AUPNVSIT(V,0),U,5),$PIECE(BD,"."))>12
SET $PIECE(G,U,3)=1
+17 SET C=$$CLINIC^APCLV(V,"C")
+18 ;not an exclusion
IF T
IF C]""
IF '$DATA(^APCMMUCN(T,14,"B",C))
SET $PIECE(G,U,4)=1
+19 ;not an exclusion for imm reg
IF $DATA(^AUPNVIMM("AD",V))
SET $PIECE(G,U,5)=1
+20 IF $$DOB^AUPNPAT($PIECE(^AUPNVSIT(V,0),U,5))>BD
SET A=$$AGE^AUPNPAT($PIECE(^AUPNVSIT(V,0),U,5),BD)
IF A<6!(A>64)
SET $PIECE(G,U,6)=1
End DoDot:2
End DoDot:1
+21 QUIT G
+22 ;
GOTALL(%) ;EP
+1 NEW Y
+2 SET Y=$PIECE(%,U,1)+$PIECE(%,U,2)+$PIECE(%,U,3)+$PIECE(%,U,4)+$PIECE(%,U,5)+$PIECE(%,U,6)
+3 IF Y=6
QUIT 1
+4 QUIT 0
VSTH(R,BD,ED) ;did this HOSPITAL HAVE THESE VISITS
+1 NEW SD,A,B,C,G,V,T,O,P,Q,E,J,S
+2 SET T=$ORDER(^APCMMUCN("B","INTERIM STAGE 1 2013",0))
+3 SET SD=$$FMADD^XLFDT(BD,-1)
+4 SET SD=SD_".9999"
+5 SET G=""
+6 FOR
SET SD=$ORDER(^AUPNVSIT("B",SD))
IF SD'=+SD!($PIECE(SD,".")>ED)!($$GOTALLH(G))
QUIT
Begin DoDot:1
+7 SET V=0
FOR
SET V=$ORDER(^AUPNVSIT("B",SD,V))
IF V'=+V!($$GOTALLH(G))
QUIT
Begin DoDot:2
+8 IF $PIECE(^AUPNVSIT(V,0),U,6)'=R
QUIT
+9 IF '$$HOSER^APCM13E6(V,R)
QUIT
+10 SET $PIECE(G,U,1)=1
+11 SET A=$$AGE^AUPNPAT($PIECE(^AUPNVSIT(V,0),U,5),$PIECE(BD,"."))
IF A>2
SET $PIECE(G,U,2)=1
+12 IF A>12
SET $PIECE(G,U,3)=1
+13 ;S C=$$CLINIC^APCLV(V,"C")
+14 ;I T,C]"",'$D(^APCMMUCN(T,14,"B",C)) S $P(G,U,4)=1 ;not an exclusion
+15 SET $PIECE(G,U,4)=1
+16 ;not an exclusion for imm reg
IF $DATA(^AUPNVIMM("AD",V))
SET $PIECE(G,U,5)=1
+17 ;check age
+18 IF A<6!(A>64)
SET $PIECE(G,U,6)=1
+19 IF $PIECE(^AUPNVSIT(V,0),U,7)="H"
SET A=$$AGE^AUPNPAT($PIECE(^AUPNVSIT(V,0),U,5),$$VD^APCLV(V))
IF A>64
SET $PIECE(G,U,7)=1
+20 ;was there any requests for electronic discharge instructions? check TIU notes
+21 IF $$TIUDCEL(V)
SET $PIECE(G,U,9)=1
+22 ;is there a referral for this visit?
+23 SET P=$PIECE(^AUPNVSIT(V,0),U,5)
SET J=""
+24 SET O=$$FMADD^XLFDT($$VD^APCLV(V),-1)
SET E=$$FMADD^XLFDT($$DSCHDATE^APCM13E6(V),1)
SET J=""
+25 FOR
SET O=$ORDER(^BMCREF("AA",P,O))
IF O'=+O!(J)!(O>E)
QUIT
Begin DoDot:3
+26 SET Q=0
FOR
SET Q=$ORDER(^BMCREF("AA",P,O,Q))
IF Q'=+Q!(J)
QUIT
Begin DoDot:4
+27 SET S=$PIECE(^BMCREF(Q,0),U,15)
+28 ;not a A or C1
IF S'="A"
IF S'="C1"
QUIT
+29 IF $PIECE(^BMCREF(Q,0),U,4)="N"
QUIT
+30 IF $PIECE(^BMCREF(Q,0),U,5)'=R
QUIT
+31 SET J=1
End DoDot:4
End DoDot:3
+32 IF J=1
SET $PIECE(G,U,8)=1
End DoDot:2
End DoDot:1
+33 QUIT G
TIUDCEL(%) ;any electronic dc instruction TIU Notes
+1 NEW A,B,C
+2 SET A=0
SET B=0
FOR
SET A=$ORDER(^AUPNVNOT("AD",%,A))
IF A'=+A!(B)
QUIT
Begin DoDot:1
+3 SET C=$$VAL^XBDIQ1(9000010.28,A,.01)
+4 IF $$UP^XLFSTR(C)="E-COPY DISCHARGE INSTR RECEIVED"
SET B=1
QUIT
+5 IF $$UP^XLFSTR(C)="E-COPY DISCHARGE INSTR NOT RECEIVED"
SET B=1
QUIT
End DoDot:1
+6 QUIT B
GOTALLH(%) ;EP
+1 NEW Y
+2 SET Y=$PIECE(%,U,1)+$PIECE(%,U,2)+$PIECE(%,U,3)+$PIECE(%,U,4)+$PIECE(%,U,5)+$PIECE(%,U,6)+$PIECE(%,U,7)+$PIECE(%,U,8)+$PIECE(%,U,9)
+3 IF Y=9
QUIT 1
+4 QUIT 0
ROI ;
+1 NEW X
+2 SET X=$ORDER(^APCM13OB("B","S1.011.EP",0))
+3 ;don't bother as this measure isn't in the report
IF '$DATA(APCMIND(X))
QUIT
+4 NEW APCMD,APCMX,APCMPAT,X,APCMP
+5 KILL APCMECHI
+6 SET X=0
FOR
SET X=$ORDER(APCMPRV(X))
IF X'=+X
QUIT
SET APCMECHI(X,1)=""
+7 SET X=0
FOR
SET X=$ORDER(APCMPRV(X))
IF X'=+X
QUIT
SET APCMECHI(X,2)=""
+8 ;LOOP THROUGH ROI AND IF I FIND 1 FOR THE PROVIDER THEN KILL OFF APCMECHI - exclusion
+9 SET APCMD=$$FMADD^XLFDT(APCMBD,-1)
+10 SET APCM4D=$$FMADD^XLFDT(APCMED,-4)
+11 FOR
SET APCMD=$ORDER(^BRNREC("B",APCMD))
IF APCMD'=+APCMD!(APCMD>APCM4D)
QUIT
Begin DoDot:1
+12 SET APCMX=0
FOR
SET APCMX=$ORDER(^BRNREC("B",APCMD,APCMX))
IF APCMX'=+APCMX
QUIT
Begin DoDot:2
+13 ;not an electronic request
IF $PIECE($GET(^BRNREC(APCMX,11)),U,1)'="E"
QUIT
+14 SET APCMPAT=$PIECE($GET(^BRNREC(APCMX,0)),U,3)
+15 KILL APCMVSTS,APCMHVTP
+16 DO ALLV^APCLAPIU(APCMPAT,$$FMADD^XLFDT(APCMED,-365),APCMED,"APCMVSTS")
+17 SET APCMP=0
FOR
SET APCMP=$ORDER(APCMPRV(APCMP))
IF APCMP'=+APCMP
QUIT
Begin DoDot:3
+18 SET APCMHV=$$HADV^APCM13CI(APCMPAT,APCMP,$$FMADD^XLFDT(APCMED,-365),APCMED,.APCMVSTS)
+19 IF 'APCMHV
QUIT
+20 ;had a visit with this patient and thus had a request, so no exclusion
KILL APCMECHI(APCMP,1)
End DoDot:3
End DoDot:2
End DoDot:1
+21 IF '$GET(APCMWPP)
QUIT
+22 SET APCMD=$$FMADD^XLFDT(APCMPBD,-1)
+23 SET APCM4D=$$FMADD^XLFDT(APCMPED,-4)
+24 FOR
SET APCMD=$ORDER(^BRNREC("B",APCMD))
IF APCMD'=+APCMD!(APCMD>APCM4D)
QUIT
Begin DoDot:1
+25 SET APCMX=0
FOR
SET APCMX=$ORDER(^BRNREC("B",APCMD,APCMX))
IF APCMX'=+APCMX
QUIT
Begin DoDot:2
+26 ;not an electronic request
IF $PIECE($GET(^BRNREC(APCMX,11)),U,1)'="E"
QUIT
+27 SET APCMPAT=$PIECE($GET(^BRNREC(APCMX,0)),U,3)
+28 KILL APCMVSTS,APCMHVTP
+29 DO ALLV^APCLAPIU(APCMPAT,$$FMADD^XLFDT(APCMPED,-365),APCMPED,"APCMVSTS")
+30 SET APCMP=0
FOR
SET APCMP=$ORDER(APCMPRV(APCMP))
IF APCMP'=+APCMP
QUIT
Begin DoDot:3
+31 SET APCMHV=$$HADV^APCM13CI(APCMPAT,APCMP,$$FMADD^XLFDT(APCMPED,-365),APCMPED,.APCMVSTS)
+32 IF 'APCMHV
QUIT
+33 ;had a visit with this patient and thus had a request, so no exclusion
KILL APCMECHI(APCMP,2)
End DoDot:3
End DoDot:2
End DoDot:1
+34 QUIT
RCIS ;did provider have any referrals for patients he/she saw
+1 NEW X
+2 SET X=$ORDER(^APCM13OB("B","S1.023.EP",0))
+3 ;don't bother as this measure isn't in the report
IF '$DATA(APCMIND(X))
QUIT
+4 NEW APCMD,APCMX,APCMPAT,X,APCMP
+5 KILL APCMRCIS
+6 SET X=0
FOR
SET X=$ORDER(APCMPRV(X))
IF X'=+X
QUIT
SET APCMRCIS(X,1)=""
+7 SET X=0
FOR
SET X=$ORDER(APCMPRV(X))
IF X'=+X
QUIT
SET APCMRCIS(X,2)=""
+8 ;LOOP THROUGH ROI AND IF I FIND 1 FOR THE PROVIDER THEN KILL OFF APCMRCIS - exclusion
+9 SET APCMD=$$FMADD^XLFDT(APCMBD,-1)
+10 FOR
SET APCMD=$ORDER(^BMCREF("B",APCMD))
IF APCMD'=+APCMD!(APCMD>APCMED)
QUIT
Begin DoDot:1
+11 SET APCMX=0
FOR
SET APCMX=$ORDER(^BMCREF("B",APCMD,APCMX))
IF APCMX'=+APCMX
QUIT
Begin DoDot:2
+12 SET APCMPAT=$PIECE($GET(^BMCREF(APCMX,0)),U,3)
+13 SET R=$PIECE(^BMCREF(APCMX,0),U,6)
+14 IF R=""
QUIT
+15 ;NOT A PROVIDER WE WANT
IF '$DATA(APCMPRV(R))
QUIT
+16 SET S=$PIECE(^BMCREF(APCMX,0),U,15)
+17 ;not a A or C1
IF S'="A"
IF S'="C1"
QUIT
+18 IF $PIECE(^BMCREF(APCMX,0),U,4)="N"
QUIT
+19 ;K APCMVSTS,APCMHVTP
+20 ;D ALLV^APCLAPIU(APCMPAT,APCMBD,APCMED,"APCMVSTS")
+21 ;S APCMP=0 F S APCMP=$O(APCMPRV(APCMP)) Q:APCMP'=+APCMP D
+22 ;.S APCMHV=$$HADV^APCM13CI(APCMPAT,APCMP,APCMBD,APCMED,.APCMVSTS)
+23 ;.Q:'APCMHV
+24 ;had a visit with this patient and had a referral for this patient so no exclusion
KILL APCMRCIS(R,1)
End DoDot:2
End DoDot:1
+25 IF '$GET(APCMWPP)
QUIT
+26 SET APCMD=$$FMADD^XLFDT(APCMPBD,-1)
+27 FOR
SET APCMD=$ORDER(^BMCREF("B",APCMD))
IF APCMD'=+APCMD!(APCMD>APCMPED)
QUIT
Begin DoDot:1
+28 SET APCMX=0
FOR
SET APCMX=$ORDER(^BMCREF("B",APCMD,APCMX))
IF APCMX'=+APCMX
QUIT
Begin DoDot:2
+29 SET APCMPAT=$PIECE($GET(^BMCREF(APCMX,0)),U,3)
+30 SET R=$PIECE(^BMCREF(APCMX,0),U,6)
+31 IF R=""
QUIT
+32 ;NOT A PROVIDER WE WANT
IF '$DATA(APCMPRV(R))
QUIT
+33 SET S=$PIECE(^BMCREF(APCMX,0),U,15)
+34 ;not a A or C1
IF S'="A"
IF S'="C1"
QUIT
+35 IF $PIECE(^BMCREF(APCMX,0),U,4)="N"
QUIT
+36 ;K APCMVSTS,APCMHVTP
+37 ;D ALLV^APCLAPIU(APCMPAT,APCMPBD,APCMPED,"APCMVSTS")
+38 ;S APCMP=0 F S APCMP=$O(APCMPRV(APCMP)) Q:APCMP'=+APCMP D
+39 ;.S APCMHV=$$HADV^APCM13CI(APCMPAT,APCMP,APCMPBD,APCMPED,.APCMVSTS)
+40 ;.Q:'APCMHV
+41 ;had a visit with this patient and thus had a request, so no exclusion
KILL APCMRCIS(R,2)
End DoDot:2
End DoDot:1
+42 QUIT
