- ABMMUFC2 ;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
- ; Req#B - Added code for Billed and Totals; changed existing line to Paid
- ; Req#C - Removed Swingbed
- ; Req#D - Resorted row order so Adult lines are together and Newborn are together
- ; Req#E - Added Private Prim/Mcd Second section
- ; Req#F - Added Grand Total section
- ; Req#G - Split Kidscare into XIX and XXI
- ;IHS/SD/SDR - 2.6*20 - HEAT256154 - Added IP Ancil Adult and Ped Charges and Bed Days.
- ;
- WRTSUMHO ;
- S ABM("HD",0)="HOSPITAL CALCULATION MU INCENTIVE REPORT"
- S ABM("PG")=1
- S ABMTYP="SUM" D WHD^ABMMUFAC
- S CENTER=IOM/2
- S ABMITYP=""
- ;F ABMITYP="MEDICARE","MEDICAID","PRIVATE","KIDSCARE/CHIP","VMBP","OTHER" D ;abm*2.6*15 HEAT183309 Req#E
- ;F ABMITYP="MEDICARE","MEDICAID","PRIVATE","PRI/MCD","KIDSCARE XIX","KIDSCARE XXI","VMBP","OTHER" D ;abm*2.6*15 HEAT183309 Req#E ;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*15 HEAT183309 Req#E ;abm*2.6*20 IHS/SD/SDR HEAT256154
- .W !!
- .I ABMITYP="PRI/MCD" W ?CENTER-($L("-- P V T I N S P R I M A R Y / M E D I C A I D S E C O N D A R Y --")/2),"-- P V T I N S P R I M A R Y / M E D I C A I D S E C O N D A R Y --" ;abm*2.6*15 HEAT183309 Req#E
- .I ABMITYP="PRIVATE" W ?CENTER-($L("-- P R I V A T E I N S U R A N C E --")/2),"-- P R I V A T E I N S U R A N C E --"
- .I ABMITYP="MEDICARE" W ?CENTER-($L("-- M E D I C A R E --")/2),"-- M E D I C A R E --"
- .I ABMITYP="MEDICAID" W ?CENTER-($L("-- M E D I C A I D --")/2),"-- M E D I C A I D --"
- .I ABMITYP="MCR/MCD" W ?CENTER-($L("-- M E D I C A R E / M E D I C A I D --")/2),"-- M E D I C A R E / M E D I C A I D --" ;abm*2.6*20 IHS/SD/SDR HEAT256154
- .;I ABMITYP="KIDSCARE/CHIP" W ?CENTER-($L("-- K I D S C A R E / C H I P --")/2),"-- K I D S C A R E / C H I P --" ;abm*2.6*15 HEAT183309 Req#H
- .;start new abm*2.6*15 HEAT183309 Req#H
- .I ABMITYP="KIDSCARE XIX" W ?CENTER-($L("-- K I D S C A R E T I T L E X I X --")/2),"-- K I D S C A R E T I T L E X I X --"
- .I ABMITYP="KIDSCARE XXI" W ?CENTER-($L("-- K I D S C A R E T I T L E X X I--")/2),"-- K I D S C A R E T I T L E X X I --"
- .;end new HEAT183309 Req#H
- .I ABMITYP="VMBP" W ?CENTER-($L("-- V E T E R A N S M E D I C A L B E N P R O G --")/2),"-- V E T E R A N S M E D I C A L B E N P R O G --"
- .I ABMITYP="OTHER" W ?CENTER-($L("-- O T H E R --")/2),"-- O T H E R --"
- .I ABMITYP="VISIT W/NO ELIG" W ?CENTER-($L("-- V I S I T S W / N O E L I G I B I L I T Y --")/2),"-- V I S I T S W / N O E L I G I B I L I T Y --" ;abm*2.6*20 IHS/SD/SDR HEAT256154
- .;start old abm*2.6*15 HEAT183309 Req#B
- .;W !?4,"# "_ABMITYP_" IP Adult & Ped Discharges",?59,$J(+$G(^TMP($J,"ABM-MUFAC",ABMITYP,"IP DISCHGS")),20)
- .;W !?4,"# "_ABMITYP_" IP Newborn Discharges",?59,$J(+$G(^TMP($J,"ABM-MUFAC",ABMITYP,"IP NB DISCHGS")),20)
- .;W !?4,"# "_ABMITYP_" IP Swingbed Discharges",?59,$J(+$G(^TMP($J,"ABM-MUFAC",ABMITYP,"IP SB DISCHGS")),20) ;removed for abm*2.6*15 HEAT183309 Req#C
- .;W !?4,"# "_ABMITYP_" IP Adult & Ped Bed Days",?59,$J(+$G(^TMP($J,"ABM-MUFAC",ABMITYP,"IP DAYS")),20)
- .;W !?4,"# "_ABMITYP_" IP Newborn Bed Days",?59,$J(+$G(^TMP($J,"ABM-MUFAC",ABMITYP,"IP NB DAYS")),20)
- .;W !?4,"# "_ABMITYP_" IP Swingbed Bed Days",?59,$J(+$G(^TMP($J,"ABM-MUFAC",ABMITYP,"IP SB DAYS")),20) ;removed for abm*2.6*15 HEAT183309 Req#C
- .;
- .;start new HEAT183309 Req#B
- .S ABMITOT=0
- .W !?4,"# "_ABMITYP_" IP Adult & Ped Discharges"
- .W ?50,$J(+$G(^TMP($J,"ABM-MUFAC",ABMITYP,"BLD","IP DISCHGS")),9)
- .W ?61,$J(+$G(^TMP($J,"ABM-MUFAC",ABMITYP,"PD","IP DISCHGS")),9)
- .S ABMITOT=+$G(^TMP($J,"ABM-MUFAC",ABMITYP,"NOTBLD","IP DISCHGS"))+$G(^TMP($J,"ABM-MUFAC",ABMITYP,"BLD","IP DISCHGS"))+$G(^TMP($J,"ABM-MUFAC",ABMITYP,"PD","IP DISCHGS"))
- .S ^TMP($J,"ABM-MUFAC","GTOT","BLD","IP DISCHGS")=+$G(^TMP($J,"ABM-MUFAC","GTOT","BLD","IP DISCHGS"))+$G(^TMP($J,"ABM-MUFAC",ABMITYP,"BLD","IP DISCHGS"))
- .S ^TMP($J,"ABM-MUFAC","GTOT","PD","IP DISCHGS")=+$G(^TMP($J,"ABM-MUFAC","GTOT","PD","IP DISCHGS"))+$G(^TMP($J,"ABM-MUFAC",ABMITYP,"PD","IP DISCHGS"))
- .S ^TMP($J,"ABM-MUFAC","GTOT","TOT","IP DISCHGS")=+$G(^TMP($J,"ABM-MUFAC","GTOT","TOT","IP DISCHGS"))+ABMITOT
- .W ?71,$J(ABMITOT,9)
- .;
- .;start new abm*2.6*20 IHS/SD/SDR HEAT256154
- .S ABMITOT=0
- .W !?4,"# "_ABMITYP_" IP Anc. Adult & Ped Dschrgs"
- .W ?50,$J(+$G(^TMP($J,"ABM-MUFAC",ABMITYP,"BLD","IP ANC DISCHGS")),9)
- .W ?61,$J(+$G(^TMP($J,"ABM-MUFAC",ABMITYP,"PD","IP ANC DISCHGS")),9)
- .S ABMITOT=+$G(^TMP($J,"ABM-MUFAC",ABMITYP,"NOTBLD","IP ANC DISCHGS"))+$G(^TMP($J,"ABM-MUFAC",ABMITYP,"BLD","IP ANC DISCHGS"))+$G(^TMP($J,"ABM-MUFAC",ABMITYP,"PD","IP ANC DISCHGS"))
- .S ^TMP($J,"ABM-MUFAC","GTOT","BLD","IP ANC DISCHGS")=+$G(^TMP($J,"ABM-MUFAC","GTOT","BLD","IP ANC DISCHGS"))+$G(^TMP($J,"ABM-MUFAC",ABMITYP,"BLD","IP ANC DISCHGS"))
- .S ^TMP($J,"ABM-MUFAC","GTOT","PD","IP ANC DISCHGS")=+$G(^TMP($J,"ABM-MUFAC","GTOT","PD","IP ANC DISCHGS"))+$G(^TMP($J,"ABM-MUFAC",ABMITYP,"PD","IP ANC DISCHGS"))
- .S ^TMP($J,"ABM-MUFAC","GTOT","TOT","IP ANC DISCHGS")=+$G(^TMP($J,"ABM-MUFAC","GTOT","TOT","IP ANC DISCHGS"))+ABMITOT
- .W ?71,$J(ABMITOT,9)
- .;end new abm*2.6*20 IHS/SD/SDR HEAT256154
- .;
- .S ABMITOT=0
- .W !?4,"# "_ABMITYP_" IP Adult & Ped Bed Days" ;this line was also edited for abm*2.6*15 HEAT183309 Req#D
- .W ?50,$J(+$G(^TMP($J,"ABM-MUFAC",ABMITYP,"BLD","IP DAYS")),9)
- .W ?61,$J(+$G(^TMP($J,"ABM-MUFAC",ABMITYP,"PD","IP DAYS")),9)
- .S ABMITOT=+$G(^TMP($J,"ABM-MUFAC",ABMITYP,"NOTBLD","IP DAYS"))+$G(^TMP($J,"ABM-MUFAC",ABMITYP,"BLD","IP DAYS"))+$G(^TMP($J,"ABM-MUFAC",ABMITYP,"PD","IP DAYS"))
- .S ^TMP($J,"ABM-MUFAC","GTOT","BLD","IP DAYS")=+$G(^TMP($J,"ABM-MUFAC","GTOT","BLD","IP DAYS"))+$G(^TMP($J,"ABM-MUFAC",ABMITYP,"BLD","IP DAYS"))
- .S ^TMP($J,"ABM-MUFAC","GTOT","PD","IP DAYS")=+$G(^TMP($J,"ABM-MUFAC","GTOT","PD","IP DAYS"))+$G(^TMP($J,"ABM-MUFAC",ABMITYP,"PD","IP DAYS"))
- .S ^TMP($J,"ABM-MUFAC","GTOT","TOT","IP DAYS")=+$G(^TMP($J,"ABM-MUFAC","GTOT","TOT","IP DAYS"))+ABMITOT
- .W ?71,$J(ABMITOT,9)
- .;
- .;start new abm*2.6*20 IHS/SD/SDR HEAT256154
- .S ABMITOT=0
- .W !?4,"# "_ABMITYP_" IP Anc. Adult & Ped Bed Days"
- .W ?50,$J(+$G(^TMP($J,"ABM-MUFAC",ABMITYP,"BLD","IP ANC DAYS")),9)
- .W ?61,$J(+$G(^TMP($J,"ABM-MUFAC",ABMITYP,"PD","IP ANC DAYS")),9)
- .S ABMITOT=+$G(^TMP($J,"ABM-MUFAC",ABMITYP,"NOTBLD","IP ANC DAYS"))+$G(^TMP($J,"ABM-MUFAC",ABMITYP,"BLD","IP ANC DAYS"))+$G(^TMP($J,"ABM-MUFAC",ABMITYP,"PD","IP ANC DAYS"))
- .S ^TMP($J,"ABM-MUFAC","GTOT","BLD","IP ANC DAYS")=+$G(^TMP($J,"ABM-MUFAC","GTOT","BLD","IP ANC DAYS"))+$G(^TMP($J,"ABM-MUFAC",ABMITYP,"BLD","IP ANC DAYS"))
- .S ^TMP($J,"ABM-MUFAC","GTOT","PD","IP ANC DAYS")=+$G(^TMP($J,"ABM-MUFAC","GTOT","PD","IP ANC DAYS"))+$G(^TMP($J,"ABM-MUFAC",ABMITYP,"PD","IP ANC DAYS"))
- .S ^TMP($J,"ABM-MUFAC","GTOT","TOT","IP ANC DAYS")=+$G(^TMP($J,"ABM-MUFAC","GTOT","TOT","IP ANC DAYS"))+ABMITOT
- .W ?71,$J(ABMITOT,9)
- .;end new abm*2.6*20 IHS/SD/SDR HEAT256154
- .;
- .S ABMITOT=0
- .W !?4,"# "_ABMITYP_" IP Newborn Discharges"
- .W ?50,$J(+$G(^TMP($J,"ABM-MUFAC",ABMITYP,"BLD","IP NB DISCHGS")),9)
- .W ?61,$J(+$G(^TMP($J,"ABM-MUFAC",ABMITYP,"PD","IP NB DISCHGS")),9)
- .S ABMITOT=+$G(^TMP($J,"ABM-MUFAC",ABMITYP,"NOTBLD","IP NB DISCHGS"))+$G(^TMP($J,"ABM-MUFAC",ABMITYP,"BLD","IP NB DISCHGS"))+$G(^TMP($J,"ABM-MUFAC",ABMITYP,"PD","IP NB DISCHGS"))
- .S ^TMP($J,"ABM-MUFAC","GTOT","BLD","IP NB DISCHGS")=+$G(^TMP($J,"ABM-MUFAC","GTOT","BLD","IP NB DISCHGS"))+$G(^TMP($J,"ABM-MUFAC",ABMITYP,"BLD","IP NB DISCHGS"))
- .S ^TMP($J,"ABM-MUFAC","GTOT","PD","IP NB DISCHGS")=+$G(^TMP($J,"ABM-MUFAC","GTOT","PD","IP NB DISCHGS"))+$G(^TMP($J,"ABM-MUFAC",ABMITYP,"PD","IP NB DISCHGS"))
- .S ^TMP($J,"ABM-MUFAC","GTOT","TOT","IP NB DISCHGS")=+$G(^TMP($J,"ABM-MUFAC","GTOT","TOT","IP NB DISCHGS"))+ABMITOT
- .W ?71,$J(ABMITOT,9)
- .;
- .S ABMITOT=0
- .W !?4,"# "_ABMITYP_" IP Newborn Bed Days" ;this line was also edited for abm*2.6*15 HEAT183309 Req#D
- .W ?50,$J(+$G(^TMP($J,"ABM-MUFAC",ABMITYP,"BLD","IP NB DAYS")),9)
- .W ?61,$J(+$G(^TMP($J,"ABM-MUFAC",ABMITYP,"PD","IP NB DAYS")),9)
- .S ABMITOT=+$G(^TMP($J,"ABM-MUFAC",ABMITYP,"NOTBLD","IP NB DAYS"))+$G(^TMP($J,"ABM-MUFAC",ABMITYP,"BLD","IP NB DAYS"))+$G(^TMP($J,"ABM-MUFAC",ABMITYP,"PD","IP NB DAYS"))
- .S ^TMP($J,"ABM-MUFAC","GTOT","BLD","IP NB DAYS")=+$G(^TMP($J,"ABM-MUFAC","GTOT","BLD","IP NB DAYS"))+$G(^TMP($J,"ABM-MUFAC",ABMITYP,"BLD","IP NB DAYS"))
- .S ^TMP($J,"ABM-MUFAC","GTOT","PD","IP NB DAYS")=+$G(^TMP($J,"ABM-MUFAC","GTOT","PD","IP NB DAYS"))+$G(^TMP($J,"ABM-MUFAC",ABMITYP,"PD","IP NB DAYS"))
- .S ^TMP($J,"ABM-MUFAC","GTOT","TOT","IP NB DAYS")=+$G(^TMP($J,"ABM-MUFAC","GTOT","TOT","IP NB DAYS"))+ABMITOT
- .W ?71,$J(ABMITOT,9)
- .;end new HEAT183309 Req#B
- .I $Y>(IOSL-5) D HD^ABMMUFAC Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT) W " (cont)"
- W !!
- ;start new abm*2.6*15 HEAT183309 Req#B and Req#F
- S CENTER=IOM/2
- W ?CENTER-($L("-- G R A N D T O T A L A L L V I S I T S --")/2),"-- G R A N D T O T A L A L L V I S I T S --"
- W !?4,"# ALL IP Adult & Ped Discharges"
- W ?50,$J(+$G(^TMP($J,"ABM-MUFAC","GTOT","BLD","IP DISCHGS")),9)
- W ?61,$J(+$G(^TMP($J,"ABM-MUFAC","GTOT","PD","IP DISCHGS")),9)
- W ?71,$J(+$G(^TMP($J,"ABM-MUFAC","GTOT","TOT","IP DISCHGS")),9)
- ;
- ;start new abm*2.6*20 IHS/SD/SDR HEAT256154
- W !?4,"# ALL IP Ancil. Adult & Ped Dischrgs"
- W ?50,$J(+$G(^TMP($J,"ABM-MUFAC","GTOT","BLD","IP ANC DISCHGS")),9)
- W ?61,$J(+$G(^TMP($J,"ABM-MUFAC","GTOT","PD","IP ANC DISCHGS")),9)
- W ?71,$J(+$G(^TMP($J,"ABM-MUFAC","GTOT","TOT","IP ANC DISCHGS")),9)
- ;end new abm*2.6*20 IHS/SD/SDR HEAT256154
- ;
- W !?4,"# ALL IP Adult & Ped Bed Days"
- W ?50,$J(+$G(^TMP($J,"ABM-MUFAC","GTOT","BLD","IP DAYS")),9)
- W ?61,$J(+$G(^TMP($J,"ABM-MUFAC","GTOT","PD","IP DAYS")),9)
- W ?71,$J(+$G(^TMP($J,"ABM-MUFAC","GTOT","TOT","IP DAYS")),9)
- ;
- ;start new abm*2.6*20 IHS/SD/SDR HEAT256154
- W !?4,"# ALL IP Ancil. Adult & Ped Bed Days"
- W ?50,$J(+$G(^TMP($J,"ABM-MUFAC","GTOT","BLD","IP ANC DAYS")),9)
- W ?61,$J(+$G(^TMP($J,"ABM-MUFAC","GTOT","PD","IP ANC DAYS")),9)
- W ?71,$J(+$G(^TMP($J,"ABM-MUFAC","GTOT","TOT","IP ANC DAYS")),9)
- ;end new abm*2.6*20 IHS/SD/SDR HEAT256154
- ;
- W !?4,"# ALL IP Newborn Discharges"
- W ?50,$J(+$G(^TMP($J,"ABM-MUFAC","GTOT","BLD","IP NB DISCHGS")),9)
- W ?61,$J(+$G(^TMP($J,"ABM-MUFAC","GTOT","PD","IP NB DISCHGS")),9)
- W ?71,$J(+$G(^TMP($J,"ABM-MUFAC","GTOT","TOT","IP NB DISCHGS")),9)
- ;
- W !?4,"# ALL IP Newborn Bed Days"
- W ?50,$J(+$G(^TMP($J,"ABM-MUFAC","GTOT","BLD","IP NB DAYS")),9)
- W ?61,$J(+$G(^TMP($J,"ABM-MUFAC","GTOT","PD","IP NB DAYS")),9)
- W ?71,$J(+$G(^TMP($J,"ABM-MUFAC","GTOT","TOT","IP NB DAYS")),9)
- ;end new HEAT183309 Req#F
- W !!,"(SUMMARY REPORT COMPLETE):"
- D PAZ^ABMDRUTL Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
- S DUZ(2)=ABMDUZ2
- Q
- WRTDTL ;
- I ABMY("FACHOS")="H" D WRTDTLHO^ABMMUFC4 Q ;abm*2.6*15 HEAT183309 Req#I
- S ABM("HD",0)="FACILITY EHR INCENTIVE REPORT" ;abm*2.6*7
- I ABMY("FACHOS")="H" S ABM("HD",0)="HOSPITAL CALCULATION MU INCENTIVE REPORT" ;abm*2.6*12
- S ABM("PG")=1 ;abm*2.6*7
- S ABMTYP="DET" D WHD^ABMMUFAC
- S CENTER=IOM/2
- F ABMITYP="MEDICARE","MEDICAID","PRIVATE","KIDSCARE/CHIP","VMBP","OTHER" D ;abm*2.6*12 VMBP RQMT_104
- .S ABMCHG=""
- .F S ABMCHG=$O(^TMP($J,"ABM-MUFAC","DETAIL",ABMITYP,ABMCHG)) Q:($G(ABMCHG)="") D
- ..S (ABMTBILD,ABMTPD,ABMTCDYS,ABMTNDYS)=0
- ..S ABMINS=""
- ..F S ABMINS=$O(^TMP($J,"ABM-MUFAC","DETAIL",ABMITYP,ABMCHG,ABMINS)) Q:ABMINS="" D
- ...S ABMP("VDFN")=0
- ...F S ABMP("VDFN")=$O(^TMP($J,"ABM-MUFAC","DETAIL",ABMITYP,ABMCHG,ABMINS,ABMP("VDFN"))) Q:'ABMP("VDFN") D
- ....S ABMREC=$G(^TMP($J,"ABM-MUFAC","DETAIL",ABMITYP,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 ABMBILLN=0
- ....S:ABMP("BDFN") ABMBILLN=$P($G(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),0)),U)
- ....;S ABMP("PDFN")=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)),U,5) ;abm*2.6*7 ;abm*2.6*15 HEAT183309 Req#B
- ....S ABMP("PDFN")=$P($G(^AUPNVSIT(ABMP("VDFN"),0)),U,5) ;abm*2.6*15 HEAT183309 Req#B
- ....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_ABMCHG
- ....W U_$P(ABMINS,"|")_U_$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,$P(ABMINS,"|",2),".211","I"),1,"I") ;abm*2.6*12 VMBP RQMT_104
- ....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_$$CDT^ABMDUTL($P($G(^AUPNVSIT(ABMP("VDFN"),0)),U))_U_ABMVLOC ;abm*2.6*15
- ....W U_+ABMCDAYS_U_+ABMNDAYS_U_$$BDT^ABMDUTL($P($G(^AUPNVSIT(ABMP("VDFN"),0)),U))_U_ABMVLOC ;abm*2.6*15
- S DUZ(2)=ABMDUZ2
- Q
- ABMMUFC2 ;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
- +3 ; split routine due to size
- +4 ; Req#B - Added code for Billed and Totals; changed existing line to Paid
- +5 ; Req#C - Removed Swingbed
- +6 ; Req#D - Resorted row order so Adult lines are together and Newborn are together
- +7 ; Req#E - Added Private Prim/Mcd Second section
- +8 ; Req#F - Added Grand Total section
- +9 ; Req#G - Split Kidscare into XIX and XXI
- +10 ;IHS/SD/SDR - 2.6*20 - HEAT256154 - Added IP Ancil Adult and Ped Charges and Bed Days.
- +11 ;
- WRTSUMHO ;
- +1 SET ABM("HD",0)="HOSPITAL CALCULATION MU INCENTIVE REPORT"
- +2 SET ABM("PG")=1
- +3 SET ABMTYP="SUM"
- DO WHD^ABMMUFAC
- +4 SET CENTER=IOM/2
- +5 SET ABMITYP=""
- +6 ;F ABMITYP="MEDICARE","MEDICAID","PRIVATE","KIDSCARE/CHIP","VMBP","OTHER" D ;abm*2.6*15 HEAT183309 Req#E
- +7 ;F ABMITYP="MEDICARE","MEDICAID","PRIVATE","PRI/MCD","KIDSCARE XIX","KIDSCARE XXI","VMBP","OTHER" D ;abm*2.6*15 HEAT183309 Req#E ;abm*2.6*20 IHS/SD/SDR HEAT256154
- +8 ;abm*2.6*15 HEAT183309 Req#E ;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
- +9 WRITE !!
- +10 ;abm*2.6*15 HEAT183309 Req#E
- IF ABMITYP="PRI/MCD"
- WRITE ?CENTER-($LENGTH("-- P V T I N S P R I M A R Y / M E D I C A I D S E C O N D A R Y --")/2),"-- P V T I N S P R I M A R Y / M E D I C A I D S E C O N D A R Y --"
- +11 IF ABMITYP="PRIVATE"
- WRITE ?CENTER-($LENGTH("-- P R I V A T E I N S U R A N C E --")/2),"-- P R I V A T E I N S U R A N C E --"
- +12 IF ABMITYP="MEDICARE"
- WRITE ?CENTER-($LENGTH("-- M E D I C A R E --")/2),"-- M E D I C A R E --"
- +13 IF ABMITYP="MEDICAID"
- WRITE ?CENTER-($LENGTH("-- M E D I C A I D --")/2),"-- M E D I C A I D --"
- +14 ;abm*2.6*20 IHS/SD/SDR HEAT256154
- IF ABMITYP="MCR/MCD"
- WRITE ?CENTER-($LENGTH("-- M E D I C A R E / M E D I C A I D --")/2),"-- M E D I C A R E / M E D I C A I D --"
- +15 ;I ABMITYP="KIDSCARE/CHIP" W ?CENTER-($L("-- K I D S C A R E / C H I P --")/2),"-- K I D S C A R E / C H I P --" ;abm*2.6*15 HEAT183309 Req#H
- +16 ;start new abm*2.6*15 HEAT183309 Req#H
- +17 IF ABMITYP="KIDSCARE XIX"
- WRITE ?CENTER-($LENGTH("-- K I D S C A R E T I T L E X I X --")/2),"-- K I D S C A R E T I T L E X I X --"
- +18 IF ABMITYP="KIDSCARE XXI"
- WRITE ?CENTER-($LENGTH("-- K I D S C A R E T I T L E X X I--")/2),"-- K I D S C A R E T I T L E X X I --"
- +19 ;end new HEAT183309 Req#H
- +20 IF ABMITYP="VMBP"
- WRITE ?CENTER-($LENGTH("-- V E T E R A N S M E D I C A L B E N P R O G --")/2),"-- V E T E R A N S M E D I C A L B E N P R O G --"
- +21 IF ABMITYP="OTHER"
- WRITE ?CENTER-($LENGTH("-- O T H E R --")/2),"-- O T H E R --"
- +22 ;abm*2.6*20 IHS/SD/SDR HEAT256154
- IF ABMITYP="VISIT W/NO ELIG"
- WRITE ?CENTER-($LENGTH("-- V I S I T S W / N O E L I G I B I L I T Y --")/2),"-- V I S I T S W / N O E L I G I B I L I T Y --"
- +23 ;start old abm*2.6*15 HEAT183309 Req#B
- +24 ;W !?4,"# "_ABMITYP_" IP Adult & Ped Discharges",?59,$J(+$G(^TMP($J,"ABM-MUFAC",ABMITYP,"IP DISCHGS")),20)
- +25 ;W !?4,"# "_ABMITYP_" IP Newborn Discharges",?59,$J(+$G(^TMP($J,"ABM-MUFAC",ABMITYP,"IP NB DISCHGS")),20)
- +26 ;W !?4,"# "_ABMITYP_" IP Swingbed Discharges",?59,$J(+$G(^TMP($J,"ABM-MUFAC",ABMITYP,"IP SB DISCHGS")),20) ;removed for abm*2.6*15 HEAT183309 Req#C
- +27 ;W !?4,"# "_ABMITYP_" IP Adult & Ped Bed Days",?59,$J(+$G(^TMP($J,"ABM-MUFAC",ABMITYP,"IP DAYS")),20)
- +28 ;W !?4,"# "_ABMITYP_" IP Newborn Bed Days",?59,$J(+$G(^TMP($J,"ABM-MUFAC",ABMITYP,"IP NB DAYS")),20)
- +29 ;W !?4,"# "_ABMITYP_" IP Swingbed Bed Days",?59,$J(+$G(^TMP($J,"ABM-MUFAC",ABMITYP,"IP SB DAYS")),20) ;removed for abm*2.6*15 HEAT183309 Req#C
- +30 ;
- +31 ;start new HEAT183309 Req#B
- +32 SET ABMITOT=0
- +33 WRITE !?4,"# "_ABMITYP_" IP Adult & Ped Discharges"
- +34 WRITE ?50,$JUSTIFY(+$GET(^TMP($JOB,"ABM-MUFAC",ABMITYP,"BLD","IP DISCHGS")),9)
- +35 WRITE ?61,$JUSTIFY(+$GET(^TMP($JOB,"ABM-MUFAC",ABMITYP,"PD","IP DISCHGS")),9)
- +36 SET ABMITOT=+$GET(^TMP($JOB,"ABM-MUFAC",ABMITYP,"NOTBLD","IP DISCHGS"))+$GET(^TMP($JOB,"ABM-MUFAC",ABMITYP,"BLD","IP DISCHGS"))+$GET(^TMP($JOB,"ABM-MUFAC",ABMITYP,"PD","IP DISCHGS"))
- +37 SET ^TMP($JOB,"ABM-MUFAC","GTOT","BLD","IP DISCHGS")=+$GET(^TMP($JOB,"ABM-MUFAC","GTOT","BLD","IP DISCHGS"))+$GET(^TMP($JOB,"ABM-MUFAC",ABMITYP,"BLD","IP DISCHGS"))
- +38 SET ^TMP($JOB,"ABM-MUFAC","GTOT","PD","IP DISCHGS")=+$GET(^TMP($JOB,"ABM-MUFAC","GTOT","PD","IP DISCHGS"))+$GET(^TMP($JOB,"ABM-MUFAC",ABMITYP,"PD","IP DISCHGS"))
- +39 SET ^TMP($JOB,"ABM-MUFAC","GTOT","TOT","IP DISCHGS")=+$GET(^TMP($JOB,"ABM-MUFAC","GTOT","TOT","IP DISCHGS"))+ABMITOT
- +40 WRITE ?71,$JUSTIFY(ABMITOT,9)
- +41 ;
- +42 ;start new abm*2.6*20 IHS/SD/SDR HEAT256154
- +43 SET ABMITOT=0
- +44 WRITE !?4,"# "_ABMITYP_" IP Anc. Adult & Ped Dschrgs"
- +45 WRITE ?50,$JUSTIFY(+$GET(^TMP($JOB,"ABM-MUFAC",ABMITYP,"BLD","IP ANC DISCHGS")),9)
- +46 WRITE ?61,$JUSTIFY(+$GET(^TMP($JOB,"ABM-MUFAC",ABMITYP,"PD","IP ANC DISCHGS")),9)
- +47 SET ABMITOT=+$GET(^TMP($JOB,"ABM-MUFAC",ABMITYP,"NOTBLD","IP ANC DISCHGS"))+$GET(^TMP($JOB,"ABM-MUFAC",ABMITYP,"BLD","IP ANC DISCHGS"))+$GET(^TMP($JOB,"ABM-MUFAC",ABMITYP,"PD","IP ANC DISCHGS"))
- +48 SET ^TMP($JOB,"ABM-MUFAC","GTOT","BLD","IP ANC DISCHGS")=+$GET(^TMP($JOB,"ABM-MUFAC","GTOT","BLD","IP ANC DISCHGS"))+$GET(^TMP($JOB,"ABM-MUFAC",ABMITYP,"BLD","IP ANC DISCHGS"))
- +49 SET ^TMP($JOB,"ABM-MUFAC","GTOT","PD","IP ANC DISCHGS")=+$GET(^TMP($JOB,"ABM-MUFAC","GTOT","PD","IP ANC DISCHGS"))+$GET(^TMP($JOB,"ABM-MUFAC",ABMITYP,"PD","IP ANC DISCHGS"))
- +50 SET ^TMP($JOB,"ABM-MUFAC","GTOT","TOT","IP ANC DISCHGS")=+$GET(^TMP($JOB,"ABM-MUFAC","GTOT","TOT","IP ANC DISCHGS"))+ABMITOT
- +51 WRITE ?71,$JUSTIFY(ABMITOT,9)
- +52 ;end new abm*2.6*20 IHS/SD/SDR HEAT256154
- +53 ;
- +54 SET ABMITOT=0
- +55 ;this line was also edited for abm*2.6*15 HEAT183309 Req#D
- WRITE !?4,"# "_ABMITYP_" IP Adult & Ped Bed Days"
- +56 WRITE ?50,$JUSTIFY(+$GET(^TMP($JOB,"ABM-MUFAC",ABMITYP,"BLD","IP DAYS")),9)
- +57 WRITE ?61,$JUSTIFY(+$GET(^TMP($JOB,"ABM-MUFAC",ABMITYP,"PD","IP DAYS")),9)
- +58 SET ABMITOT=+$GET(^TMP($JOB,"ABM-MUFAC",ABMITYP,"NOTBLD","IP DAYS"))+$GET(^TMP($JOB,"ABM-MUFAC",ABMITYP,"BLD","IP DAYS"))+$GET(^TMP($JOB,"ABM-MUFAC",ABMITYP,"PD","IP DAYS"))
- +59 SET ^TMP($JOB,"ABM-MUFAC","GTOT","BLD","IP DAYS")=+$GET(^TMP($JOB,"ABM-MUFAC","GTOT","BLD","IP DAYS"))+$GET(^TMP($JOB,"ABM-MUFAC",ABMITYP,"BLD","IP DAYS"))
- +60 SET ^TMP($JOB,"ABM-MUFAC","GTOT","PD","IP DAYS")=+$GET(^TMP($JOB,"ABM-MUFAC","GTOT","PD","IP DAYS"))+$GET(^TMP($JOB,"ABM-MUFAC",ABMITYP,"PD","IP DAYS"))
- +61 SET ^TMP($JOB,"ABM-MUFAC","GTOT","TOT","IP DAYS")=+$GET(^TMP($JOB,"ABM-MUFAC","GTOT","TOT","IP DAYS"))+ABMITOT
- +62 WRITE ?71,$JUSTIFY(ABMITOT,9)
- +63 ;
- +64 ;start new abm*2.6*20 IHS/SD/SDR HEAT256154
- +65 SET ABMITOT=0
- +66 WRITE !?4,"# "_ABMITYP_" IP Anc. Adult & Ped Bed Days"
- +67 WRITE ?50,$JUSTIFY(+$GET(^TMP($JOB,"ABM-MUFAC",ABMITYP,"BLD","IP ANC DAYS")),9)
- +68 WRITE ?61,$JUSTIFY(+$GET(^TMP($JOB,"ABM-MUFAC",ABMITYP,"PD","IP ANC DAYS")),9)
- +69 SET ABMITOT=+$GET(^TMP($JOB,"ABM-MUFAC",ABMITYP,"NOTBLD","IP ANC DAYS"))+$GET(^TMP($JOB,"ABM-MUFAC",ABMITYP,"BLD","IP ANC DAYS"))+$GET(^TMP($JOB,"ABM-MUFAC",ABMITYP,"PD","IP ANC DAYS"))
- +70 SET ^TMP($JOB,"ABM-MUFAC","GTOT","BLD","IP ANC DAYS")=+$GET(^TMP($JOB,"ABM-MUFAC","GTOT","BLD","IP ANC DAYS"))+$GET(^TMP($JOB,"ABM-MUFAC",ABMITYP,"BLD","IP ANC DAYS"))
- +71 SET ^TMP($JOB,"ABM-MUFAC","GTOT","PD","IP ANC DAYS")=+$GET(^TMP($JOB,"ABM-MUFAC","GTOT","PD","IP ANC DAYS"))+$GET(^TMP($JOB,"ABM-MUFAC",ABMITYP,"PD","IP ANC DAYS"))
- +72 SET ^TMP($JOB,"ABM-MUFAC","GTOT","TOT","IP ANC DAYS")=+$GET(^TMP($JOB,"ABM-MUFAC","GTOT","TOT","IP ANC DAYS"))+ABMITOT
- +73 WRITE ?71,$JUSTIFY(ABMITOT,9)
- +74 ;end new abm*2.6*20 IHS/SD/SDR HEAT256154
- +75 ;
- +76 SET ABMITOT=0
- +77 WRITE !?4,"# "_ABMITYP_" IP Newborn Discharges"
- +78 WRITE ?50,$JUSTIFY(+$GET(^TMP($JOB,"ABM-MUFAC",ABMITYP,"BLD","IP NB DISCHGS")),9)
- +79 WRITE ?61,$JUSTIFY(+$GET(^TMP($JOB,"ABM-MUFAC",ABMITYP,"PD","IP NB DISCHGS")),9)
- +80 SET ABMITOT=+$GET(^TMP($JOB,"ABM-MUFAC",ABMITYP,"NOTBLD","IP NB DISCHGS"))+$GET(^TMP($JOB,"ABM-MUFAC",ABMITYP,"BLD","IP NB DISCHGS"))+$GET(^TMP($JOB,"ABM-MUFAC",ABMITYP,"PD","IP NB DISCHGS"))
- +81 SET ^TMP($JOB,"ABM-MUFAC","GTOT","BLD","IP NB DISCHGS")=+$GET(^TMP($JOB,"ABM-MUFAC","GTOT","BLD","IP NB DISCHGS"))+$GET(^TMP($JOB,"ABM-MUFAC",ABMITYP,"BLD","IP NB DISCHGS"))
- +82 SET ^TMP($JOB,"ABM-MUFAC","GTOT","PD","IP NB DISCHGS")=+$GET(^TMP($JOB,"ABM-MUFAC","GTOT","PD","IP NB DISCHGS"))+$GET(^TMP($JOB,"ABM-MUFAC",ABMITYP,"PD","IP NB DISCHGS"))
- +83 SET ^TMP($JOB,"ABM-MUFAC","GTOT","TOT","IP NB DISCHGS")=+$GET(^TMP($JOB,"ABM-MUFAC","GTOT","TOT","IP NB DISCHGS"))+ABMITOT
- +84 WRITE ?71,$JUSTIFY(ABMITOT,9)
- +85 ;
- +86 SET ABMITOT=0
- +87 ;this line was also edited for abm*2.6*15 HEAT183309 Req#D
- WRITE !?4,"# "_ABMITYP_" IP Newborn Bed Days"
- +88 WRITE ?50,$JUSTIFY(+$GET(^TMP($JOB,"ABM-MUFAC",ABMITYP,"BLD","IP NB DAYS")),9)
- +89 WRITE ?61,$JUSTIFY(+$GET(^TMP($JOB,"ABM-MUFAC",ABMITYP,"PD","IP NB DAYS")),9)
- +90 SET ABMITOT=+$GET(^TMP($JOB,"ABM-MUFAC",ABMITYP,"NOTBLD","IP NB DAYS"))+$GET(^TMP($JOB,"ABM-MUFAC",ABMITYP,"BLD","IP NB DAYS"))+$GET(^TMP($JOB,"ABM-MUFAC",ABMITYP,"PD","IP NB DAYS"))
- +91 SET ^TMP($JOB,"ABM-MUFAC","GTOT","BLD","IP NB DAYS")=+$GET(^TMP($JOB,"ABM-MUFAC","GTOT","BLD","IP NB DAYS"))+$GET(^TMP($JOB,"ABM-MUFAC",ABMITYP,"BLD","IP NB DAYS"))
- +92 SET ^TMP($JOB,"ABM-MUFAC","GTOT","PD","IP NB DAYS")=+$GET(^TMP($JOB,"ABM-MUFAC","GTOT","PD","IP NB DAYS"))+$GET(^TMP($JOB,"ABM-MUFAC",ABMITYP,"PD","IP NB DAYS"))
- +93 SET ^TMP($JOB,"ABM-MUFAC","GTOT","TOT","IP NB DAYS")=+$GET(^TMP($JOB,"ABM-MUFAC","GTOT","TOT","IP NB DAYS"))+ABMITOT
- +94 WRITE ?71,$JUSTIFY(ABMITOT,9)
- +95 ;end new HEAT183309 Req#B
- +96 IF $Y>(IOSL-5)
- DO HD^ABMMUFAC
- IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
- QUIT
- WRITE " (cont)"
- End DoDot:1
- +97 WRITE !!
- +98 ;start new abm*2.6*15 HEAT183309 Req#B and Req#F
- +99 SET CENTER=IOM/2
- +100 WRITE ?CENTER-($LENGTH("-- G R A N D T O T A L A L L V I S I T S --")/2),"-- G R A N D T O T A L A L L V I S I T S --"
- +101 WRITE !?4,"# ALL IP Adult & Ped Discharges"
- +102 WRITE ?50,$JUSTIFY(+$GET(^TMP($JOB,"ABM-MUFAC","GTOT","BLD","IP DISCHGS")),9)
- +103 WRITE ?61,$JUSTIFY(+$GET(^TMP($JOB,"ABM-MUFAC","GTOT","PD","IP DISCHGS")),9)
- +104 WRITE ?71,$JUSTIFY(+$GET(^TMP($JOB,"ABM-MUFAC","GTOT","TOT","IP DISCHGS")),9)
- +105 ;
- +106 ;start new abm*2.6*20 IHS/SD/SDR HEAT256154
- +107 WRITE !?4,"# ALL IP Ancil. Adult & Ped Dischrgs"
- +108 WRITE ?50,$JUSTIFY(+$GET(^TMP($JOB,"ABM-MUFAC","GTOT","BLD","IP ANC DISCHGS")),9)
- +109 WRITE ?61,$JUSTIFY(+$GET(^TMP($JOB,"ABM-MUFAC","GTOT","PD","IP ANC DISCHGS")),9)
- +110 WRITE ?71,$JUSTIFY(+$GET(^TMP($JOB,"ABM-MUFAC","GTOT","TOT","IP ANC DISCHGS")),9)
- +111 ;end new abm*2.6*20 IHS/SD/SDR HEAT256154
- +112 ;
- +113 WRITE !?4,"# ALL IP Adult & Ped Bed Days"
- +114 WRITE ?50,$JUSTIFY(+$GET(^TMP($JOB,"ABM-MUFAC","GTOT","BLD","IP DAYS")),9)
- +115 WRITE ?61,$JUSTIFY(+$GET(^TMP($JOB,"ABM-MUFAC","GTOT","PD","IP DAYS")),9)
- +116 WRITE ?71,$JUSTIFY(+$GET(^TMP($JOB,"ABM-MUFAC","GTOT","TOT","IP DAYS")),9)
- +117 ;
- +118 ;start new abm*2.6*20 IHS/SD/SDR HEAT256154
- +119 WRITE !?4,"# ALL IP Ancil. Adult & Ped Bed Days"
- +120 WRITE ?50,$JUSTIFY(+$GET(^TMP($JOB,"ABM-MUFAC","GTOT","BLD","IP ANC DAYS")),9)
- +121 WRITE ?61,$JUSTIFY(+$GET(^TMP($JOB,"ABM-MUFAC","GTOT","PD","IP ANC DAYS")),9)
- +122 WRITE ?71,$JUSTIFY(+$GET(^TMP($JOB,"ABM-MUFAC","GTOT","TOT","IP ANC DAYS")),9)
- +123 ;end new abm*2.6*20 IHS/SD/SDR HEAT256154
- +124 ;
- +125 WRITE !?4,"# ALL IP Newborn Discharges"
- +126 WRITE ?50,$JUSTIFY(+$GET(^TMP($JOB,"ABM-MUFAC","GTOT","BLD","IP NB DISCHGS")),9)
- +127 WRITE ?61,$JUSTIFY(+$GET(^TMP($JOB,"ABM-MUFAC","GTOT","PD","IP NB DISCHGS")),9)
- +128 WRITE ?71,$JUSTIFY(+$GET(^TMP($JOB,"ABM-MUFAC","GTOT","TOT","IP NB DISCHGS")),9)
- +129 ;
- +130 WRITE !?4,"# ALL IP Newborn Bed Days"
- +131 WRITE ?50,$JUSTIFY(+$GET(^TMP($JOB,"ABM-MUFAC","GTOT","BLD","IP NB DAYS")),9)
- +132 WRITE ?61,$JUSTIFY(+$GET(^TMP($JOB,"ABM-MUFAC","GTOT","PD","IP NB DAYS")),9)
- +133 WRITE ?71,$JUSTIFY(+$GET(^TMP($JOB,"ABM-MUFAC","GTOT","TOT","IP NB DAYS")),9)
- +134 ;end new HEAT183309 Req#F
- +135 WRITE !!,"(SUMMARY REPORT COMPLETE):"
- +136 DO PAZ^ABMDRUTL
- IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
- QUIT
- +137 SET DUZ(2)=ABMDUZ2
- +138 QUIT
- WRTDTL ;
- +1 ;abm*2.6*15 HEAT183309 Req#I
- IF ABMY("FACHOS")="H"
- DO WRTDTLHO^ABMMUFC4
- QUIT
- +2 ;abm*2.6*7
- SET ABM("HD",0)="FACILITY EHR INCENTIVE REPORT"
- +3 ;abm*2.6*12
- IF ABMY("FACHOS")="H"
- SET ABM("HD",0)="HOSPITAL CALCULATION MU INCENTIVE REPORT"
- +4 ;abm*2.6*7
- SET ABM("PG")=1
- +5 SET ABMTYP="DET"
- DO WHD^ABMMUFAC
- +6 SET CENTER=IOM/2
- +7 ;abm*2.6*12 VMBP RQMT_104
- FOR ABMITYP="MEDICARE","MEDICAID","PRIVATE","KIDSCARE/CHIP","VMBP","OTHER"
- Begin DoDot:1
- +8 SET ABMCHG=""
- +9 FOR
- SET ABMCHG=$ORDER(^TMP($JOB,"ABM-MUFAC","DETAIL",ABMITYP,ABMCHG))
- IF ($GET(ABMCHG)="")
- QUIT
- Begin DoDot:2
- +10 SET (ABMTBILD,ABMTPD,ABMTCDYS,ABMTNDYS)=0
- +11 SET ABMINS=""
- +12 FOR
- SET ABMINS=$ORDER(^TMP($JOB,"ABM-MUFAC","DETAIL",ABMITYP,ABMCHG,ABMINS))
- IF ABMINS=""
- QUIT
- Begin DoDot:3
- +13 SET ABMP("VDFN")=0
- +14 FOR
- SET ABMP("VDFN")=$ORDER(^TMP($JOB,"ABM-MUFAC","DETAIL",ABMITYP,ABMCHG,ABMINS,ABMP("VDFN")))
- IF 'ABMP("VDFN")
- QUIT
- Begin DoDot:4
- +15 SET ABMREC=$GET(^TMP($JOB,"ABM-MUFAC","DETAIL",ABMITYP,ABMCHG,ABMINS,ABMP("VDFN")))
- +16 SET ABMDOSB=$PIECE(ABMREC,U)
- +17 SET ABMDOSE=$PIECE(ABMREC,U,2)
- +18 SET ABMBILLD=$PIECE(ABMREC,U,3)
- +19 SET ABMPD=$PIECE(ABMREC,U,4)
- +20 SET ABMCDAYS=$PIECE(ABMREC,U,5)
- +21 SET ABMNDAYS=$PIECE(ABMREC,U,6)
- +22 SET ABMVLOC=$PIECE(ABMREC,U,7)
- +23 SET ABMDUZ2=+$PIECE(ABMREC,U,8)
- +24 SET ABMP("BDFN")=+$PIECE(ABMREC,U,9)
- +25 SET ABMBILLN=0
- +26 IF ABMP("BDFN")
- SET ABMBILLN=$PIECE($GET(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),0)),U)
- +27 ;S ABMP("PDFN")=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)),U,5) ;abm*2.6*7 ;abm*2.6*15 HEAT183309 Req#B
- +28 ;abm*2.6*15 HEAT183309 Req#B
- SET ABMP("PDFN")=$PIECE($GET(^AUPNVSIT(ABMP("VDFN"),0)),U,5)
- +29 IF ABMBILLN
- SET ABMBILLN=ABMBILLN_$SELECT($PIECE($GET(^ABMDPARM(ABMDUZ2,1,2)),U,4)]"":"-"_$PIECE(^ABMDPARM(ABMDUZ2,1,2),U,4),1:"")
- +30 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)
- +31 WRITE !,ABMITYP_U_ABMCHG
- +32 ;abm*2.6*12 VMBP RQMT_104
- WRITE U_$PIECE(ABMINS,"|")_U_$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,$PIECE(ABMINS,"|",2),".211","I"),1,"I")
- +33 WRITE U_ABMBILLN
- +34 WRITE U_$$SDTO^ABMDUTL(ABMDOSB)_U_$$SDTO^ABMDUTL(ABMDOSE)_U_$FNUMBER(ABMBILLD,",",2)_U_$FNUMBER(ABMPD,",",2)
- +35 ;W U_+ABMCDAYS_U_+ABMNDAYS_U_$$CDT^ABMDUTL($P($G(^AUPNVSIT(ABMP("VDFN"),0)),U))_U_ABMVLOC ;abm*2.6*15
- +36 ;abm*2.6*15
- WRITE U_+ABMCDAYS_U_+ABMNDAYS_U_$$BDT^ABMDUTL($PIECE($GET(^AUPNVSIT(ABMP("VDFN"),0)),U))_U_ABMVLOC
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +37 SET DUZ(2)=ABMDUZ2
- +38 QUIT
