ABMMUFC4 ;IHS/SD/SDR - EHR Incentive Report (MU) ;
;;2.6;IHS 3P BILLING SYSTEM;**15,20**;NOV 12, 2009;Build 317
;IHS/SD/SDR - 2.6*15 - HEAT183309 - split routine due to size
;IHS/SD/SDR - 2.6*20 - HEAT256154 - Added MCR/MCD and VISIT W/NO ELIG categories; Also made only IP CHGS show on detail. Added bill type and visit type to
; detail output for validating purposes.
WRTDTLHO ;
S ABM("HD",0)="HOSPITAL CALCULATION MU INCENTIVE REPORT"
S ABM("PG")=1 ;abm*2.6*7
S ABMTYP="DET" D WHD^ABMMUFAC
S CENTER=IOM/2
;F ABMITYP="MEDICARE","MEDICAID","PRIVATE","PRI/MCD","KIDSCARE XIX","KIDSCARE XXI","VMBP","OTHER" D ;abm*2.6*20 IHS/SD/SDR HEAT256154
F ABMITYP="MEDICARE","MEDICAID","MCR/MCD","PRIVATE","PRI/MCD","KIDSCARE XIX","KIDSCARE XXI","VMBP","OTHER","VISIT W/NO ELIG" D ;abm*2.6*20 IHS/SD/SDR HEAT256154
.S (ABMTBILD,ABMTPD,ABMTCDYS,ABMTNDYS)=0
.;abm*2.6*15 HEAT183309 Req#B - Rewrote everything below to use ABMREC, added ABMRT loop, and removed BDFN and DUZ(2) loops
.S ABMRT=""
.F S ABMRT=$O(^TMP($J,"ABM-MUFAC","DETAIL",ABMITYP,ABMRT)) Q:($G(ABMRT)="") D
..S ABMCHG=""
..F S ABMCHG=$O(^TMP($J,"ABM-MUFAC","DETAIL",ABMITYP,ABMRT,ABMCHG)) Q:($G(ABMCHG)="") D
...I ABMCHG="IP CHGS" Q ;abm*2.6*20 IHS/SD/SDR HEAT256154
...S (ABMTBILD,ABMTPD,ABMTCDYS,ABMTNDYS)=0
...S ABMINS=""
...F S ABMINS=$O(^TMP($J,"ABM-MUFAC","DETAIL",ABMITYP,ABMRT,ABMCHG,ABMINS)) Q:ABMINS="" D
....S ABMP("VDFN")=0
....F S ABMP("VDFN")=$O(^TMP($J,"ABM-MUFAC","DETAIL",ABMITYP,ABMRT,ABMCHG,ABMINS,ABMP("VDFN"))) Q:'ABMP("VDFN") D
.....S ABMREC=$G(^TMP($J,"ABM-MUFAC","DETAIL",ABMITYP,ABMRT,ABMCHG,ABMINS,ABMP("VDFN")))
.....S ABMDOSB=$P(ABMREC,U)
.....S ABMDOSE=$P(ABMREC,U,2)
.....S ABMBILLD=$P(ABMREC,U,3)
.....S ABMPD=$P(ABMREC,U,4)
.....S ABMCDAYS=$P(ABMREC,U,5)
.....S ABMNDAYS=$P(ABMREC,U,6)
.....S ABMVLOC=$P(ABMREC,U,7)
.....S ABMDUZ2=+$P(ABMREC,U,8)
.....S ABMP("BDFN")=+$P(ABMREC,U,9)
.....S ABMP("BTYP")=$P(ABMREC,U,11) ;abm*2.6*20 IHS/SD/SDR HEAT256154
.....S ABMP("VTYP")=$P(ABMREC,U,12) ;abm*2.6*20 IHS/SD/SDR HEAT256154
.....S ABMITYPA=$P(ABMREC,U,13) ;abm*2.6*20 IHS/SD/SDR HEAT256154
.....S ABMATYP=$P(ABMREC,U,14) ;abm*2.6*20 IHS/SD/SDR HEAT256154
.....S ABMBILLN=0
.....S:ABMP("BDFN") ABMBILLN=$P($G(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),0)),U)
.....S ABMP("PDFN")=$P($G(^AUPNVSIT(ABMP("VDFN"),0)),U,5)
.....S IENS=$P($G(^AUPNVSIT(ABMP("VDFN"),0)),U,6)_","_ABMP("PDFN")_","
.....S ABMHRN=$$GET1^DIQ(9000001.41,IENS,".02")
.....S:ABMBILLN ABMBILLN=ABMBILLN_$S($P($G(^ABMDPARM(ABMDUZ2,1,2)),U,4)]"":"-"_$P(^ABMDPARM(ABMDUZ2,1,2),U,4),1:"")
.....I $P($G(^ABMDPARM(ABMDUZ2,1,3)),U,3),($P($G(^AUPNPAT(ABMP("PDFN"),41,ABMDUZ2,0)),U,2)),ABMBILLN S ABMBILLN=ABMBILLN_"-"_$P(^AUPNPAT(ABMP("PDFN"),41,ABMDUZ2,0),U,2)
.....W !,ABMITYP_U_$S(ABMRT="NOTBLD":"TOT",1:ABMRT)_U_ABMCHG ;abm*2.6*15 HEAT183309 Req#B
.....W U_$P(ABMINS,"|")_U_$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,$P(ABMINS,"|",2),".211","I"),1,"I")
.....W U_ABMBILLN
.....W U_$$SDTO^ABMDUTL(ABMDOSB)_U_$$SDTO^ABMDUTL(ABMDOSE)_U_$FN(ABMBILLD,",",2)_U_$FN(ABMPD,",",2)
.....;W U_+ABMCDAYS_U_+ABMNDAYS_U_ABMHRN_U_$$CDT^ABMDUTL($P($G(^AUPNVSIT(ABMP("VDFN"),0)),U))_U_ABMVLOC ;abm*2.6*15
.....W U_+ABMCDAYS_U_+ABMNDAYS_U_ABMHRN_U_$$BDT^ABMDUTL($P($G(^AUPNVSIT(ABMP("VDFN"),0)),U))_U_ABMVLOC ;abm*2.6*15
.....W U_ABMP("BTYP")_U_ABMP("VTYP")_U_ABMITYPA_U_ABMATYP_"|" ;abm*2.6*20 IHS/SD/SDR HEAT256154
.....S ABMTBILD=+$G(ABMTBILD)+ABMBILLD
.....S ABMTPD=+$G(ABMTPD)+ABMPD
.....S ABMTCDYS=+$G(ABMTCDYS)+ABMCDAYS
.....S ABMTNDYS=+$G(ABMTNDYS)+ABMNDAYS
S DUZ(2)=ABMDUZ2
Q
ABMMUFC4 ;IHS/SD/SDR - EHR Incentive Report (MU) ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;**15,20**;NOV 12, 2009;Build 317
+2 ;IHS/SD/SDR - 2.6*15 - HEAT183309 - split routine due to size
+3 ;IHS/SD/SDR - 2.6*20 - HEAT256154 - Added MCR/MCD and VISIT W/NO ELIG categories; Also made only IP CHGS show on detail. Added bill type and visit type to
+4 ; detail output for validating purposes.
WRTDTLHO ;
+1 SET ABM("HD",0)="HOSPITAL CALCULATION MU INCENTIVE REPORT"
+2 ;abm*2.6*7
SET ABM("PG")=1
+3 SET ABMTYP="DET"
DO WHD^ABMMUFAC
+4 SET CENTER=IOM/2
+5 ;F ABMITYP="MEDICARE","MEDICAID","PRIVATE","PRI/MCD","KIDSCARE XIX","KIDSCARE XXI","VMBP","OTHER" D ;abm*2.6*20 IHS/SD/SDR HEAT256154
+6 ;abm*2.6*20 IHS/SD/SDR HEAT256154
FOR ABMITYP="MEDICARE","MEDICAID","MCR/MCD","PRIVATE","PRI/MCD","KIDSCARE XIX","KIDSCARE XXI","VMBP","OTHER","VISIT W/NO ELIG"
Begin DoDot:1
+7 SET (ABMTBILD,ABMTPD,ABMTCDYS,ABMTNDYS)=0
+8 ;abm*2.6*15 HEAT183309 Req#B - Rewrote everything below to use ABMREC, added ABMRT loop, and removed BDFN and DUZ(2) loops
+9 SET ABMRT=""
+10 FOR
SET ABMRT=$ORDER(^TMP($JOB,"ABM-MUFAC","DETAIL",ABMITYP,ABMRT))
IF ($GET(ABMRT)="")
QUIT
Begin DoDot:2
+11 SET ABMCHG=""
+12 FOR
SET ABMCHG=$ORDER(^TMP($JOB,"ABM-MUFAC","DETAIL",ABMITYP,ABMRT,ABMCHG))
IF ($GET(ABMCHG)="")
QUIT
Begin DoDot:3
+13 ;abm*2.6*20 IHS/SD/SDR HEAT256154
IF ABMCHG="IP CHGS"
QUIT
+14 SET (ABMTBILD,ABMTPD,ABMTCDYS,ABMTNDYS)=0
+15 SET ABMINS=""
+16 FOR
SET ABMINS=$ORDER(^TMP($JOB,"ABM-MUFAC","DETAIL",ABMITYP,ABMRT,ABMCHG,ABMINS))
IF ABMINS=""
QUIT
Begin DoDot:4
+17 SET ABMP("VDFN")=0
+18 FOR
SET ABMP("VDFN")=$ORDER(^TMP($JOB,"ABM-MUFAC","DETAIL",ABMITYP,ABMRT,ABMCHG,ABMINS,ABMP("VDFN")))
IF 'ABMP("VDFN")
QUIT
Begin DoDot:5
+19 SET ABMREC=$GET(^TMP($JOB,"ABM-MUFAC","DETAIL",ABMITYP,ABMRT,ABMCHG,ABMINS,ABMP("VDFN")))
+20 SET ABMDOSB=$PIECE(ABMREC,U)
+21 SET ABMDOSE=$PIECE(ABMREC,U,2)
+22 SET ABMBILLD=$PIECE(ABMREC,U,3)
+23 SET ABMPD=$PIECE(ABMREC,U,4)
+24 SET ABMCDAYS=$PIECE(ABMREC,U,5)
+25 SET ABMNDAYS=$PIECE(ABMREC,U,6)
+26 SET ABMVLOC=$PIECE(ABMREC,U,7)
+27 SET ABMDUZ2=+$PIECE(ABMREC,U,8)
+28 SET ABMP("BDFN")=+$PIECE(ABMREC,U,9)
+29 ;abm*2.6*20 IHS/SD/SDR HEAT256154
SET ABMP("BTYP")=$PIECE(ABMREC,U,11)
+30 ;abm*2.6*20 IHS/SD/SDR HEAT256154
SET ABMP("VTYP")=$PIECE(ABMREC,U,12)
+31 ;abm*2.6*20 IHS/SD/SDR HEAT256154
SET ABMITYPA=$PIECE(ABMREC,U,13)
+32 ;abm*2.6*20 IHS/SD/SDR HEAT256154
SET ABMATYP=$PIECE(ABMREC,U,14)
+33 SET ABMBILLN=0
+34 IF ABMP("BDFN")
SET ABMBILLN=$PIECE($GET(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),0)),U)
+35 SET ABMP("PDFN")=$PIECE($GET(^AUPNVSIT(ABMP("VDFN"),0)),U,5)
+36 SET IENS=$PIECE($GET(^AUPNVSIT(ABMP("VDFN"),0)),U,6)_","_ABMP("PDFN")_","
+37 SET ABMHRN=$$GET1^DIQ(9000001.41,IENS,".02")
+38 IF ABMBILLN
SET ABMBILLN=ABMBILLN_$SELECT($PIECE($GET(^ABMDPARM(ABMDUZ2,1,2)),U,4)]"":"-"_$PIECE(^ABMDPARM(ABMDUZ2,1,2),U,4),1:"")
+39 IF $PIECE($GET(^ABMDPARM(ABMDUZ2,1,3)),U,3)
IF ($PIECE($GET(^AUPNPAT(ABMP("PDFN"),41,ABMDUZ2,0)),U,2))
IF ABMBILLN
SET ABMBILLN=ABMBILLN_"-"_$PIECE(^AUPNPAT(ABMP("PDFN"),41,ABMDUZ2,0),U,2)
+40 ;abm*2.6*15 HEAT183309 Req#B
WRITE !,ABMITYP_U_$SELECT(ABMRT="NOTBLD":"TOT",1:ABMRT)_U_ABMCHG
+41 WRITE U_$PIECE(ABMINS,"|")_U_$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,$PIECE(ABMINS,"|",2),".211","I"),1,"I")
+42 WRITE U_ABMBILLN
+43 WRITE U_$$SDTO^ABMDUTL(ABMDOSB)_U_$$SDTO^ABMDUTL(ABMDOSE)_U_$FNUMBER(ABMBILLD,",",2)_U_$FNUMBER(ABMPD,",",2)
+44 ;W U_+ABMCDAYS_U_+ABMNDAYS_U_ABMHRN_U_$$CDT^ABMDUTL($P($G(^AUPNVSIT(ABMP("VDFN"),0)),U))_U_ABMVLOC ;abm*2.6*15
+45 ;abm*2.6*15
WRITE U_+ABMCDAYS_U_+ABMNDAYS_U_ABMHRN_U_$$BDT^ABMDUTL($PIECE($GET(^AUPNVSIT(ABMP("VDFN"),0)),U))_U_ABMVLOC
+46 ;abm*2.6*20 IHS/SD/SDR HEAT256154
WRITE U_ABMP("BTYP")_U_ABMP("VTYP")_U_ABMITYPA_U_ABMATYP_"|"
+47 SET ABMTBILD=+$GET(ABMTBILD)+ABMBILLD
+48 SET ABMTPD=+$GET(ABMTPD)+ABMPD
+49 SET ABMTCDYS=+$GET(ABMTCDYS)+ABMCDAYS
+50 SET ABMTNDYS=+$GET(ABMTNDYS)+ABMNDAYS
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+51 SET DUZ(2)=ABMDUZ2
+52 QUIT