- APCM11E1 ; IHS/CMI/LAB - IHS MU 24 Feb 2011 10:32 AM ;
- ;;1.0;IHS MU PERFORMANCE REPORTS;**1,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^APCM11E7
- 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 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)=""
- ;Q:"FM"'[$P(^DPT(DFN,0),U,2)
- S APCMEDAT=APCMED,APCMTIME=1,APCMBDAT=APCMBD,APCMGBL="^APCMMUDC(",APCMFILN=9001300.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="^APCMMUDP(",APCMFILN=9001300.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^APCM11CI
- Q
- PROCACY ;EP - current time period
- S APCMEDAT=APCMED,APCMTIME=1,APCMBDAT=APCMBD,APCMGBL="^APCMMUDC(",APCMFILN=9001300.0311
- D CALCINDA^APCM11CI
- Q
- PROCAPY ;
- Q:'$G(APCMWPP)
- S APCMEDAT=APCMPED,APCMTIME=2,APCMBDAT=APCMPBD,APCMGBL="^APCMMUDP(",APCMFILN=9001300.0411
- D CALCINDA^APCM11CI
- 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(^APCMMUM(IND,0),U,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
- ..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
- ..I $P(^APCMMUM(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(9001300.0311,F,0),U,4)
- .S N=$P(Y,";")
- .S P=$P(Y,";",2)
- .S J=$O(^APCMMUDC(RPT,11,"B",I,0))
- .I 'J W APCMBOMB Q
- .I VALUE?.N S $P(^APCMMUDC(RPT,11,J,N),U,P)=$P($G(^APCMMUDC(RPT,11,J,N)),U,P)+VALUE
- .I VALUE'?.N S $P(^APCMMUDC(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(9001300.0312,F,0),U,4)
- .S N=$P(Y,";")
- .S P=$P(Y,";",2)
- .S J=$O(^APCMMUDC(RPT,12,"B","TOTAL",0))
- .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
- .I VALUE?.N S $P(^APCMMUDC(RPT,12,J,N),U,P)=$P($G(^APCMMUDC(RPT,12,J,N)),U,P)+VALUE Q
- .S $P(^APCMMUDC(RPT,12,J,N),U,P)=VALUE
- I T=2 D
- .I $G(BQIGREF)'="" D Q
- ..NEW ID
- ..S ID=$P(^APCMMUM(IND,0),U,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
- ..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
- ..I $P(^APCMMUM(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(9001300.0411,F,0),U,4)
- .S N=$P(Y,";")
- .S P=$P(Y,";",2)
- .S J=$O(^APCMMUDP(RPT,11,"B",I,0))
- .I 'J W APCMBOMB Q
- .I VALUE?.N S $P(^APCMMUDP(RPT,11,J,N),U,P)=$P($G(^APCMMUDP(RPT,11,J,N)),U,P)+VALUE
- .I VALUE'?.N S $P(^APCMMUDP(RPT,11,J,N),U,P)=VALUE
- .Q ; NOT TOTALS PER TIFFANY
- .Q:$G(NT)=1 ;no totals
- .S Y=$P(^DD(9001300.0412,F,0),U,4)
- .S N=$P(Y,";")
- .S P=$P(Y,";",2)
- .S J=$O(^APCMMUDP(RPT,12,"B","TOTAL",0))
- .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
- .I VALUE?.N S $P(^APCMMUDP(RPT,12,J,N),U,P)=$P($G(^APCMMUDP(RPT,12,J,N)),U,P)+VALUE Q
- .I VALUE'?.N S $P(^APCMMUDP(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 ^APCMMUPL(APCMX,12) Q:'$T
- .S APCMINDL(APCMIC,APCMX,APCMP)=$G(APCMINDL(APCMIC,APCMX,APCMP))+1
- .S APCMO=$S(APCMRPTT=2:$P(^APCMMUPL(APCMX,0),U,6),1:$P(^APCMMUPL(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(^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)
- Q
- H100(R,BD,ED) ;
- NEW ID,C,Y,X
- S C=0
- S ID=$$FMADD^XLFDT(BD,-1)
- F S ID=$O(^PSRX("AC",ID)) Q:ID'=+ID!(C>100) 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 2011",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 2011",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^APCM11E6(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^APCM11E6(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(^APCMMUM("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^APCM11CI(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^APCM11CI(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(^APCMMUM("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^APCM11CI(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^APCM11CI(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
- 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
- +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^APCM11E7
- 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 APCLDEMO'="I" Q:$P($G(^DPT(DFN,0)),U)["DEMO,PATIENT"
- +4 IF $$DEMO^APCLUTL(DFN,$GET(APCMDEMO))
- QUIT
- +5 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 ;Q:"FM"'[$P(^DPT(DFN,0),U,2)
- +5 SET APCMEDAT=APCMED
- SET APCMTIME=1
- SET APCMBDAT=APCMBD
- SET APCMGBL="^APCMMUDC("
- SET APCMFILN=9001300.0311
- +6 SET APCMAGEB=$$AGE^AUPNPAT(DFN,APCMBDAT)
- +7 SET APCMAGEE=$$AGE^AUPNPAT(DFN,APCMEDAT)
- +8 SET APCMSEX=$PIECE(^DPT(DFN,0),U,2)
- +9 ;had visit to each provider?
- +10 DO CALCIND
- +11 KILL ^TMP($JOB,"A")
- +12 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="^APCMMUDP("
- SET APCMFILN=9001300.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^APCM11CI
- +2 QUIT
- PROCACY ;EP - current time period
- +1 SET APCMEDAT=APCMED
- SET APCMTIME=1
- SET APCMBDAT=APCMBD
- SET APCMGBL="^APCMMUDC("
- SET APCMFILN=9001300.0311
- +2 DO CALCINDA^APCM11CI
- +3 QUIT
- PROCAPY ;
- +1 IF '$GET(APCMWPP)
- QUIT
- +2 SET APCMEDAT=APCMPED
- SET APCMTIME=2
- SET APCMBDAT=APCMPBD
- SET APCMGBL="^APCMMUDP("
- SET APCMFILN=9001300.0411
- +3 DO CALCINDA^APCM11CI
- +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(^APCMMUM(IND,0),U,1)
- +9 IF $PIECE(^APCMMUM(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(^APCMMUM(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(^APCMMUM(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(9001300.0311,F,0),U,4)
- +14 SET N=$PIECE(Y,";")
- +15 SET P=$PIECE(Y,";",2)
- +16 SET J=$ORDER(^APCMMUDC(RPT,11,"B",I,0))
- +17 IF 'J
- WRITE APCMBOMB
- QUIT
- +18 IF VALUE?.N
- SET $PIECE(^APCMMUDC(RPT,11,J,N),U,P)=$PIECE($GET(^APCMMUDC(RPT,11,J,N)),U,P)+VALUE
- +19 IF VALUE'?.N
- SET $PIECE(^APCMMUDC(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(9001300.0312,F,0),U,4)
- +23 SET N=$PIECE(Y,";")
- +24 SET P=$PIECE(Y,";",2)
- +25 SET J=$ORDER(^APCMMUDC(RPT,12,"B","TOTAL",0))
- +26 IF 'J
- SET ^APCMMUDC(RPT,12,0)="^9001300.0312A^1^1"
- SET ^APCMMUDC(RPT,12,1,0)="TOTAL"
- SET ^APCMMUDC(RPT,12,"B","TOTAL",1)=""
- SET J=1
- +27 IF VALUE?.N
- SET $PIECE(^APCMMUDC(RPT,12,J,N),U,P)=$PIECE($GET(^APCMMUDC(RPT,12,J,N)),U,P)+VALUE
- QUIT
- +28 SET $PIECE(^APCMMUDC(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(^APCMMUM(IND,0),U,1)
- +33 IF $PIECE(^APCMMUM(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(^APCMMUM(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(^APCMMUM(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(9001300.0411,F,0),U,4)
- +38 SET N=$PIECE(Y,";")
- +39 SET P=$PIECE(Y,";",2)
- +40 SET J=$ORDER(^APCMMUDP(RPT,11,"B",I,0))
- +41 IF 'J
- WRITE APCMBOMB
- QUIT
- +42 IF VALUE?.N
- SET $PIECE(^APCMMUDP(RPT,11,J,N),U,P)=$PIECE($GET(^APCMMUDP(RPT,11,J,N)),U,P)+VALUE
- +43 IF VALUE'?.N
- SET $PIECE(^APCMMUDP(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(9001300.0412,F,0),U,4)
- +47 SET N=$PIECE(Y,";")
- +48 SET P=$PIECE(Y,";",2)
- +49 SET J=$ORDER(^APCMMUDP(RPT,12,"B","TOTAL",0))
- +50 IF 'J
- SET ^APCMMUDP(RPT,12,0)="^9001300.0412A^1^1"
- SET ^APCMMUDP(RPT,12,1,0)="TOTAL"
- SET ^APCMMUDP(RPT,12,"B","TOTAL",1)=""
- SET J=1
- +51 IF VALUE?.N
- SET $PIECE(^APCMMUDP(RPT,12,J,N),U,P)=$PIECE($GET(^APCMMUDP(RPT,12,J,N)),U,P)+VALUE
- QUIT
- +52 IF VALUE'?.N
- SET $PIECE(^APCMMUDP(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 ^APCMMUPL(APCMX,12)
- IF '$TEST
- QUIT
- +6 SET APCMINDL(APCMIC,APCMX,APCMP)=$GET(APCMINDL(APCMIC,APCMX,APCMP))+1
- +7 SET APCMO=$SELECT(APCMRPTT=2:$PIECE(^APCMMUPL(APCMX,0),U,6),1:$PIECE(^APCMMUPL(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(^APCMMUM(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
- +2 SET C=0
- +3 SET ID=$$FMADD^XLFDT(BD,-1)
- +4 FOR
- SET ID=$ORDER(^PSRX("AC",ID))
- IF ID'=+ID!(C>100)
- 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 2011",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 2011",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^APCM11E6(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^APCM11E6(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(^APCMMUM("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^APCM11CI(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^APCM11CI(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(^APCMMUM("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^APCM11CI(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^APCM11CI(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