- 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
