ABMM2PV2 ;IHS/SD/SDR - MU Patient Volume EP Report ;
;;2.6;IHS 3P BILLING SYSTEM;**11,12,15**;NOV 12, 2009;Build 251
;IHS/SD/SDR - 2.6*12 - Made changes for uncompensated care; uncompensated should be a separate detail line
; and should be included in the patient volume total, not as a separate line.
;IHS/SD/SDR - 2.6*15 - HEAT183289 -Include Tribal self-insured in calculation if populated
;
CALC ;EP
S ABMCFLG=0
I ABMY("RTYP")="GRP" D CALC2 Q
S ABMSDT=0
F S ABMSDT=$O(^XTMP("ABM-PVP2",$J,"PRV-DENOM",ABMSDT)) Q:'ABMSDT D
.;I ABMY("90")'="A"&(ABMY("SDT")'=ABMSDT) Q ;only calculate whole year for automated ;abm*2.6*12 uncomp care
.I "^A^D^"'[("^"_ABMY("90")_"^")&(ABMY("SDT")'=ABMSDT) Q ;only whole year for automated ;abm*2.6*12 uncomp care
.;I (ABMY("90")="A")&($E(ABMSDT,4,7)>1003) Q ;after 10/3 it won't be 90 days anymore ;abm*2.6*12 HEAT134048
.S X1=ABMY("SDT")
.S X2=275
.D C^%DTC
.I "^A^D^"[("^"_ABMY("90")_"^")&(ABMSDT>X) Q ;275 days after start won't contain 90 days anymore ;abm*2.6*12 HEAT134048
.S ABMPRV=0
.F S ABMPRV=$O(^XTMP("ABM-PVP2",$J,"PRV-DENOM",ABMSDT,ABMPRV)) Q:'ABMPRV D
..Q:+$G(ABMT(ABMPRV))=1
..S ABMPD=+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM PD",ABMSDT,ABMPRV,"MCD"))+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM PD",ABMSDT,ABMPRV,"CHIP"))
..S ABMZPD=+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM ZEROPD",ABMSDT,ABMPRV,"MCD"))+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM ZEROPD",ABMSDT,ABMPRV,"CHIP"))
..S ABMENR=+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM ENR",ABMSDT,ABMPRV,"MCD"))+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM ENR",ABMSDT,ABMPRV,"CHIP"))
..S ^XTMP("ABM-PVP2",$J,"PRV-NUM",ABMSDT,ABMPRV)=+ABMPD+ABMZPD+ABMENR
..S ABMTPRCT=$J((+ABMPD+ABMZPD+ABMENR)/(+$G(^XTMP("ABM-PVP2",$J,"PRV-DENOM",ABMSDT,ABMPRV)))*100,0,1)
..;start new code abm*2.6*12 uncomp care
..I ABMFQHC=1 D
...S ABMDENOM=+$G(^XTMP("ABM-PVP2",$J,"PRV-DENOM",ABMSDT,ABMPRV))
...;S ABMOTH=+$G(^XTMP("ABM-PVP2",$J,"PRV ENC CNT",ABMSDT,ABMPRV,"OTHR"))
...S ABMOTH=+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM PD",ABMSDT,ABMPRV,"OTHR"))+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM ZEROPD",ABMSDT,ABMPRV,"OTHR"))
...;S ABMTSI=+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM TRIBSI",ABMSDT,ABMPRV,"TRIBSI")) ;abm*2.6*15 HEAT183289
...;S (ABMUNCOM,^XTMP("ABM-PVP2",$J,"PRV-NUM UNCOMP",ABMSDT,ABMPRV,"UNCOMP"))=ABMDENOM-ABMPD-ABMZPD-ABMENR-ABMOTH-(+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM OELIG",ABMSDT,ABMPRV,"OTHR"))) ;abm*2.6*15
...S ABMUNCOM=(+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM UNCOMP",ABMSDT,ABMPRV,"UNCOMP"))) ;abm*2.6*15
...S ^XTMP("ABM-PVP2",$J,"PRV-NUM",ABMSDT,ABMPRV)=+ABMPD+ABMZPD+ABMENR+ABMUNCOM
...S ABMTPRCT=$J((+ABMPD+ABMZPD+ABMENR+ABMUNCOM)/(+$G(^XTMP("ABM-PVP2",$J,"PRV-DENOM",ABMSDT,ABMPRV)))*100,0,1)
..;end new code uncomp care
..S ^XTMP("ABM-PVP2",$J,"PRV PERCENT",ABMSDT,ABMPRV)=ABMTPRCT
..I '$D(^XTMP("ABM-PVP2",$J,"PRV TOP",ABMPRV)) S ^XTMP("ABM-PVP2",$J,"PRV TOP",ABMPRV)=ABMTPRCT_"^"_ABMSDT
..I +$P($G(^XTMP("ABM-PVP2",$J,"PRV TOP",ABMPRV)),U)<ABMTPRCT S ^XTMP("ABM-PVP2",$J,"PRV TOP",ABMPRV)=ABMTPRCT_"^"_ABMSDT
..;
..S ABMVLOC=0
..F S ABMVLOC=$O(^XTMP("ABM-PVP2",$J,"PRV-DENOM",ABMSDT,ABMPRV,ABMVLOC)) Q:'ABMVLOC D
...S ABMPD=+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM PD",ABMSDT,ABMPRV,ABMVLOC,"MCD"))+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM PD",ABMSDT,ABMPRV,ABMVLOC,"CHIP"))
...S ABMZPD=+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM ZEROPD",ABMSDT,ABMPRV,ABMVLOC,"MCD"))+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM ZEROPD",ABMSDT,ABMPRV,ABMVLOC,"CHIP"))
...S ABMENR=+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM ENR",ABMSDT,ABMPRV,ABMVLOC,"MCD"))+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM ENR",ABMSDT,ABMPRV,ABMVLOC,"CHIP"))
...S ^XTMP("ABM-PVP2",$J,"PRV-NUM",ABMSDT,ABMPRV,ABMVLOC)=+ABMPD+ABMZPD+ABMENR
...;I (ABMPD+ABMZPD+ABMENR)=0 S ^XTMP("ABM-PVP2",$J,"PRV PERCENT",ABMSDT,ABMPRV,ABMVLOC)=0 Q ;abm*2.6*12 uncomp care
...S ABMPERCT=$J((+ABMPD+ABMZPD+ABMENR)/(+$G(^XTMP("ABM-PVP2",$J,"PRV-DENOM",ABMSDT,ABMPRV,ABMVLOC)))*100,0,1)
...;start new code abm*2.6*12 uncomp care
...I ABMFQHC=1 D
....S ABMDENOM=+$G(^XTMP("ABM-PVP2",$J,"PRV-DENOM",ABMSDT,ABMPRV,ABMVLOC))
....;S ABMOTH=+$G(^XTMP("ABM-PVP2",$J,"PRV ENC CNT",ABMSDT,ABMPRV,ABMVLOC,"OTHR"))
....S ABMOTH=+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM PD",ABMSDT,ABMPRV,ABMVLOC,"OTHR"))+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM ZEROPD",ABMSDT,ABMPRV,ABMVLOC,"OTHR"))
....;S ABMTSI=+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM TRIBSI",ABMSDT,ABMPRV,ABMVLOC,"TRIBSI")) ;abm*2.6*15 HEAT183289
....;S (ABMUNCOM,^XTMP("ABM-PVP2",$J,"PRV-NUM UNCOMP",ABMSDT,ABMPRV,ABMVLOC,"UNCOMP"))=ABMDENOM-ABMPD-ABMZPD-ABMENR-ABMOTH-(+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM OELIG",ABMSDT,ABMPRV,ABMVLOC,"OTHR"))) ;abm*2.6*15
....S ABMUNCOM=(+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM UNCOMP",ABMSDT,ABMPRV,ABMVLOC,"UNCOMP"))) ;abm*2.6*15
....S ^XTMP("ABM-PVP2",$J,"PRV-NUM",ABMSDT,ABMPRV,ABMVLOC)=+ABMPD+ABMZPD+ABMENR+ABMUNCOM
....S ABMPERCT=$J((+ABMPD+ABMZPD+ABMENR+ABMUNCOM)/(+$G(^XTMP("ABM-PVP2",$J,"PRV-DENOM",ABMSDT,ABMPRV,ABMVLOC)))*100,0,1)
...;end new code uncomp care
...S ^XTMP("ABM-PVP2",$J,"PRV PERCENT",ABMSDT,ABMPRV,ABMVLOC)=ABMPERCT
..;if looking for first that meets 30%, set flag to quit
..I ABMTPRCT>29.99,$G(ABMY("A90"))="F" S ABMT(ABMPRV)=1
..I ABMTPRCT>19.99&($$DOCLASS^ABMDVST2(ABMPRV)["PEDIAT")&($G(ABMY("A90"))="F") S ABMT(ABMPRV)=1
Q
CALC2 ;EP
S ABMSDT=0
F S ABMSDT=$O(^XTMP("ABM-PVP2",$J,"PRV-DENOM",ABMSDT)) Q:'ABMSDT D Q:ABMCFLG
.;start old code abm*2.6*12 HEAT134048
.;I ABMY("90")'="A"&(ABMY("SDT")'=ABMSDT) Q ;only calculate whole year for automated
.;I (ABMY("90")="A")&($E(ABMSDT,4,7)>1003) Q ;after 10/3 it won't be 90 days anymore
.;end old start new HEAT134048
.I "^A^D^"'[("^"_ABMY("90")_"^")&(ABMY("SDT")'=ABMSDT) Q ;only whole year for automated
.S X1=ABMY("SDT")
.S X2=275
.D C^%DTC
.I "^A^D^"[("^"_ABMY("90")_"^")&(ABMSDT>X) Q ;275 days after start won't contain 90 days anymore
.;end new HEAT134048
.S ABMPD=+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM PD",ABMSDT,"MCD"))+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM PD",ABMSDT,"CHIP"))
.S ABMZPD=+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM ZEROPD",ABMSDT,"MCD"))+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM ZEROPD",ABMSDT,"CHIP"))
.S ABMENR=+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM ENR",ABMSDT,"MCD"))+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM ENR",ABMSDT,"CHIP"))
.S ^XTMP("ABM-PVP2",$J,"PRV-NUM",ABMSDT)=+ABMPD+ABMZPD+ABMENR
.S ABMTPRCT=$J((+ABMPD+ABMZPD+ABMENR)/(+$G(^XTMP("ABM-PVP2",$J,"PRV-DENOM",ABMSDT)))*100,0,1)
.;start new code abm*2.6*12 uncomp care
.I ABMFQHC=1 D
..S ABMDENOM=+$G(^XTMP("ABM-PVP2",$J,"PRV-DENOM",ABMSDT))
..;S ABMOTH=+$G(^XTMP("ABM-PVP2",$J,"PRV ENC CNT",ABMSDT,"OTHR"))
..S ABMOTH=+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM PD",ABMSDT,"OTHR"))+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM ZEROPD",ABMSDT,"OTHR"))
..;S ABMTSI=+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM TRIBSI",ABMSDT,"TRIBSI")) ;abm*2.6*15 HEAT183289
..;S (ABMUNCOM,^XTMP("ABM-PVP2",$J,"PRV-NUM UNCOMP",ABMSDT,"UNCOMP"))=ABMDENOM-ABMPD-ABMZPD-ABMENR-ABMOTH-(+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM OELIG",ABMSDT,"OTHR"))) ;abm*2.6*15
..S ABMUNCOM=+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM UNCOMP",ABMSDT,"UNCOMP")) ;abm*2.6*15
..S ^XTMP("ABM-PVP2",$J,"PRV-NUM",ABMSDT)=+ABMPD+ABMZPD+ABMENR+ABMUNCOM ;abm*2.6*15 HEAT183289
..;S ^XTMP("ABM-PVP2",$J,"PRV-NUM",ABMSDT)=+ABMPD+ABMZPD+ABMENR+ABMUNCOM+ABMTSI ;abm*2.6*15 HEAT183289
..S ABMTPRCT=$J((+ABMPD+ABMZPD+ABMENR+ABMUNCOM)/(+$G(^XTMP("ABM-PVP2",$J,"PRV-DENOM",ABMSDT)))*100,0,1) ;abm*2.6*15 HEAT183289
..;S ABMTPRCT=$J((+ABMPD+ABMZPD+ABMENR+ABMUNCOM+ABMTSI)/(+$G(^XTMP("ABM-PVP2",$J,"PRV-DENOM",ABMSDT)))*100,0,1) ;abm*2.6*15 HEAT183289
.;end new code uncomp care
.S ^XTMP("ABM-PVP2",$J,"PRV PERCENT",ABMSDT)=ABMTPRCT
.I '$D(^XTMP("ABM-PVP2",$J,"PRV TOP")) S ^XTMP("ABM-PVP2",$J,"PRV TOP")=ABMTPRCT_"^"_ABMSDT
.I +$P($G(^XTMP("ABM-PVP2",$J,"PRV TOP")),U)<ABMTPRCT S ^XTMP("ABM-PVP2",$J,"PRV TOP")=ABMTPRCT_"^"_ABMSDT
.;
.S ABMVLOC=0
.F S ABMVLOC=$O(^XTMP("ABM-PVP2",$J,"PRV-DENOM",ABMSDT,ABMVLOC)) Q:'ABMVLOC D Q:ABMCFLG
..S ABMPD=+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM PD",ABMSDT,ABMVLOC,"MCD"))+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM PD",ABMSDT,ABMVLOC,"CHIP"))
..S ABMZPD=+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM ZEROPD",ABMSDT,ABMVLOC,"MCD"))+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM ZEROPD",ABMSDT,ABMVLOC,"CHIP"))
..S ABMENR=+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM ENR",ABMSDT,ABMVLOC,"MCD"))+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM ENR",ABMSDT,ABMVLOC,"CHIP"))
..S ^XTMP("ABM-PVP2",$J,"PRV-NUM",ABMSDT,ABMVLOC)=+ABMPD+ABMZPD+ABMENR
..;I (ABMPD+ABMZPD+ABMENR)=0 S ^XTMP("ABM-PVP2",$J,"PRV PERCENT",ABMSDT,ABMVLOC)=0 Q ;abm*2.6*12
..S ABMPERCT=$J((+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM",ABMSDT,ABMVLOC))/(+$G(^XTMP("ABM-PVP2",$J,"PRV-DENOM",ABMSDT,ABMVLOC))))*100,0,1)
..;start new code abm*2.6*12 uncomp care
..I ABMFQHC=1 D
...S ABMDENOM=+$G(^XTMP("ABM-PVP2",$J,"PRV-DENOM",ABMSDT,ABMVLOC))
...;S ABMOTH=+$G(^XTMP("ABM-PVP2",$J,"PRV ENC CNT",ABMSDT,ABMVLOC,"OTHR"))
...S ABMOTH=+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM PD",ABMSDT,ABMVLOC,"OTHR"))+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM ZEROPD",ABMSDT,ABMVLOC,"OTHR"))
...;S ABMTSI=+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM TRIBSI",ABMSDT,"TRIBSI")) ;abm*2.6*15 HEAT183289
...;S (ABMUNCOM,^XTMP("ABM-PVP2",$J,"PRV-NUM UNCOMP",ABMSDT,ABMVLOC,"UNCOMP"))=ABMDENOM-ABMPD-ABMZPD-ABMENR-ABMOTH-(+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM OELIG",ABMSDT,ABMVLOC,"OTHR"))) ;abm*2.6*15
...S ABMUNCOM=+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM UNCOMP",ABMSDT,ABMVLOC,"UNCOMP")) ;abm*2.6*15
...S ^XTMP("ABM-PVP2",$J,"PRV-NUM",ABMSDT,ABMVLOC)=+ABMPD+ABMZPD+ABMENR+ABMUNCOM
...S ABMPERCT=$J((+ABMPD+ABMZPD+ABMENR+ABMUNCOM)/(+$G(^XTMP("ABM-PVP2",$J,"PRV-DENOM",ABMSDT,ABMVLOC)))*100,0,1)
..;end new code uncomp care
..S ^XTMP("ABM-PVP2",$J,"PRV PERCENT",ABMSDT,ABMVLOC)=ABMPERCT
.;if looking for first that meets 30%, set flag to quit
.I ABMTPRCT>29.99,$G(ABMY("A90"))="F" S ABMCFLG=1
Q
ABMM2PV2 ;IHS/SD/SDR - MU Patient Volume EP Report ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;**11,12,15**;NOV 12, 2009;Build 251
+2 ;IHS/SD/SDR - 2.6*12 - Made changes for uncompensated care; uncompensated should be a separate detail line
+3 ; and should be included in the patient volume total, not as a separate line.
+4 ;IHS/SD/SDR - 2.6*15 - HEAT183289 -Include Tribal self-insured in calculation if populated
+5 ;
CALC ;EP
+1 SET ABMCFLG=0
+2 IF ABMY("RTYP")="GRP"
DO CALC2
QUIT
+3 SET ABMSDT=0
+4 FOR
SET ABMSDT=$ORDER(^XTMP("ABM-PVP2",$JOB,"PRV-DENOM",ABMSDT))
IF 'ABMSDT
QUIT
Begin DoDot:1
+5 ;I ABMY("90")'="A"&(ABMY("SDT")'=ABMSDT) Q ;only calculate whole year for automated ;abm*2.6*12 uncomp care
+6 ;only whole year for automated ;abm*2.6*12 uncomp care
IF "^A^D^"'[("^"_ABMY("90")_"^")&(ABMY("SDT")'=ABMSDT)
QUIT
+7 ;I (ABMY("90")="A")&($E(ABMSDT,4,7)>1003) Q ;after 10/3 it won't be 90 days anymore ;abm*2.6*12 HEAT134048
+8 SET X1=ABMY("SDT")
+9 SET X2=275
+10 DO C^%DTC
+11 ;275 days after start won't contain 90 days anymore ;abm*2.6*12 HEAT134048
IF "^A^D^"[("^"_ABMY("90")_"^")&(ABMSDT>X)
QUIT
+12 SET ABMPRV=0
+13 FOR
SET ABMPRV=$ORDER(^XTMP("ABM-PVP2",$JOB,"PRV-DENOM",ABMSDT,ABMPRV))
IF 'ABMPRV
QUIT
Begin DoDot:2
+14 IF +$GET(ABMT(ABMPRV))=1
QUIT
+15 SET ABMPD=+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-NUM PD",ABMSDT,ABMPRV,"MCD"))+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-NUM PD",ABMSDT,ABMPRV,"CHIP"))
+16 SET ABMZPD=+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-NUM ZEROPD",ABMSDT,ABMPRV,"MCD"))+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-NUM ZEROPD",ABMSDT,ABMPRV,"CHIP"))
+17 SET ABMENR=+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-NUM ENR",ABMSDT,ABMPRV,"MCD"))+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-NUM ENR",ABMSDT,ABMPRV,"CHIP"))
+18 SET ^XTMP("ABM-PVP2",$JOB,"PRV-NUM",ABMSDT,ABMPRV)=+ABMPD+ABMZPD+ABMENR
+19 SET ABMTPRCT=$JUSTIFY((+ABMPD+ABMZPD+ABMENR)/(+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-DENOM",ABMSDT,ABMPRV)))*100,0,1)
+20 ;start new code abm*2.6*12 uncomp care
+21 IF ABMFQHC=1
Begin DoDot:3
+22 SET ABMDENOM=+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-DENOM",ABMSDT,ABMPRV))
+23 ;S ABMOTH=+$G(^XTMP("ABM-PVP2",$J,"PRV ENC CNT",ABMSDT,ABMPRV,"OTHR"))
+24 SET ABMOTH=+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-NUM PD",ABMSDT,ABMPRV,"OTHR"))+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-NUM ZEROPD",ABMSDT,ABMPRV,"OTHR"))
+25 ;S ABMTSI=+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM TRIBSI",ABMSDT,ABMPRV,"TRIBSI")) ;abm*2.6*15 HEAT183289
+26 ;S (ABMUNCOM,^XTMP("ABM-PVP2",$J,"PRV-NUM UNCOMP",ABMSDT,ABMPRV,"UNCOMP"))=ABMDENOM-ABMPD-ABMZPD-ABMENR-ABMOTH-(+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM OELIG",ABMSDT,ABMPRV,"OTHR"))) ;abm*2.6*15
+27 ;abm*2.6*15
SET ABMUNCOM=(+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-NUM UNCOMP",ABMSDT,ABMPRV,"UNCOMP")))
+28 SET ^XTMP("ABM-PVP2",$JOB,"PRV-NUM",ABMSDT,ABMPRV)=+ABMPD+ABMZPD+ABMENR+ABMUNCOM
+29 SET ABMTPRCT=$JUSTIFY((+ABMPD+ABMZPD+ABMENR+ABMUNCOM)/(+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-DENOM",ABMSDT,ABMPRV)))*100,0,1)
End DoDot:3
+30 ;end new code uncomp care
+31 SET ^XTMP("ABM-PVP2",$JOB,"PRV PERCENT",ABMSDT,ABMPRV)=ABMTPRCT
+32 IF '$DATA(^XTMP("ABM-PVP2",$JOB,"PRV TOP",ABMPRV))
SET ^XTMP("ABM-PVP2",$JOB,"PRV TOP",ABMPRV)=ABMTPRCT_"^"_ABMSDT
+33 IF +$PIECE($GET(^XTMP("ABM-PVP2",$JOB,"PRV TOP",ABMPRV)),U)<ABMTPRCT
SET ^XTMP("ABM-PVP2",$JOB,"PRV TOP",ABMPRV)=ABMTPRCT_"^"_ABMSDT
+34 ;
+35 SET ABMVLOC=0
+36 FOR
SET ABMVLOC=$ORDER(^XTMP("ABM-PVP2",$JOB,"PRV-DENOM",ABMSDT,ABMPRV,ABMVLOC))
IF 'ABMVLOC
QUIT
Begin DoDot:3
+37 SET ABMPD=+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-NUM PD",ABMSDT,ABMPRV,ABMVLOC,"MCD"))+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-NUM PD",ABMSDT,ABMPRV,ABMVLOC,"CHIP"))
+38 SET ABMZPD=+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-NUM ZEROPD",ABMSDT,ABMPRV,ABMVLOC,"MCD"))+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-NUM ZEROPD",ABMSDT,ABMPRV,ABMVLOC,"CHIP"))
+39 SET ABMENR=+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-NUM ENR",ABMSDT,ABMPRV,ABMVLOC,"MCD"))+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-NUM ENR",ABMSDT,ABMPRV,ABMVLOC,"CHIP"))
+40 SET ^XTMP("ABM-PVP2",$JOB,"PRV-NUM",ABMSDT,ABMPRV,ABMVLOC)=+ABMPD+ABMZPD+ABMENR
+41 ;I (ABMPD+ABMZPD+ABMENR)=0 S ^XTMP("ABM-PVP2",$J,"PRV PERCENT",ABMSDT,ABMPRV,ABMVLOC)=0 Q ;abm*2.6*12 uncomp care
+42 SET ABMPERCT=$JUSTIFY((+ABMPD+ABMZPD+ABMENR)/(+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-DENOM",ABMSDT,ABMPRV,ABMVLOC)))*100,0,1)
+43 ;start new code abm*2.6*12 uncomp care
+44 IF ABMFQHC=1
Begin DoDot:4
+45 SET ABMDENOM=+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-DENOM",ABMSDT,ABMPRV,ABMVLOC))
+46 ;S ABMOTH=+$G(^XTMP("ABM-PVP2",$J,"PRV ENC CNT",ABMSDT,ABMPRV,ABMVLOC,"OTHR"))
+47 SET ABMOTH=+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-NUM PD",ABMSDT,ABMPRV,ABMVLOC,"OTHR"))+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-NUM ZEROPD",ABMSDT,ABMPRV,ABMVLOC,"OTHR"))
+48 ;S ABMTSI=+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM TRIBSI",ABMSDT,ABMPRV,ABMVLOC,"TRIBSI")) ;abm*2.6*15 HEAT183289
+49 ;S (ABMUNCOM,^XTMP("ABM-PVP2",$J,"PRV-NUM UNCOMP",ABMSDT,ABMPRV,ABMVLOC,"UNCOMP"))=ABMDENOM-ABMPD-ABMZPD-ABMENR-ABMOTH-(+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM OELIG",ABMSDT,ABMPRV,ABMVLOC,"OTHR"))) ;abm*2.6*15
+50 ;abm*2.6*15
SET ABMUNCOM=(+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-NUM UNCOMP",ABMSDT,ABMPRV,ABMVLOC,"UNCOMP")))
+51 SET ^XTMP("ABM-PVP2",$JOB,"PRV-NUM",ABMSDT,ABMPRV,ABMVLOC)=+ABMPD+ABMZPD+ABMENR+ABMUNCOM
+52 SET ABMPERCT=$JUSTIFY((+ABMPD+ABMZPD+ABMENR+ABMUNCOM)/(+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-DENOM",ABMSDT,ABMPRV,ABMVLOC)))*100,0,1)
End DoDot:4
+53 ;end new code uncomp care
+54 SET ^XTMP("ABM-PVP2",$JOB,"PRV PERCENT",ABMSDT,ABMPRV,ABMVLOC)=ABMPERCT
End DoDot:3
+55 ;if looking for first that meets 30%, set flag to quit
+56 IF ABMTPRCT>29.99
IF $GET(ABMY("A90"))="F"
SET ABMT(ABMPRV)=1
+57 IF ABMTPRCT>19.99&($$DOCLASS^ABMDVST2(ABMPRV)["PEDIAT")&($GET(ABMY("A90"))="F")
SET ABMT(ABMPRV)=1
End DoDot:2
End DoDot:1
+58 QUIT
CALC2 ;EP
+1 SET ABMSDT=0
+2 FOR
SET ABMSDT=$ORDER(^XTMP("ABM-PVP2",$JOB,"PRV-DENOM",ABMSDT))
IF 'ABMSDT
QUIT
Begin DoDot:1
+3 ;start old code abm*2.6*12 HEAT134048
+4 ;I ABMY("90")'="A"&(ABMY("SDT")'=ABMSDT) Q ;only calculate whole year for automated
+5 ;I (ABMY("90")="A")&($E(ABMSDT,4,7)>1003) Q ;after 10/3 it won't be 90 days anymore
+6 ;end old start new HEAT134048
+7 ;only whole year for automated
IF "^A^D^"'[("^"_ABMY("90")_"^")&(ABMY("SDT")'=ABMSDT)
QUIT
+8 SET X1=ABMY("SDT")
+9 SET X2=275
+10 DO C^%DTC
+11 ;275 days after start won't contain 90 days anymore
IF "^A^D^"[("^"_ABMY("90")_"^")&(ABMSDT>X)
QUIT
+12 ;end new HEAT134048
+13 SET ABMPD=+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-NUM PD",ABMSDT,"MCD"))+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-NUM PD",ABMSDT,"CHIP"))
+14 SET ABMZPD=+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-NUM ZEROPD",ABMSDT,"MCD"))+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-NUM ZEROPD",ABMSDT,"CHIP"))
+15 SET ABMENR=+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-NUM ENR",ABMSDT,"MCD"))+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-NUM ENR",ABMSDT,"CHIP"))
+16 SET ^XTMP("ABM-PVP2",$JOB,"PRV-NUM",ABMSDT)=+ABMPD+ABMZPD+ABMENR
+17 SET ABMTPRCT=$JUSTIFY((+ABMPD+ABMZPD+ABMENR)/(+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-DENOM",ABMSDT)))*100,0,1)
+18 ;start new code abm*2.6*12 uncomp care
+19 IF ABMFQHC=1
Begin DoDot:2
+20 SET ABMDENOM=+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-DENOM",ABMSDT))
+21 ;S ABMOTH=+$G(^XTMP("ABM-PVP2",$J,"PRV ENC CNT",ABMSDT,"OTHR"))
+22 SET ABMOTH=+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-NUM PD",ABMSDT,"OTHR"))+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-NUM ZEROPD",ABMSDT,"OTHR"))
+23 ;S ABMTSI=+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM TRIBSI",ABMSDT,"TRIBSI")) ;abm*2.6*15 HEAT183289
+24 ;S (ABMUNCOM,^XTMP("ABM-PVP2",$J,"PRV-NUM UNCOMP",ABMSDT,"UNCOMP"))=ABMDENOM-ABMPD-ABMZPD-ABMENR-ABMOTH-(+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM OELIG",ABMSDT,"OTHR"))) ;abm*2.6*15
+25 ;abm*2.6*15
SET ABMUNCOM=+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-NUM UNCOMP",ABMSDT,"UNCOMP"))
+26 ;abm*2.6*15 HEAT183289
SET ^XTMP("ABM-PVP2",$JOB,"PRV-NUM",ABMSDT)=+ABMPD+ABMZPD+ABMENR+ABMUNCOM
+27 ;S ^XTMP("ABM-PVP2",$J,"PRV-NUM",ABMSDT)=+ABMPD+ABMZPD+ABMENR+ABMUNCOM+ABMTSI ;abm*2.6*15 HEAT183289
+28 ;abm*2.6*15 HEAT183289
SET ABMTPRCT=$JUSTIFY((+ABMPD+ABMZPD+ABMENR+ABMUNCOM)/(+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-DENOM",ABMSDT)))*100,0,1)
+29 ;S ABMTPRCT=$J((+ABMPD+ABMZPD+ABMENR+ABMUNCOM+ABMTSI)/(+$G(^XTMP("ABM-PVP2",$J,"PRV-DENOM",ABMSDT)))*100,0,1) ;abm*2.6*15 HEAT183289
End DoDot:2
+30 ;end new code uncomp care
+31 SET ^XTMP("ABM-PVP2",$JOB,"PRV PERCENT",ABMSDT)=ABMTPRCT
+32 IF '$DATA(^XTMP("ABM-PVP2",$JOB,"PRV TOP"))
SET ^XTMP("ABM-PVP2",$JOB,"PRV TOP")=ABMTPRCT_"^"_ABMSDT
+33 IF +$PIECE($GET(^XTMP("ABM-PVP2",$JOB,"PRV TOP")),U)<ABMTPRCT
SET ^XTMP("ABM-PVP2",$JOB,"PRV TOP")=ABMTPRCT_"^"_ABMSDT
+34 ;
+35 SET ABMVLOC=0
+36 FOR
SET ABMVLOC=$ORDER(^XTMP("ABM-PVP2",$JOB,"PRV-DENOM",ABMSDT,ABMVLOC))
IF 'ABMVLOC
QUIT
Begin DoDot:2
+37 SET ABMPD=+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-NUM PD",ABMSDT,ABMVLOC,"MCD"))+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-NUM PD",ABMSDT,ABMVLOC,"CHIP"))
+38 SET ABMZPD=+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-NUM ZEROPD",ABMSDT,ABMVLOC,"MCD"))+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-NUM ZEROPD",ABMSDT,ABMVLOC,"CHIP"))
+39 SET ABMENR=+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-NUM ENR",ABMSDT,ABMVLOC,"MCD"))+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-NUM ENR",ABMSDT,ABMVLOC,"CHIP"))
+40 SET ^XTMP("ABM-PVP2",$JOB,"PRV-NUM",ABMSDT,ABMVLOC)=+ABMPD+ABMZPD+ABMENR
+41 ;I (ABMPD+ABMZPD+ABMENR)=0 S ^XTMP("ABM-PVP2",$J,"PRV PERCENT",ABMSDT,ABMVLOC)=0 Q ;abm*2.6*12
+42 SET ABMPERCT=$JUSTIFY((+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-NUM",ABMSDT,ABMVLOC))/(+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-DENOM",ABMSDT,ABMVLOC))))*100,0,1)
+43 ;start new code abm*2.6*12 uncomp care
+44 IF ABMFQHC=1
Begin DoDot:3
+45 SET ABMDENOM=+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-DENOM",ABMSDT,ABMVLOC))
+46 ;S ABMOTH=+$G(^XTMP("ABM-PVP2",$J,"PRV ENC CNT",ABMSDT,ABMVLOC,"OTHR"))
+47 SET ABMOTH=+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-NUM PD",ABMSDT,ABMVLOC,"OTHR"))+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-NUM ZEROPD",ABMSDT,ABMVLOC,"OTHR"))
+48 ;S ABMTSI=+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM TRIBSI",ABMSDT,"TRIBSI")) ;abm*2.6*15 HEAT183289
+49 ;S (ABMUNCOM,^XTMP("ABM-PVP2",$J,"PRV-NUM UNCOMP",ABMSDT,ABMVLOC,"UNCOMP"))=ABMDENOM-ABMPD-ABMZPD-ABMENR-ABMOTH-(+$G(^XTMP("ABM-PVP2",$J,"PRV-NUM OELIG",ABMSDT,ABMVLOC,"OTHR"))) ;abm*2.6*15
+50 ;abm*2.6*15
SET ABMUNCOM=+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-NUM UNCOMP",ABMSDT,ABMVLOC,"UNCOMP"))
+51 SET ^XTMP("ABM-PVP2",$JOB,"PRV-NUM",ABMSDT,ABMVLOC)=+ABMPD+ABMZPD+ABMENR+ABMUNCOM
+52 SET ABMPERCT=$JUSTIFY((+ABMPD+ABMZPD+ABMENR+ABMUNCOM)/(+$GET(^XTMP("ABM-PVP2",$JOB,"PRV-DENOM",ABMSDT,ABMVLOC)))*100,0,1)
End DoDot:3
+53 ;end new code uncomp care
+54 SET ^XTMP("ABM-PVP2",$JOB,"PRV PERCENT",ABMSDT,ABMVLOC)=ABMPERCT
End DoDot:2
IF ABMCFLG
QUIT
+55 ;if looking for first that meets 30%, set flag to quit
+56 IF ABMTPRCT>29.99
IF $GET(ABMY("A90"))="F"
SET ABMCFLG=1
End DoDot:1
IF ABMCFLG
QUIT
+57 QUIT
