- 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
