Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: APCM11E1

APCM11E1.m

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