APCM14E1 ; IHS/CMI/LAB - IHS MU 24 Feb 2014 10:32 AM ;
;;1.0;IHS MU PERFORMANCE REPORTS;**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 APCMOFFV
.K APCM14ON ;SMK STATUS EXCL
.K APCMIMME ;IMM EXCL
.K APCMHO65 ;ADV DIR EXCL
.S X=APCMFAC S APCMX=$$VSTH(APCMFAC,APCMBD,APCMED,APCMMETH) D
..I '$P(APCMX,U,3) S APCM14ON(X,1)="" ;SMOKING STATUS EXCL
..I '$P(APCMX,U,1) S APCMOFFV(X,1)=""
..I '$P(APCMX,U,5) S APCMIMME(X,1)="" ;IMM REG
..I '$P(APCMX,U,7) S APCMHO65(X,1)="" ;ADV DIR EXCL
.;
K APCM100R
S X=0 F S X=$O(APCMPRV(X)) Q:X'=+X I '$$H100(X,APCMBD,APCMED) S APCM100R(X,1)="" ;S1.003.EP E-RX EXCL, DRUG FORM EXCL
K APCMOFFV
K APCM14ON
K APCMIMME
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 APCM14ON(X,1)="" ;SMK STATUS EXCL
.I '$P(APCMX,U,1) S APCMOFFV(X,1)="" ;CLIN SUM EXCL
.I '$P(APCMX,U,5) S APCMIMME(X,1)="" ;IMM REG EXCL
N1 ;
;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
;
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))
.;I DUZ=2793 Q:DFN'=5851
.Q:$$DEMO^APCLUTL(DFN,$G(APCMDEMO))
.D PROCCY
N ;
;NOW DO ATTESTATION MEASURES
D PROCACY
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="^APCMM14C(",APCMFILN=9001302.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
CALCIND ;
D CALCIND^APCM14CI
Q
PROCACY ;EP - current time period
S APCMEDAT=APCMED,APCMTIME=1,APCMBDAT=APCMBD,APCMGBL="^APCMM14C(",APCMFILN=9001302.0311
D CALCINDA^APCM14CI
Q
S(RPT,IND,VALUE,PROV,RT,T,F,NT) ;EP - set counter
NEW N,P,Y,J,I,ID
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(^APCM14OB(IND,0),U,1)
..I $P(^APCM14OB(IND,0),U,8)=F S $P(@BQIGREF@(PROV,ID,"CURR"),U,1)=$P($G(@BQIGREF@(PROV,ID,"CURR")),U,1)+VALUE
..I $P(^APCM14OB(IND,0),U,9)=F S $P(@BQIGREF@(PROV,ID,"CURR"),U,2)=$P($G(@BQIGREF@(PROV,ID,"CURR")),U,2)+VALUE
..I $P(^APCM14OB(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(9001302.0311,F,0),U,4)
.S N=$P(Y,";")
.S P=$P(Y,";",2)
.S J=$O(^APCMM14C(RPT,11,"B",I,0))
.I 'J W APCMBOMB Q
.I VALUE?.N S $P(^APCMM14C(RPT,11,J,N),U,P)=$P($G(^APCMM14C(RPT,11,J,N)),U,P)+VALUE
.I VALUE'?.N S $P(^APCMM14C(RPT,11,J,N),U,P)=VALUE
.Q
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 ^APCMM14L(APCMX,12) Q:'$T
.S APCMINDL(APCMIC,APCMX,APCMP)=$G(APCMINDL(APCMIC,APCMX,APCMP))+1
.S APCMO=$S(APCMRPTT=2:$P(^APCMM14L(APCMX,0),U,6),1:$P(^APCMM14L(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(^APCM14OB(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) ;CALCULATE EXCLUSIONS
NEW SD,A,B,C,G,V,T
S T=$O(^APCMMUCN("B","INTERIM STAGE 1 2014",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 ;not to this provider
..S C=$$CLINIC^APCLV(V,"C")
..I C=30 Q ;no ER per Carmen patch 1
..I C=77 Q ;no case management clinic 77 per Chris
..I C=76 Q ;no lab
..I C=63 Q ;no radiology
..I C=39 Q ;no pharmacy
..S $P(G,U,1)=1 ;has an office visit ;clinic summary excl
..I $$AGE^AUPNPAT($P(^AUPNVSIT(V,0),U,5),$P(BD,"."))>12 S $P(G,U,3)=1 ;SMK STATUS EXCL
..I $D(^AUPNVIMM("AD",V)) S $P(G,U,5)=1 ;not an exclusion for imm reg
Q G
;
GOTALL(%) ;EP
NEW Y
S Y=$P(%,U,1)+$P(%,U,3)+$P(%,U,5)
I Y=3 Q 1
Q 0
VSTH(R,BD,ED,APCMMETH) ;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 2014",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
..I APCMMETH="E" Q:'$$HOSER^APCM24E6(V,R)
..I APCMMETH="O" Q:"OH"'[$P(^AUPNVSIT(V,0),U,7)
..S $P(G,U,1)=1
..S A=$$AGE^AUPNPAT($P(^AUPNVSIT(V,0),U,5),$P(BD,"."))
..I A>12 S $P(G,U,3)=1
..I $D(^AUPNVIMM("AD",V)) S $P(G,U,5)=1 ;not an exclusion for imm reg
..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
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
VDT ;EP - ask additional exclusion questions for PEA
S APCMQ=0
S APCMY=$O(^APCM14OB("B","S1.020.EP",0))
Q:'$D(APCMIND(APCMY)) ;measure not being run
K APCMATTE("S1.020.EP.1")
;display exclusion text/narrative
I $O(^APCM14OB(APCMY,26,0)) D ET
I APCMPLTY="SEL"!(APCMPLTY="TAX") D G:APCMIND=1 EIND Q
.S APCMZ=0 F S APCMZ=$O(^APCM14OB(APCMY,19,APCMZ)) Q:APCMZ'=+APCMZ W !,^APCM14OB(APCMY,19,APCMZ,0)
.S APCMQ=0,APCMIND=0
.W !!!,"The View, Download, Transmit question above may be addressed as a group or"
.W !,"by individual provider. Do you want to answer for all selected providers as a"
.S DIR(0)="Y",DIR("A")="group Y/N",DIR("B")="YES" KILL DA D ^DIR KILL DIR
.I $D(DIRUT) S APCMQ=1 Q
.I 'Y S APCMIND=1 Q
.W !!,"Do all selected providers included in this report meet the broadband"
.S DIR(0)="Y",DIR("A")="Exclusion",DIR("B")="YES" KILL DA D ^DIR KILL DIR
.I $D(DIRUT) S APCMQ=1 Q
.I 'Y S APCMIND=1 Q
.S APCMP=0 F S APCMP=$O(APCMPRV(APCMP)) Q:APCMP'=+APCMP S APCMATTE("S1.020.EP.1",APCMP)="Yes"
EIND ;ask individually
S APCMP=0 F S APCMP=$O(APCMPRV(APCMP)) Q:APCMP'=+APCMP!(APCMQ) D
.S APCMZ=0 F S APCMZ=$O(^APCM14OB(APCMY,19,APCMZ)) Q:APCMZ'=+APCMZ W !,^APCM14OB(APCMY,19,APCMZ,0)
.S DIR(0)="Y",DIR("A")="Does "_$E($P(^VA(200,APCMP,0),U,1),1,25)_" meet the broadband exclusion",DIR("B")="YES" KILL DA D ^DIR KILL DIR
.I $D(DIRUT) S APCMQ=1 Q
.S APCMATTE("S1.020.EP.1",APCMP)=$S(Y:"Yes",1:"No")
Q
ET ;
W ! S APCMZ=0 F S APCMZ=$O(^APCM14OB(APCMY,26,APCMZ)) Q:APCMZ'=+APCMZ W !,^APCM14OB(APCMY,26,APCMZ,0)
W !
Q
APCM14E1 ; IHS/CMI/LAB - IHS MU 24 Feb 2014 10:32 AM ;
+1 ;;1.0;IHS MU PERFORMANCE REPORTS;**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 ;D 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 APCMOFFV
+9 ;SMK STATUS EXCL
KILL APCM14ON
+10 ;IMM EXCL
KILL APCMIMME
+11 ;ADV DIR EXCL
KILL APCMHO65
+12 SET X=APCMFAC
SET APCMX=$$VSTH(APCMFAC,APCMBD,APCMED,APCMMETH)
Begin DoDot:2
+13 ;SMOKING STATUS EXCL
IF '$PIECE(APCMX,U,3)
SET APCM14ON(X,1)=""
+14 IF '$PIECE(APCMX,U,1)
SET APCMOFFV(X,1)=""
+15 ;IMM REG
IF '$PIECE(APCMX,U,5)
SET APCMIMME(X,1)=""
+16 ;ADV DIR EXCL
IF '$PIECE(APCMX,U,7)
SET APCMHO65(X,1)=""
End DoDot:2
+17 ;
End DoDot:1
GOTO PROC1
+18 KILL APCM100R
+19 ;S1.003.EP E-RX EXCL, DRUG FORM EXCL
SET X=0
FOR
SET X=$ORDER(APCMPRV(X))
IF X'=+X
QUIT
IF '$$H100(X,APCMBD,APCMED)
SET APCM100R(X,1)=""
+20 KILL APCMOFFV
+21 KILL APCM14ON
+22 KILL APCMIMME
+23 SET X=0
FOR
SET X=$ORDER(APCMPRV(X))
IF X'=+X
QUIT
SET APCMX=$$VST(X,APCMBD,APCMED)
Begin DoDot:1
+24 ;SMK STATUS EXCL
IF '$PIECE(APCMX,U,3)
SET APCM14ON(X,1)=""
+25 ;CLIN SUM EXCL
IF '$PIECE(APCMX,U,1)
SET APCMOFFV(X,1)=""
+26 ;IMM REG EXCL
IF '$PIECE(APCMX,U,5)
SET APCMIMME(X,1)=""
End DoDot:1
N1 ;
+1 ;any patients 0-5 or >64?
+2 SET APCMN565(1)=1
+3 SET P=0
FOR
SET P=$ORDER(^DPT(P))
IF P'=+P!(APCMN565(1)=0)
QUIT
Begin DoDot:1
+4 SET X=$$DOD^AUPNPAT(P)
+5 IF X
IF X'>APCMED
QUIT
+6 ;born after time period begin date
IF $$DOB^AUPNPAT(P)>APCMBD
QUIT
+7 SET X=$PIECE($GET(^AUPNPAT(P,41,DUZ(2),0)),U,3)
+8 IF X
IF X'>APCMED
QUIT
+9 SET A=$$AGE^AUPNPAT(P,APCMBD)
+10 IF A<6
SET APCMN565(1)=0
QUIT
+11 IF A>64
SET APCMN565(1)=0
QUIT
End DoDot:1
+12 ;
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 ;I DUZ=2793 Q:DFN'=5851
+5 IF $$DEMO^APCLUTL(DFN,$GET(APCMDEMO))
QUIT
+6 DO PROCCY
End DoDot:1
N ;
+1 ;NOW DO ATTESTATION MEASURES
+2 DO PROCACY
+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="^APCMM14C("
SET APCMFILN=9001302.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
CALCIND ;
+1 DO CALCIND^APCM14CI
+2 QUIT
PROCACY ;EP - current time period
+1 SET APCMEDAT=APCMED
SET APCMTIME=1
SET APCMBDAT=APCMBD
SET APCMGBL="^APCMM14C("
SET APCMFILN=9001302.0311
+2 DO CALCINDA^APCM14CI
+3 QUIT
S(RPT,IND,VALUE,PROV,RT,T,F,NT) ;EP - set counter
+1 NEW N,P,Y,J,I,ID
+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(^APCM14OB(IND,0),U,1)
+9 IF $PIECE(^APCM14OB(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(^APCM14OB(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(^APCM14OB(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(9001302.0311,F,0),U,4)
+14 SET N=$PIECE(Y,";")
+15 SET P=$PIECE(Y,";",2)
+16 SET J=$ORDER(^APCMM14C(RPT,11,"B",I,0))
+17 IF 'J
WRITE APCMBOMB
QUIT
+18 IF VALUE?.N
SET $PIECE(^APCMM14C(RPT,11,J,N),U,P)=$PIECE($GET(^APCMM14C(RPT,11,J,N)),U,P)+VALUE
+19 IF VALUE'?.N
SET $PIECE(^APCMM14C(RPT,11,J,N),U,P)=VALUE
+20 QUIT
End DoDot:1
QUIT
+21 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 ^APCMM14L(APCMX,12)
IF '$TEST
QUIT
+6 SET APCMINDL(APCMIC,APCMX,APCMP)=$GET(APCMINDL(APCMIC,APCMX,APCMP))+1
+7 SET APCMO=$SELECT(APCMRPTT=2:$PIECE(^APCMM14L(APCMX,0),U,6),1:$PIECE(^APCMM14L(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(^APCM14OB(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) ;CALCULATE EXCLUSIONS
+1 NEW SD,A,B,C,G,V,T
+2 SET T=$ORDER(^APCMMUCN("B","INTERIM STAGE 1 2014",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 ;not to this provider
IF 'C
QUIT
+14 SET C=$$CLINIC^APCLV(V,"C")
+15 ;no ER per Carmen patch 1
IF C=30
QUIT
+16 ;no case management clinic 77 per Chris
IF C=77
QUIT
+17 ;no lab
IF C=76
QUIT
+18 ;no radiology
IF C=63
QUIT
+19 ;no pharmacy
IF C=39
QUIT
+20 ;has an office visit ;clinic summary excl
SET $PIECE(G,U,1)=1
+21 ;SMK STATUS EXCL
IF $$AGE^AUPNPAT($PIECE(^AUPNVSIT(V,0),U,5),$PIECE(BD,"."))>12
SET $PIECE(G,U,3)=1
+22 ;not an exclusion for imm reg
IF $DATA(^AUPNVIMM("AD",V))
SET $PIECE(G,U,5)=1
End DoDot:2
End DoDot:1
+23 QUIT G
+24 ;
GOTALL(%) ;EP
+1 NEW Y
+2 SET Y=$PIECE(%,U,1)+$PIECE(%,U,3)+$PIECE(%,U,5)
+3 IF Y=3
QUIT 1
+4 QUIT 0
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
+2 SET T=$ORDER(^APCMMUCN("B","INTERIM STAGE 1 2014",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 APCMMETH="E"
IF '$$HOSER^APCM24E6(V,R)
QUIT
+10 IF APCMMETH="O"
IF "OH"'[$PIECE(^AUPNVSIT(V,0),U,7)
QUIT
+11 SET $PIECE(G,U,1)=1
+12 SET A=$$AGE^AUPNPAT($PIECE(^AUPNVSIT(V,0),U,5),$PIECE(BD,"."))
+13 IF A>12
SET $PIECE(G,U,3)=1
+14 ;not an exclusion for imm reg
IF $DATA(^AUPNVIMM("AD",V))
SET $PIECE(G,U,5)=1
+15 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
End DoDot:2
End DoDot:1
+16 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
VDT ;EP - ask additional exclusion questions for PEA
+1 SET APCMQ=0
+2 SET APCMY=$ORDER(^APCM14OB("B","S1.020.EP",0))
+3 ;measure not being run
IF '$DATA(APCMIND(APCMY))
QUIT
+4 KILL APCMATTE("S1.020.EP.1")
+5 ;display exclusion text/narrative
+6 IF $ORDER(^APCM14OB(APCMY,26,0))
DO ET
+7 IF APCMPLTY="SEL"!(APCMPLTY="TAX")
Begin DoDot:1
+8 SET APCMZ=0
FOR
SET APCMZ=$ORDER(^APCM14OB(APCMY,19,APCMZ))
IF APCMZ'=+APCMZ
QUIT
WRITE !,^APCM14OB(APCMY,19,APCMZ,0)
+9 SET APCMQ=0
SET APCMIND=0
+10 WRITE !!!,"The View, Download, Transmit question above may be addressed as a group or"
+11 WRITE !,"by individual provider. Do you want to answer for all selected providers as a"
+12 SET DIR(0)="Y"
SET DIR("A")="group Y/N"
SET DIR("B")="YES"
KILL DA
DO ^DIR
KILL DIR
+13 IF $DATA(DIRUT)
SET APCMQ=1
QUIT
+14 IF 'Y
SET APCMIND=1
QUIT
+15 WRITE !!,"Do all selected providers included in this report meet the broadband"
+16 SET DIR(0)="Y"
SET DIR("A")="Exclusion"
SET DIR("B")="YES"
KILL DA
DO ^DIR
KILL DIR
+17 IF $DATA(DIRUT)
SET APCMQ=1
QUIT
+18 IF 'Y
SET APCMIND=1
QUIT
+19 SET APCMP=0
FOR
SET APCMP=$ORDER(APCMPRV(APCMP))
IF APCMP'=+APCMP
QUIT
SET APCMATTE("S1.020.EP.1",APCMP)="Yes"
End DoDot:1
IF APCMIND=1
GOTO EIND
QUIT
EIND ;ask individually
+1 SET APCMP=0
FOR
SET APCMP=$ORDER(APCMPRV(APCMP))
IF APCMP'=+APCMP!(APCMQ)
QUIT
Begin DoDot:1
+2 SET APCMZ=0
FOR
SET APCMZ=$ORDER(^APCM14OB(APCMY,19,APCMZ))
IF APCMZ'=+APCMZ
QUIT
WRITE !,^APCM14OB(APCMY,19,APCMZ,0)
+3 SET DIR(0)="Y"
SET DIR("A")="Does "_$EXTRACT($PIECE(^VA(200,APCMP,0),U,1),1,25)_" meet the broadband exclusion"
SET DIR("B")="YES"
KILL DA
DO ^DIR
KILL DIR
+4 IF $DATA(DIRUT)
SET APCMQ=1
QUIT
+5 SET APCMATTE("S1.020.EP.1",APCMP)=$SELECT(Y:"Yes",1:"No")
End DoDot:1
+6 QUIT
ET ;
+1 WRITE !
SET APCMZ=0
FOR
SET APCMZ=$ORDER(^APCM14OB(APCMY,26,APCMZ))
IF APCMZ'=+APCMZ
QUIT
WRITE !,^APCM14OB(APCMY,26,APCMZ,0)
+2 WRITE !
+3 QUIT
