ABMM2PH2 ;IHS/SD/SDR - MU Patient Volume Hospital Report ;
;;2.6;IHS 3P BILLING SYSTEM;**11,12**;NOV 12, 2009;Build 187
;IHS/SD/SDR - 2.6*12 - HEAT142398 - Made change for auto dt range, and end of fiscal year
; to work correctly.
;
CALC ;EP
S ABMCFLG=0
S ABMSDT=0
F S ABMSDT=$O(^XTMP("ABM-PVH2",$J,"LOC-DENOM",ABMSDT)) Q:'ABMSDT D Q:ABMCFLG
.;I ABMY("90")'="A"&(ABMY("SDT")'=ABMSDT) Q ;only calculate whole year for automated ;abm*2.6*12 HEAT142398
.I "^A^D^"'[("^"_ABMY("90")_"^")&(ABMY("SDT")'=ABMSDT) Q ;only whole year for automated ;abm*2.6*12 HEAT142398
.;I (ABMY("90")="A")&($E(ABMSDT,4,7)>0703) Q ;after 7/3 it won't be 90 days anymore ;abm*2.6*12 HEAT142398
.;start new abm*2.6*12 HEAT142398
.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
.;end new HEAT142398
.S ABMPD=+$G(^XTMP("ABM-PVH2",$J,"LOC-NUM PD",ABMSDT,"MCD"))+$G(^XTMP("ABM-PVH2",$J,"LOC-NUM PD",ABMSDT,"CHIP"))
.S ABMZPD=+$G(^XTMP("ABM-PVH2",$J,"LOC-NUM ZEROPD",ABMSDT,"MCD"))+$G(^XTMP("ABM-PVH2",$J,"LOC-NUM ZEROPD",ABMSDT,"CHIP"))
.S ABMENR=+$G(^XTMP("ABM-PVH2",$J,"LOC-NUM ENR",ABMSDT,"MCD"))+$G(^XTMP("ABM-PVH2",$J,"LOC-NUM ENR",ABMSDT,"CHIP"))
.S ^XTMP("ABM-PVH2",$J,"LOC-NUM",ABMSDT)=+ABMPD+ABMZPD+ABMENR
.S ABMTPRCT=$J((+ABMPD+ABMZPD+ABMENR)/(+$G(^XTMP("ABM-PVH2",$J,"LOC-DENOM",ABMSDT)))*100,0,1)
.S ^XTMP("ABM-PVH2",$J,"LOC PERCENT",ABMSDT)=ABMTPRCT
.I '$D(^XTMP("ABM-PVH2",$J,"LOC TOP")) S ^XTMP("ABM-PVH2",$J,"LOC TOP")=ABMTPRCT_"^"_ABMSDT
.I +$P($G(^XTMP("ABM-PVH2",$J,"LOC TOP")),U)<ABMTPRCT S ^XTMP("ABM-PVH2",$J,"LOC TOP")=ABMTPRCT_"^"_ABMSDT
.;
.S ABMLOC=0
.F S ABMLOC=$O(^XTMP("ABM-PVH2",$J,"LOC-DENOM",ABMSDT,ABMLOC)) Q:'ABMLOC D Q:ABMCFLG
..S ABMPD=+$G(^XTMP("ABM-PVH2",$J,"LOC-NUM PD",ABMSDT,ABMLOC,"MCD"))+$G(^XTMP("ABM-PVH2",$J,"LOC-NUM PD",ABMSDT,ABMLOC,"CHIP"))
..S ABMZPD=+$G(^XTMP("ABM-PVH2",$J,"LOC-NUM ZEROPD",ABMSDT,ABMLOC,"MCD"))+$G(^XTMP("ABM-PVH2",$J,"LOC-NUM ZEROPD",ABMSDT,ABMLOC,"CHIP"))
..S ABMENR=+$G(^XTMP("ABM-PVH2",$J,"LOC-NUM ENR",ABMSDT,ABMLOC,"MCD"))+$G(^XTMP("ABM-PVH2",$J,"LOC-NUM ENR",ABMSDT,ABMLOC,"CHIP"))
..S ^XTMP("ABM-PVH2",$J,"LOC-NUM",ABMSDT,ABMLOC)=+ABMPD+ABMZPD+ABMENR
..I (ABMPD+ABMZPD+ABMENR)=0 S ^XTMP("ABM-PVH2",$J,"LOC PERCENT",ABMSDT,ABMLOC)=0 Q
..S ABMPERCT=$J((+$G(^XTMP("ABM-PVH2",$J,"LOC-NUM",ABMSDT,ABMLOC))/(+$G(^XTMP("ABM-PVH2",$J,"LOC-DENOM",ABMSDT,ABMLOC))))*100,0,1)
..S ^XTMP("ABM-PVH2",$J,"LOC PERCENT",ABMSDT,ABMLOC)=ABMPERCT
..I '$D(^XTMP("ABM-PVH2",$J,"LOC TOP",ABMLOC)) S ^XTMP("ABM-PVH2",$J,"LOC TOP",ABMLOC)=ABMPERCT_"^"_ABMSDT
..I +$P($G(^XTMP("ABM-PVH2",$J,"LOC TOP",ABMLOC)),U)<ABMPERCT S ^XTMP("ABM-PVH2",$J,"LOC TOP",ABMLOC)=ABMPERCT_"^"_ABMSDT
..I ABMPERCT>9.99,$G(ABMY("A90"))="F" S ABMCFLG=1
Q
ENROLL ;EP
K ABMBILLN,ABMTRAMT,ABMDX,ABMTRIEN
S ABMEFLG=1
S ABMVDFN=0
F S ABMVDFN=$O(^XTMP("ABM-PVH2",$J,"VISITS",ABMVDFN)) Q:'ABMVDFN D
.Q:(+$G(^XTMP("ABM-PVH2",$J,"VISITS",ABMVDFN))=1) ;bill was found for visit
.S ABMPT=$$GET1^DIQ(9000010,ABMVDFN,".05","I")
.I $D(^AUPNVINP("AD",ABMVDFN)) D ;this Visit is linked to V Hosp entry
..S ABMVIEN=$O(^AUPNVINP("AD",ABMVDFN,0))
..S (ABMP("VDT"),ABMVDT,ABMSDT)=$P($$GET1^DIQ(9000010.02,ABMVIEN,".01","I"),".")
.I '$D(^AUPNVINP("AD",ABMVDFN)) D
..S (ABMP("VDT"),ABMVDT,ABMSDT)=$P($$GET1^DIQ(9000010,ABMVDFN,".01","I"),".")
.S ABMVLOC=$$GET1^DIQ(9000010,ABMVDFN,".06","I")
.S ABML=""
.D ELIG^ABMM2PV8
.K ABMINS,ABMOINS,ABMARACT,ABMARIEN
.K ABMITYP
.D CALCDTS^ABMM2PV1
.S ABMDTFLG=0
.S ABMP("BDT")=ABMP("BSDT")
.F D Q:ABMDTFLG=1
..I ABMP("VDT")<ABMP("BSDT") S ABMDTFLG=1 Q ;visit is before 90-day window
..I (+$G(ABML("MCD"))=1!(+$G(ABML("CHIP"))=1)) D
...F ABMGRP="MCD","CHIP" D
....I +$G(ABML(ABMGRP))'=1 Q
....I ABMGRP="MCD",((+$G(ABML("MCD"))=1)&(+$G(ABML("CHIP"))=1)) Q
....S ^XTMP("ABM-PVH2",$J,"LOC ENC CNT",ABMP("BDT"),ABMVLOC,ABMGRP)=+$G(^XTMP("ABM-PVH2",$J,"LOC ENC CNT",ABMP("BDT"),ABMVLOC,ABMGRP))+1
....S ^XTMP("ABM-PVH2",$J,"LOC ENC CNT",ABMP("BDT"),ABMGRP)=+$G(^XTMP("ABM-PVH2",$J,"LOC ENC CNT",ABMP("BDT"),ABMGRP))+1
....;
....S ^XTMP("ABM-PVH2",$J,"LOC-NUM ENR",ABMP("BDT"),ABMGRP)=+$G(^XTMP("ABM-PVH2",$J,"LOC-NUM ENR",ABMP("BDT"),ABMGRP))+1
....S ^XTMP("ABM-PVH2",$J,"LOC-NUM ENR",ABMP("BDT"),ABMVLOC,ABMGRP)=+$G(^XTMP("ABM-PVH2",$J,"LOC-NUM ENR",ABMP("BDT"),ABMVLOC,ABMGRP))+1
....S ^XTMP("ABM-PVH2",$J,"LOC-NUM ENR",ABMP("BDT"),ABMGRP,ABMVLOC)=+$G(^XTMP("ABM-PVH2",$J,"LOC-NUM ENR",ABMP("BDT"),ABMGRP,ABMVLOC))+1
....I +$G(^XTMP("ABM-PVH2",$J,"VISITS",ABMVDFN))'=2 D PTDATA^ABMM2PVH
....S ^XTMP("ABM-PVH2",$J,"VISITS",ABMVDFN)=1
..S X1=ABMP("BDT")
..S X2=1
..D C^%DTC
..I X>ABMP("BEDT") S ABMDTFLG=1 Q
..S ABMP("BDT")=X
Q
ABMM2PH2 ;IHS/SD/SDR - MU Patient Volume Hospital Report ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;**11,12**;NOV 12, 2009;Build 187
+2 ;IHS/SD/SDR - 2.6*12 - HEAT142398 - Made change for auto dt range, and end of fiscal year
+3 ; to work correctly.
+4 ;
CALC ;EP
+1 SET ABMCFLG=0
+2 SET ABMSDT=0
+3 FOR
SET ABMSDT=$ORDER(^XTMP("ABM-PVH2",$JOB,"LOC-DENOM",ABMSDT))
IF 'ABMSDT
QUIT
Begin DoDot:1
+4 ;I ABMY("90")'="A"&(ABMY("SDT")'=ABMSDT) Q ;only calculate whole year for automated ;abm*2.6*12 HEAT142398
+5 ;only whole year for automated ;abm*2.6*12 HEAT142398
IF "^A^D^"'[("^"_ABMY("90")_"^")&(ABMY("SDT")'=ABMSDT)
QUIT
+6 ;I (ABMY("90")="A")&($E(ABMSDT,4,7)>0703) Q ;after 7/3 it won't be 90 days anymore ;abm*2.6*12 HEAT142398
+7 ;start new abm*2.6*12 HEAT142398
+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 ;end new HEAT142398
+13 SET ABMPD=+$GET(^XTMP("ABM-PVH2",$JOB,"LOC-NUM PD",ABMSDT,"MCD"))+$GET(^XTMP("ABM-PVH2",$JOB,"LOC-NUM PD",ABMSDT,"CHIP"))
+14 SET ABMZPD=+$GET(^XTMP("ABM-PVH2",$JOB,"LOC-NUM ZEROPD",ABMSDT,"MCD"))+$GET(^XTMP("ABM-PVH2",$JOB,"LOC-NUM ZEROPD",ABMSDT,"CHIP"))
+15 SET ABMENR=+$GET(^XTMP("ABM-PVH2",$JOB,"LOC-NUM ENR",ABMSDT,"MCD"))+$GET(^XTMP("ABM-PVH2",$JOB,"LOC-NUM ENR",ABMSDT,"CHIP"))
+16 SET ^XTMP("ABM-PVH2",$JOB,"LOC-NUM",ABMSDT)=+ABMPD+ABMZPD+ABMENR
+17 SET ABMTPRCT=$JUSTIFY((+ABMPD+ABMZPD+ABMENR)/(+$GET(^XTMP("ABM-PVH2",$JOB,"LOC-DENOM",ABMSDT)))*100,0,1)
+18 SET ^XTMP("ABM-PVH2",$JOB,"LOC PERCENT",ABMSDT)=ABMTPRCT
+19 IF '$DATA(^XTMP("ABM-PVH2",$JOB,"LOC TOP"))
SET ^XTMP("ABM-PVH2",$JOB,"LOC TOP")=ABMTPRCT_"^"_ABMSDT
+20 IF +$PIECE($GET(^XTMP("ABM-PVH2",$JOB,"LOC TOP")),U)<ABMTPRCT
SET ^XTMP("ABM-PVH2",$JOB,"LOC TOP")=ABMTPRCT_"^"_ABMSDT
+21 ;
+22 SET ABMLOC=0
+23 FOR
SET ABMLOC=$ORDER(^XTMP("ABM-PVH2",$JOB,"LOC-DENOM",ABMSDT,ABMLOC))
IF 'ABMLOC
QUIT
Begin DoDot:2
+24 SET ABMPD=+$GET(^XTMP("ABM-PVH2",$JOB,"LOC-NUM PD",ABMSDT,ABMLOC,"MCD"))+$GET(^XTMP("ABM-PVH2",$JOB,"LOC-NUM PD",ABMSDT,ABMLOC,"CHIP"))
+25 SET ABMZPD=+$GET(^XTMP("ABM-PVH2",$JOB,"LOC-NUM ZEROPD",ABMSDT,ABMLOC,"MCD"))+$GET(^XTMP("ABM-PVH2",$JOB,"LOC-NUM ZEROPD",ABMSDT,ABMLOC,"CHIP"))
+26 SET ABMENR=+$GET(^XTMP("ABM-PVH2",$JOB,"LOC-NUM ENR",ABMSDT,ABMLOC,"MCD"))+$GET(^XTMP("ABM-PVH2",$JOB,"LOC-NUM ENR",ABMSDT,ABMLOC,"CHIP"))
+27 SET ^XTMP("ABM-PVH2",$JOB,"LOC-NUM",ABMSDT,ABMLOC)=+ABMPD+ABMZPD+ABMENR
+28 IF (ABMPD+ABMZPD+ABMENR)=0
SET ^XTMP("ABM-PVH2",$JOB,"LOC PERCENT",ABMSDT,ABMLOC)=0
QUIT
+29 SET ABMPERCT=$JUSTIFY((+$GET(^XTMP("ABM-PVH2",$JOB,"LOC-NUM",ABMSDT,ABMLOC))/(+$GET(^XTMP("ABM-PVH2",$JOB,"LOC-DENOM",ABMSDT,ABMLOC))))*100,0,1)
+30 SET ^XTMP("ABM-PVH2",$JOB,"LOC PERCENT",ABMSDT,ABMLOC)=ABMPERCT
+31 IF '$DATA(^XTMP("ABM-PVH2",$JOB,"LOC TOP",ABMLOC))
SET ^XTMP("ABM-PVH2",$JOB,"LOC TOP",ABMLOC)=ABMPERCT_"^"_ABMSDT
+32 IF +$PIECE($GET(^XTMP("ABM-PVH2",$JOB,"LOC TOP",ABMLOC)),U)<ABMPERCT
SET ^XTMP("ABM-PVH2",$JOB,"LOC TOP",ABMLOC)=ABMPERCT_"^"_ABMSDT
+33 IF ABMPERCT>9.99
IF $GET(ABMY("A90"))="F"
SET ABMCFLG=1
End DoDot:2
IF ABMCFLG
QUIT
End DoDot:1
IF ABMCFLG
QUIT
+34 QUIT
ENROLL ;EP
+1 KILL ABMBILLN,ABMTRAMT,ABMDX,ABMTRIEN
+2 SET ABMEFLG=1
+3 SET ABMVDFN=0
+4 FOR
SET ABMVDFN=$ORDER(^XTMP("ABM-PVH2",$JOB,"VISITS",ABMVDFN))
IF 'ABMVDFN
QUIT
Begin DoDot:1
+5 ;bill was found for visit
IF (+$GET(^XTMP("ABM-PVH2",$JOB,"VISITS",ABMVDFN))=1)
QUIT
+6 SET ABMPT=$$GET1^DIQ(9000010,ABMVDFN,".05","I")
+7 ;this Visit is linked to V Hosp entry
IF $DATA(^AUPNVINP("AD",ABMVDFN))
Begin DoDot:2
+8 SET ABMVIEN=$ORDER(^AUPNVINP("AD",ABMVDFN,0))
+9 SET (ABMP("VDT"),ABMVDT,ABMSDT)=$PIECE($$GET1^DIQ(9000010.02,ABMVIEN,".01","I"),".")
End DoDot:2
+10 IF '$DATA(^AUPNVINP("AD",ABMVDFN))
Begin DoDot:2
+11 SET (ABMP("VDT"),ABMVDT,ABMSDT)=$PIECE($$GET1^DIQ(9000010,ABMVDFN,".01","I"),".")
End DoDot:2
+12 SET ABMVLOC=$$GET1^DIQ(9000010,ABMVDFN,".06","I")
+13 SET ABML=""
+14 DO ELIG^ABMM2PV8
+15 KILL ABMINS,ABMOINS,ABMARACT,ABMARIEN
+16 KILL ABMITYP
+17 DO CALCDTS^ABMM2PV1
+18 SET ABMDTFLG=0
+19 SET ABMP("BDT")=ABMP("BSDT")
+20 FOR
Begin DoDot:2
+21 ;visit is before 90-day window
IF ABMP("VDT")<ABMP("BSDT")
SET ABMDTFLG=1
QUIT
+22 IF (+$GET(ABML("MCD"))=1!(+$GET(ABML("CHIP"))=1))
Begin DoDot:3
+23 FOR ABMGRP="MCD","CHIP"
Begin DoDot:4
+24 IF +$GET(ABML(ABMGRP))'=1
QUIT
+25 IF ABMGRP="MCD"
IF ((+$GET(ABML("MCD"))=1)&(+$GET(ABML("CHIP"))=1))
QUIT
+26 SET ^XTMP("ABM-PVH2",$JOB,"LOC ENC CNT",ABMP("BDT"),ABMVLOC,ABMGRP)=+$GET(^XTMP("ABM-PVH2",$JOB,"LOC ENC CNT",ABMP("BDT"),ABMVLOC,ABMGRP))+1
+27 SET ^XTMP("ABM-PVH2",$JOB,"LOC ENC CNT",ABMP("BDT"),ABMGRP)=+$GET(^XTMP("ABM-PVH2",$JOB,"LOC ENC CNT",ABMP("BDT"),ABMGRP))+1
+28 ;
+29 SET ^XTMP("ABM-PVH2",$JOB,"LOC-NUM ENR",ABMP("BDT"),ABMGRP)=+$GET(^XTMP("ABM-PVH2",$JOB,"LOC-NUM ENR",ABMP("BDT"),ABMGRP))+1
+30 SET ^XTMP("ABM-PVH2",$JOB,"LOC-NUM ENR",ABMP("BDT"),ABMVLOC,ABMGRP)=+$GET(^XTMP("ABM-PVH2",$JOB,"LOC-NUM ENR",ABMP("BDT"),ABMVLOC,ABMGRP))+1
+31 SET ^XTMP("ABM-PVH2",$JOB,"LOC-NUM ENR",ABMP("BDT"),ABMGRP,ABMVLOC)=+$GET(^XTMP("ABM-PVH2",$JOB,"LOC-NUM ENR",ABMP("BDT"),ABMGRP,ABMVLOC))+1
+32 IF +$GET(^XTMP("ABM-PVH2",$JOB,"VISITS",ABMVDFN))'=2
DO PTDATA^ABMM2PVH
+33 SET ^XTMP("ABM-PVH2",$JOB,"VISITS",ABMVDFN)=1
End DoDot:4
End DoDot:3
+34 SET X1=ABMP("BDT")
+35 SET X2=1
+36 DO C^%DTC
+37 IF X>ABMP("BEDT")
SET ABMDTFLG=1
QUIT
+38 SET ABMP("BDT")=X
End DoDot:2
IF ABMDTFLG=1
QUIT
End DoDot:1
+39 QUIT
