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

APCM2AE1.m

Go to the documentation of this file. 
  1. APCM2AE1 ; IHS/CMI/LAB - IHS MU 24 Feb 2015 10:32 AM ; 28 Jul 2016  11:41 AM
  1.  ;;1.0;MU PERFORMANCE REPORTS;**7,8**;MAR 26, 2012;Build 22
  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.  S APCMSEME=0  ;FOR SEM ERROR -1 FROM PHR
  1.  S APCMVDTE=0  ;FOR VDT ERROR -1 FROM PHR CALL
  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 APCMOFFV
  1.  .K APCM2AON
  1.  .K APCMIMME
  1.  .K APCMN565
  1.  .K APCMHO65
  1.  .K APCMNOEC
  1.  .S X=APCMFAC  S APCMX=$$VSTH(APCMFAC,APCMBD,APCMED,APCMMETH) D
  1.  ..I '$P(APCMX,U,3) S APCM2AON(X,1)=""
  1.  ..I '$P(APCMX,U,1) S APCMOFFV(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,9) S APCMNOEC(X,1)=""
  1.  .;
  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.  K APCM2AON
  1.  K APCMIMME
  1.  K APCMOFFV
  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 APCM2AON(X,1)=""  ;smk status excl
  1.  .I '$P(APCMX,U,1) S APCMOFFV(X,1)=""  ;
  1.  .I '$P(APCMX,U,5) S APCMIMME(X,1)=""  ;imm reg excl
  1. N1 ;
  1.  ;NOW GO THROUGH ALL PROVIDER'S VISIT IN 24 MONTHS BEFORE EHR REPORTING PERIOD, SEE IF ANY VISITS
  1.  K APCM2ABR
  1.  S X=0  F  S X=$O(APCMPRV(X)) Q:X'=+X  D
  1.  .S APCMX=$$VST24(X,$$FMADD^XLFDT(APCMBD,-(24*30.5)),$$FMADD^XLFDT(APCMBD,-1))
  1.  .I 'APCMX S APCM2ABR(X)=""  ;EXCL FROM PAT REMINDERS
  1.  ;
  1. PROC1 ;
  1.  S DFN=0 F  S DFN=$O(^AUPNPAT(DFN)) Q:DFN'=+DFN  D
  1.  .Q:'$D(^DPT(DFN,0))
  1.  .;I DUZ=2793 Q:'$D(^DIBT(4723,1,DFN))
  1.  .;I DUZ=2793 Q:DFN'=2972
  1.  .Q:$$DEMO^APCLUTL(DFN,$G(APCMDEMO))
  1.  .D PROCCY
  1. N ;
  1.  ;NOW DO ATTESTATION MEASURES
  1.  D PROCACY
  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.  S APCMEDAT=APCMED,APCMTIME=1,APCMBDAT=APCMBD,APCMGBL="^APCMM25C(",APCMFILN=9001304.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. CALCIND ;
  1.  D CALCIND^APCM2ACI
  1.  Q
  1. PROCACY ;EP - current time period
  1.  S APCMEDAT=APCMED,APCMTIME=1,APCMBDAT=APCMBD,APCMGBL="^APCMM25C(",APCMFILN=9001304.0311
  1.  D CALCINDA^APCM2ACI
  1.  Q
  1. S(RPT,IND,VALUE,PROV,RT,T,F,NT) ;EP - set counter
  1.  NEW N,P,Y,J,I,ID
  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(^APCM25OB(IND,0),U,1)
  1.  ..I $P(^APCM25OB(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(^APCM25OB(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(^APCM25OB(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(9001304.0311,F,0),U,4)
  1.  .S N=$P(Y,";")
  1.  .S P=$P(Y,";",2)
  1.  .S J=$O(^APCMM25C(RPT,11,"B",I,0))
  1.  .I 'J W APCMBOMB Q
  1.  .I VALUE?.N S $P(^APCMM25C(RPT,11,J,N),U,P)=$P($G(^APCMM25C(RPT,11,J,N)),U,P)+VALUE
  1.  .I VALUE'?.N S $P(^APCMM25C(RPT,11,J,N),U,P)=VALUE
  1.  .Q
  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 ^APCMM25L(APCMX,12) Q:'$T
  1.  .S APCMINDL(APCMIC,APCMX,APCMP)=$G(APCMINDL(APCMIC,APCMX,APCMP))+1
  1.  .S APCMO=$S(APCMRPTT=2:$P(^APCMM25L(APCMX,0),U,6),1:$P(^APCMM25L(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(^APCM25OB(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,VMED,V
  1.  S C=0
  1.  S ID=$$FMADD^XLFDT(BD,-1)
  1.  F  S ID=$O(^PSRX("AC",ID)) Q:ID'=+ID!(C>100)!(ID>ED)  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 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  ;not to this provider
  1.  ..S C=$$CLINIC^APCLV(V,"C")
  1.  ..I C=30 Q  ;no ER per Carmen patch 1
  1.  ..I C=77 Q  ;no case management clinic 77 per Chris
  1.  ..I C=76 Q  ;no lab
  1.  ..I C=63 Q  ;no radiology
  1.  ..I C=39 Q  ;no pharmacy
  1.  ..S $P(G,U,1)=1  ;has an office visit ;clinic summary excl
  1.  ..I $$AGE^AUPNPAT($P(^AUPNVSIT(V,0),U,5),$P(BD,"."))>12 S $P(G,U,3)=1
  1.  ..I $D(^AUPNVIMM("AD",V)) S $P(G,U,5)=1  ;not an exclusion for imm reg
  1.  Q G
  1.  ;
  1. GOTALL(%) ;EP
  1.  NEW Y
  1.  S Y=$P(%,U,1)+$P(%,U,3)+$P(%,U,5)
  1.  I Y=3 Q 1
  1.  Q 0
  1. VST24(R,BD,ED) ;did this provider see anyone over 2
  1.  NEW SD,A,B,C,G,V,T
  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)!(G)  D
  1.  .S V=0 F  S V=$O(^AUPNVSIT("B",SD,V)) Q:V'=+V!(G)  D
  1.  ..S B=0,C=0 F  S B=$O(^AUPNVPRV("AD",V,B)) Q:B'=+B!(C)  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  ;not to this provider
  1.  ..S C=$$CLINIC^APCLV(V,"C")
  1.  ..I C=30 Q  ;no ER per Carmen patch 1
  1.  ..I C=77 Q  ;no case management clinic 77 per Chris
  1.  ..I C=76 Q  ;no lab
  1.  ..I C=63 Q  ;no radiology
  1.  ..I C=39 Q  ;no pharmacy
  1.  ..S G=1  ;has an office visit ;clinic summary excl
  1.  Q G
  1. VSTH(R,BD,ED,APCMMETH) ;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","MODIFIED STAGE 2 2015",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.  ..I APCMMETH="E" Q:'$$HOSER^APCM25E6(V,R)
  1.  ..I APCMMETH="O" Q:"OH"'[$P(^AUPNVSIT(V,0),U,7)
  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 $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.  Q G
  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