ABMMUFAC ;IHS/SD/SDR - EHR Incentive Report (MU) ;
;;2.6;IHS 3P BILLING SYSTEM;**6,7,11,12,15,20**;NOV 12, 2009;Build 317
;2.6*12-VMBP RQMT_104 - Added VAMB to report.
;2.6*12-Relabeled hdrs to include 'Adult&Ped'; added swingbed
;IHS/SD/SDR - 2.6*15 - HEAT183309
; split routine due to size
; Req#B - added code so paid will still print for 'F' report so changes made for paid will work for both reports
;IHS/SD/SDR - 2.6*20 - HEAT256154 - Added IP Ancillary Discharges category. Added bill type and visit type to detail report.
;
W !!,"This report will calculate the number of Covered Inpatient days for Medicare,"
W !,"Medicaid, and Private Insurance. Outpatient All-Inclusive Rate (AIR) bills are"
W !,"counted. A report can be selected to view the bills used in the calculations."
W !!!
K ABMY,ABMP
K ^TMP($J,"ABM-MUFAC")
K ^TMP($J,"ABM-MUVLST")
DTTYP ;
D ^XBFMK
;start new MU2 #8
S DIR("A")="Run report by FISCAL YEAR, DATE RANGE, or LOOKBACK DATE"
S DIR(0)="SO^F:FISCAL YEAR;D:DATE RANGE;L:LOOKBACK DATE"
;end new MU2 #8
S DIR("B")="FISCAL YEAR"
D ^DIR
Q:$D(DIRUT)!$D(DIROUT)!$D(DTOUT)!$D(DUOUT)
S ABMDTYP=Y
S ABMY("FACHOS")="F" ;default to F ;abm*2.6*11 MU2 #8
W !
I ABMDTYP="F" D FDT
I ABMDTYP="D" D DTR
;start new abm*2.6*11 MU2 #8
I ABMDTYP="L" D
.D LBK
Q:$D(DIRUT)!$D(DIROUT)!$D(DTOUT)!$D(DUOUT)
;start new abm*2.6*20 IHS/SD/SDR HEAT256154
D GETLOCS
I +ABMPAR=0 D H 1 G DTTYP
.W !!?8,"** There are no active facilities for the date range selected. **"
.W !?24,"** Please re-select date span. **"
;end new abm*2.6*20 IHS/SD/SDR HEAT256154
D FACHOS
;end new MU2 #8
D RTYPE
Q
FDT ;
D ^XBFMK
S DIR("A")="Select REPORT DATE Fiscal year"
S DIR(0)="LO^1960:2100:0"
S DIR("B")=$E($$Y2KD2^ABMDUTL(DT),1,4)
D ^DIR
Q:$D(DIRUT)!$D(DIROUT)!$D(DTOUT)!$D(DUOUT)
S ABMY("DT",1)=Y
W !
Q
DTR ;
D ^XBFMK
S DIR("A")="Enter STARTING Date"
S DIR(0)="DO^::EP"
D ^DIR
Q:$D(DIRUT)!$D(DIROUT)!$D(DTOUT)!$D(DUOUT)
S ABMY("DT",1)=Y
W !
S DIR("A")="Enter ENDING Date"
D ^DIR
K DIR
G DTR:$D(DIRUT)
S ABMY("DT",2)=Y
I ABMY("DT",1)>ABMY("DT",2) W !!,*7,"INPUT ERROR: Start Date is Greater than than the End Date, TRY AGAIN!",!! G DTR
Q
;start new abm*2.6*11 MU2 #8
LBK ;
D LBK^ABMMUFC1
Q
FACHOS ;EP
D FACHOS^ABMMUFC1
Q
;end new MU2 #8
RTYPE ;sum or dtl?
W !
K DIC,DIE,DIR,X,Y,DA
S DIR(0)="S^S:SUMMARY;D:DETAIL;B:BOTH"
S DIR("A")="SUMMARY, DETAIL, or BOTH"
S DIR("B")="SUMMARY"
D ^DIR K DIR
Q:$D(DIRUT)!$D(DIROUT)!$D(DTOUT)!$D(DUOUT)
S ABMSUMDT=Y
SEL ;Select device
I ABMSUMDT="B" D
.W !!,"There will be two outputs, one for SUMMARY and one for DETAIL."
.W !,"The first one should be a terminal or a printer."
.W !,"The second forces an HFS file because it could be a large file",!
I ABMSUMDT'="D" D
.S ABMQ("RX")=$S(ABMSUMDT="S":"XIT^ABMMUFAC",1:"XIT2^ABMMUFAC")
.S ABMQ("NS")="ABM"
.S ABMQ("RC")="GETTOTS^ABMMUFAC"
.S ABMQ("RP")="WRTSUM^ABMMUFAC"
.D ^ABMDRDBQ
I ABMSUMDT'="S" D
.W !!,"Will now write detail to file",!!
.D ^XBFMK
.;start old abm*2.6*20 IHS/SD/SDR HEAT256154
.;S DIR(0)="F"
.;S DIR("A")="Enter Path"
.;S DIR("B")=$P($G(^ABMDPARM(DUZ(2),1,4)),"^",7)
.;D ^DIR K DIR
.;Q:$D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
.;S ABMPATH=Y
.;S DIR(0)="F",DIR("A")="Enter File Name"
.;D ^DIR K DIR
.;Q:$D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
.;S ABMFN=Y
.;W !!,"Creating file..."
.;D OPEN^%ZISH("ABM",ABMPATH,ABMFN,"W")
.;Q:POP
.;U IO
.;D GETTOTS ;abm*2.6*7
.;D WRTDTL^ABMMUFC2
.;D CLOSE^%ZISH("ABM")
.;W "DONE" H 1
.;end old start new abm*2.6*20 IHS/SD/SDR HEAT256154
.S ABMQ("RX")=$S(ABMSUMDT="S":"XIT^ABMMUFAC",1:"XIT2^ABMMUFAC")
.S ABMQ("NS")="ABM"
.S ABMQ("RC")="GETTOTS^ABMMUFAC"
.S ABMQ("RP")="WRTDTL^ABMMUFC2"
.D ^ABMDRDBQ
.;end new abm*2.6*20 IHS/SD/SDR HEAT256154
XIT ;
K ^TMP($J,"ABM-MUFAC")
K ^TMP($J,"ABM-MUVLST")
K ABMP,ABMY,ABMPTINA,ABMPT,ABMMFLG,ABMC,ABMB
XIT2 ;
Q
QUE ;TASKMAN
S ZTRTN="WRTDTL^ABMMUFAC"
S ZTDESC="FACILITY EHR INCENTIVE REPORT"
S ZTSAVE("ABM*")=""
K ZTSK
D ^%ZTLOAD
W:$G(ZTSK) !,"Task # ",ZTSK," queued.",!
Q
GETTOTS ;
D GETLOCS
;start new abm*2.6*15 HEAT183309 keep 'F' option same as before
I ABMY("FACHOS")="F" D Q
.S ABML=0
.S ABMDUZ2=DUZ(2)
.F S ABML=$O(ABMLOC(ABML)) Q:'ABML D
..S DUZ(2)=ABML
..D GETBILLS^ABMMUFC5
;
;only gets here if 'H' option
S ABML=0
S ABMDUZ2=DUZ(2)
F S ABML=$O(ABMLOC(ABML)) Q:'ABML D
.S DUZ(2)=ABML
.D GETBILLS^ABMMUFC1
.D CLAIMS^ABMMUFC3 ;abm*2.6*15 HEAT183309 Req#B
S DUZ(2)=ABMDUZ2
D VISITS^ABMMUFC1 ;abm*2.6*15 HEAT183309 Req#B
Q
GETLOCS ;
I ABMDTYP="F" D
.S ABMP("SDT")=((+ABMY("DT",1)-1)_"1001")-17000000
.S ABMP("EDT")=((+ABMY("DT",1))_"0930")-16999999
I ABMDTYP="D"!(ABMDTYP="L") D ;abm*2.6*11 MU2 #8
.S ABMP("SDT")=ABMY("DT",1)-.5
.S ABMP("EDT")=ABMY("DT",2)+.999999
K ABMPSFLG
S ABMPAR=0
F S ABMPAR=$O(^BAR(90052.05,ABMPAR)) Q:+ABMPAR=0 D Q:($G(ABMPSFLG)=1)
.I $D(^BAR(90052.05,ABMPAR,DUZ(2))) D
..; Use A/R parent/sat is yes, but DUZ(2) is not parent for this
..; visit loc
..Q:$P($G(^BAR(90052.05,ABMPAR,DUZ(2),0)),U,3)'=ABMPAR
..Q:$P($G(^BAR(90052.05,ABMPAR,DUZ(2),0)),U,6)>ABMP("EDT")
..Q:$P($G(^BAR(90052.05,ABMPAR,DUZ(2),0)),U,7)&($P(^(0),U,7)<ABMP("SDT"))
..S ABMPSFLG=1
I +ABMPAR=0 Q ;abm*2.6*20 IHS/SD/SDR HEAT256154
S ABMLOC(ABMPAR)=""
S ABML=0
F S ABML=$O(^BAR(90052.05,ABMPAR,ABML)) Q:'ABML D
.Q:$P($G(^BAR(90052.05,ABMPAR,DUZ(2),0)),U,6)>ABMP("EDT")
.Q:$P($G(^BAR(90052.05,ABMPAR,DUZ(2),0)),U,7)&($P(^(0),U,7)<ABMP("SDT"))
.S ABMLOC(ABML)=""
Q
SETCAT ;
;swingbed
I (ABMSC="H"!(ABMSC="I")),(+$G(ABMP("SWINGBED"))=1)!(($E(ABMP("BTYP"),1,2)=18)&(ABMP("VTYP")'=999)) S ABMP("RPT-CAT")="IP SB DISCHGS" Q ;abm*2.6*12
I (ABMSC="H"!(ABMSC="I")),+$G(ABMP("NEWBORN"))=0,($E(ABMP("BTYP"),1,2)=11),(ABMP("VTYP")=111) S ABMP("RPT-CAT")="IP DISCHGS" Q ;abm*2.6*7
I (ABMSC="H"!(ABMSC="I")),+$G(ABMP("NEWBORN"))=1,($E(ABMP("BTYP"),1,2)=11),(ABMP("VTYP")=111) S ABMP("RPT-CAT")="IP NB DISCHGS" Q ;abm*2.6*7
I (ABMSC="H"!(ABMSC="I")),($E(ABMP("BTYP"),1,2)=11),(ABMP("VTYP")=999) S ABMP("RPT-CAT")="IP CHGS" Q
I (ABMSC'="H"&(ABMSC'="I")),(($E(ABMP("BTYP"),1,2)=13)!($E(ABMP("BTYP"),1,2)=85)!($E(ABMP("BTYP"),1,2)=73)),(ABMP("VTYP")=131),(ABMFFLG=1) S ABMP("RPT-CAT")="OP AIR" Q
I (ABMSC'="H"&(ABMSC'="I")),(($E(ABMP("BTYP"),1,2)=13)!($E(ABMP("BTYP"),1,2)=85)!($E(ABMP("BTYP"),1,2)=73)),(ABMP("VTYP")=131),(ABMFFLG=0) S ABMP("RPT-CAT")="OP ITEM" Q
I (ABMSC'="H"&(ABMSC'="I")),(($E(ABMP("BTYP"),1,2)=13)!($E(ABMP("BTYP"),1,2)=85)!($E(ABMP("BTYP"),1,2)=73)),(ABMP("VTYP")=999) S ABMP("RPT-CAT")="OP CHGS" Q
I ABMSC="H"!(ABMSC="I"),($E(ABMP("BTYP"),1,2)=12) S ABMP("RPT-CAT")="IP ANC DISCHGS" Q ;abm*2.6*20 IHS/SD/SDR HEAT256154
I ABMSC="H"!(ABMSC="I"),($E(ABMP("BTYP"),1,2)'=11) S ABMP("RPT-CAT")="IP CHGS" Q
I +$G(ABMFFLG)=1 S ABMP("RPT-CAT")="OP AIR" Q
S ABMP("RPT-CAT")="OP ITEM"
Q
WRTSUM ;
I ABMY("FACHOS")="H" D WRTSUMHO^ABMMUFC2 Q ;abm*2.6*12
S ABM("HD",0)="FACILITY EHR INCENTIVE REPORT" ;abm*2.6*7
S ABM("PG")=1 ;abm*2.6*7
S ABMTYP="SUM" D WHD
S CENTER=IOM/2
S ABMITYP=""
F ABMITYP="MEDICARE","MEDICAID","PRIVATE","KIDSCARE/CHIP","VMBP","OTHER" D ;abm*2.6*12 VMBP RQMT_104
.W !
.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="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 --"
.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 --" ;abm*2.6*12 VMBP RQMT_104
.I ABMITYP="OTHER" W ?CENTER-($L("-- O T H E R --")/2),"-- O T H E R --"
.W !?4,"# Paid "_ABMITYP_" IP Discharges",?59,$J(+$G(^TMP($J,"ABM-MUFAC",ABMITYP,"IP DISCHGS")),20)
.W !?4,"# Paid "_ABMITYP_" IP Newborn Discharges",?59,$J(+$G(^TMP($J,"ABM-MUFAC",ABMITYP,"IP NB DISCHGS")),20) ;abm*2.6*7
.;W !?4,"# Paid "_ABMITYP_" IP Charges",?59,$J(+$G(^TMP($J,"ABM-MUFAC",ABMITYP,"IP CHGS")),20) ;abm*2.6*11 MU2 #8
.W:$G(ABMY("FACHOS"))="F" !?4,"# Paid "_ABMITYP_" IP Charges",?59,$J(+$G(^TMP($J,"ABM-MUFAC",ABMITYP,"IP CHGS")),20) ;abm*2.6*11 MU2 #8
.W !?4,"# Paid "_ABMITYP_" IP Bed Days",?59,$J(+$G(^TMP($J,"ABM-MUFAC",ABMITYP,"IP DAYS")),20)
.W !?4,"# Paid "_ABMITYP_" IP Newborn Bed Days",?59,$J(+$G(^TMP($J,"ABM-MUFAC",ABMITYP,"IP NB DAYS")),20) ;abm*2.6*7
.W !?4,"# Paid "_ABMITYP_" IP Bed Days Charges",?59,$J(+$G(^TMP($J,"ABM-MUFAC",ABMITYP,"IP CHGS DAYS")),20)
.W !?4,"# Paid "_ABMITYP_" OP All-Inclusive",?59,$J(+$G(^TMP($J,"ABM-MUFAC",ABMITYP,"OP AIR")),20)
.W !?4,"# Paid "_ABMITYP_" OP Charges",?59,$J(+$G(^TMP($J,"ABM-MUFAC",ABMITYP,"OP CHGS")),20)
.W !?4,"# Paid "_ABMITYP_" OP Itemized",?59,$J(+$G(^TMP($J,"ABM-MUFAC",ABMITYP,"OP ITEM")),20)
.I $Y>(IOSL-5) D HD Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT) W " (cont)"
.W !
W !!,"(SUMMARY REPORT COMPLETE):"
D PAZ^ABMDRUTL Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
S DUZ(2)=ABMDUZ2
Q
HD D PAZ^ABMDRUTL Q:$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
WHD ;EP
W $$EN^ABMVDF("IOF"),!
K ABM("LINE") S $P(ABM("LINE"),"=",$S($D(ABM(132)):132,1:80))="" W ABM("LINE"),!
D NOW^%DTC
W ABM("HD",0),?$S($D(ABM(132)):103,1:48) S Y=% X ^DD("DD") W Y,$S(ABMTYP="SUM":" Page "_ABM("PG"),1:"")
S:ABMDTYP="F" ABM("HD",1)="For FISCAL YEAR: "_+(ABMY("DT",1))
S:ABMDTYP="D" ABM("HD",1)="For Date Range: "_$$SDT^ABMDUTL(ABMY("DT",1))_" to "_$$SDT^ABMDUTL(ABMY("DT",2))
S:ABMDTYP="L" ABM("HD",1)="Lookback Date Range: "_$$SDT^ABMDUTL(ABMY("DT",1))_" to "_$$SDT^ABMDUTL(ABMY("DT",2)) ;abm*2.6*11 MU2 #8
W:$G(ABM("HD",1))]"" !,ABM("HD",1)
W:$G(ABM("HD",2))]"" !,ABM("HD",2)
W !,"Billing Location: ",$P($G(^AUTTLOC(ABMPAR,0)),U,2)
W !,ABM("LINE") K ABM("LINE")
S ABM("PG")=+$G(ABM("PG"))+1
I ABMTYP="DET" D
.;W !,"INSURER CATEGORY"_U_"IP/OP CATEGORY"_U_"INSURER"_U_"INSURER TYPE" ;abm*2.6*15 HEAT183309 Req#B
.W !,"INSURER CATEGORY"_U_"RECORD TYPE"_U_"IP/OP CATEGORY"_U_"INSURER"_U_"INSURER TYPE" ;abm*2.6*15 HEAT183309 Req#B
.W U_"BILL NUMBER"_U_"ADMIT DT"_U_"DISCHG DT"_U_"AMOUNT BILLED"_U_"PAYMENT"_U_"COVD DAYS"_U_"N-COVD DAYS"
.;I ABMY("FACHOS")="H" W U_"HRN"_U_"VISIT"_U_"VISIT LOCATION" ;abm*2.6*20 IHS/SD/SDR HEAT256154
.I ABMY("FACHOS")="H" W U_"HRN"_U_"VISIT"_U_"VISIT LOCATION"_U_"BILL TYPE"_U_"VISIT TYPE"_U_"ALL INSURER TYPES"_U_"ADMISSION TYPE" ;abm*2.6*20 IHS/SD/SDR HEAT256154
.I ABMY("FACHOS")="F" W U_"VISIT"_U_"VISIT LOCATION"
I ABMTYP="SUM" D
.;W !?67,"# Discharges",! ;abm*2.6*15 HEAT183309 Req#A
.;start new abm*2.6*15 HEAT183309 Req#A
.I ABMY("FACHOS")="F" D
..W !?67,"# Discharges",!
.;end new HEAT183309 Req#A
.I ABMY("FACHOS")="H" D
..W !?52,"Billed",?63,"Paid",?73,"Total",! ;abm*2.6*15 HEAT183309 Req#B
.F ABMI=1:1:80 W "-"
Q
ABMMUFAC ;IHS/SD/SDR - EHR Incentive Report (MU) ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;**6,7,11,12,15,20**;NOV 12, 2009;Build 317
+2 ;2.6*12-VMBP RQMT_104 - Added VAMB to report.
+3 ;2.6*12-Relabeled hdrs to include 'Adult&Ped'; added swingbed
+4 ;IHS/SD/SDR - 2.6*15 - HEAT183309
+5 ; split routine due to size
+6 ; Req#B - added code so paid will still print for 'F' report so changes made for paid will work for both reports
+7 ;IHS/SD/SDR - 2.6*20 - HEAT256154 - Added IP Ancillary Discharges category. Added bill type and visit type to detail report.
+8 ;
+9 WRITE !!,"This report will calculate the number of Covered Inpatient days for Medicare,"
+10 WRITE !,"Medicaid, and Private Insurance. Outpatient All-Inclusive Rate (AIR) bills are"
+11 WRITE !,"counted. A report can be selected to view the bills used in the calculations."
+12 WRITE !!!
+13 KILL ABMY,ABMP
+14 KILL ^TMP($JOB,"ABM-MUFAC")
+15 KILL ^TMP($JOB,"ABM-MUVLST")
DTTYP ;
+1 DO ^XBFMK
+2 ;start new MU2 #8
+3 SET DIR("A")="Run report by FISCAL YEAR, DATE RANGE, or LOOKBACK DATE"
+4 SET DIR(0)="SO^F:FISCAL YEAR;D:DATE RANGE;L:LOOKBACK DATE"
+5 ;end new MU2 #8
+6 SET DIR("B")="FISCAL YEAR"
+7 DO ^DIR
+8 IF $DATA(DIRUT)!$DATA(DIROUT)!$DATA(DTOUT)!$DATA(DUOUT)
QUIT
+9 SET ABMDTYP=Y
+10 ;default to F ;abm*2.6*11 MU2 #8
SET ABMY("FACHOS")="F"
+11 WRITE !
+12 IF ABMDTYP="F"
DO FDT
+13 IF ABMDTYP="D"
DO DTR
+14 ;start new abm*2.6*11 MU2 #8
+15 IF ABMDTYP="L"
Begin DoDot:1
+16 DO LBK
End DoDot:1
+17 IF $DATA(DIRUT)!$DATA(DIROUT)!$DATA(DTOUT)!$DATA(DUOUT)
QUIT
+18 ;start new abm*2.6*20 IHS/SD/SDR HEAT256154
+19 DO GETLOCS
+20 IF +ABMPAR=0
Begin DoDot:1
+21 WRITE !!?8,"** There are no active facilities for the date range selected. **"
+22 WRITE !?24,"** Please re-select date span. **"
End DoDot:1
HANG 1
GOTO DTTYP
+23 ;end new abm*2.6*20 IHS/SD/SDR HEAT256154
+24 DO FACHOS
+25 ;end new MU2 #8
+26 DO RTYPE
+27 QUIT
FDT ;
+1 DO ^XBFMK
+2 SET DIR("A")="Select REPORT DATE Fiscal year"
+3 SET DIR(0)="LO^1960:2100:0"
+4 SET DIR("B")=$EXTRACT($$Y2KD2^ABMDUTL(DT),1,4)
+5 DO ^DIR
+6 IF $DATA(DIRUT)!$DATA(DIROUT)!$DATA(DTOUT)!$DATA(DUOUT)
QUIT
+7 SET ABMY("DT",1)=Y
+8 WRITE !
+9 QUIT
DTR ;
+1 DO ^XBFMK
+2 SET DIR("A")="Enter STARTING Date"
+3 SET DIR(0)="DO^::EP"
+4 DO ^DIR
+5 IF $DATA(DIRUT)!$DATA(DIROUT)!$DATA(DTOUT)!$DATA(DUOUT)
QUIT
+6 SET ABMY("DT",1)=Y
+7 WRITE !
+8 SET DIR("A")="Enter ENDING Date"
+9 DO ^DIR
+10 KILL DIR
+11 IF $DATA(DIRUT)
GOTO DTR
+12 SET ABMY("DT",2)=Y
+13 IF ABMY("DT",1)>ABMY("DT",2)
WRITE !!,*7,"INPUT ERROR: Start Date is Greater than than the End Date, TRY AGAIN!",!!
GOTO DTR
+14 QUIT
+15 ;start new abm*2.6*11 MU2 #8
LBK ;
+1 DO LBK^ABMMUFC1
+2 QUIT
FACHOS ;EP
+1 DO FACHOS^ABMMUFC1
+2 QUIT
+3 ;end new MU2 #8
RTYPE ;sum or dtl?
+1 WRITE !
+2 KILL DIC,DIE,DIR,X,Y,DA
+3 SET DIR(0)="S^S:SUMMARY;D:DETAIL;B:BOTH"
+4 SET DIR("A")="SUMMARY, DETAIL, or BOTH"
+5 SET DIR("B")="SUMMARY"
+6 DO ^DIR
KILL DIR
+7 IF $DATA(DIRUT)!$DATA(DIROUT)!$DATA(DTOUT)!$DATA(DUOUT)
QUIT
+8 SET ABMSUMDT=Y
SEL ;Select device
+1 IF ABMSUMDT="B"
Begin DoDot:1
+2 WRITE !!,"There will be two outputs, one for SUMMARY and one for DETAIL."
+3 WRITE !,"The first one should be a terminal or a printer."
+4 WRITE !,"The second forces an HFS file because it could be a large file",!
End DoDot:1
+5 IF ABMSUMDT'="D"
Begin DoDot:1
+6 SET ABMQ("RX")=$SELECT(ABMSUMDT="S":"XIT^ABMMUFAC",1:"XIT2^ABMMUFAC")
+7 SET ABMQ("NS")="ABM"
+8 SET ABMQ("RC")="GETTOTS^ABMMUFAC"
+9 SET ABMQ("RP")="WRTSUM^ABMMUFAC"
+10 DO ^ABMDRDBQ
End DoDot:1
+11 IF ABMSUMDT'="S"
Begin DoDot:1
+12 WRITE !!,"Will now write detail to file",!!
+13 DO ^XBFMK
+14 ;start old abm*2.6*20 IHS/SD/SDR HEAT256154
+15 ;S DIR(0)="F"
+16 ;S DIR("A")="Enter Path"
+17 ;S DIR("B")=$P($G(^ABMDPARM(DUZ(2),1,4)),"^",7)
+18 ;D ^DIR K DIR
+19 ;Q:$D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
+20 ;S ABMPATH=Y
+21 ;S DIR(0)="F",DIR("A")="Enter File Name"
+22 ;D ^DIR K DIR
+23 ;Q:$D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT)
+24 ;S ABMFN=Y
+25 ;W !!,"Creating file..."
+26 ;D OPEN^%ZISH("ABM",ABMPATH,ABMFN,"W")
+27 ;Q:POP
+28 ;U IO
+29 ;D GETTOTS ;abm*2.6*7
+30 ;D WRTDTL^ABMMUFC2
+31 ;D CLOSE^%ZISH("ABM")
+32 ;W "DONE" H 1
+33 ;end old start new abm*2.6*20 IHS/SD/SDR HEAT256154
+34 SET ABMQ("RX")=$SELECT(ABMSUMDT="S":"XIT^ABMMUFAC",1:"XIT2^ABMMUFAC")
+35 SET ABMQ("NS")="ABM"
+36 SET ABMQ("RC")="GETTOTS^ABMMUFAC"
+37 SET ABMQ("RP")="WRTDTL^ABMMUFC2"
+38 DO ^ABMDRDBQ
+39 ;end new abm*2.6*20 IHS/SD/SDR HEAT256154
End DoDot:1
XIT ;
+1 KILL ^TMP($JOB,"ABM-MUFAC")
+2 KILL ^TMP($JOB,"ABM-MUVLST")
+3 KILL ABMP,ABMY,ABMPTINA,ABMPT,ABMMFLG,ABMC,ABMB
XIT2 ;
+1 QUIT
QUE ;TASKMAN
+1 SET ZTRTN="WRTDTL^ABMMUFAC"
+2 SET ZTDESC="FACILITY EHR INCENTIVE REPORT"
+3 SET ZTSAVE("ABM*")=""
+4 KILL ZTSK
+5 DO ^%ZTLOAD
+6 IF $GET(ZTSK)
WRITE !,"Task # ",ZTSK," queued.",!
+7 QUIT
GETTOTS ;
+1 DO GETLOCS
+2 ;start new abm*2.6*15 HEAT183309 keep 'F' option same as before
+3 IF ABMY("FACHOS")="F"
Begin DoDot:1
+4 SET ABML=0
+5 SET ABMDUZ2=DUZ(2)
+6 FOR
SET ABML=$ORDER(ABMLOC(ABML))
IF 'ABML
QUIT
Begin DoDot:2
+7 SET DUZ(2)=ABML
+8 DO GETBILLS^ABMMUFC5
End DoDot:2
End DoDot:1
QUIT
+9 ;
+10 ;only gets here if 'H' option
+11 SET ABML=0
+12 SET ABMDUZ2=DUZ(2)
+13 FOR
SET ABML=$ORDER(ABMLOC(ABML))
IF 'ABML
QUIT
Begin DoDot:1
+14 SET DUZ(2)=ABML
+15 DO GETBILLS^ABMMUFC1
+16 ;abm*2.6*15 HEAT183309 Req#B
DO CLAIMS^ABMMUFC3
End DoDot:1
+17 SET DUZ(2)=ABMDUZ2
+18 ;abm*2.6*15 HEAT183309 Req#B
DO VISITS^ABMMUFC1
+19 QUIT
GETLOCS ;
+1 IF ABMDTYP="F"
Begin DoDot:1
+2 SET ABMP("SDT")=((+ABMY("DT",1)-1)_"1001")-17000000
+3 SET ABMP("EDT")=((+ABMY("DT",1))_"0930")-16999999
End DoDot:1
+4 ;abm*2.6*11 MU2 #8
IF ABMDTYP="D"!(ABMDTYP="L")
Begin DoDot:1
+5 SET ABMP("SDT")=ABMY("DT",1)-.5
+6 SET ABMP("EDT")=ABMY("DT",2)+.999999
End DoDot:1
+7 KILL ABMPSFLG
+8 SET ABMPAR=0
+9 FOR
SET ABMPAR=$ORDER(^BAR(90052.05,ABMPAR))
IF +ABMPAR=0
QUIT
Begin DoDot:1
+10 IF $DATA(^BAR(90052.05,ABMPAR,DUZ(2)))
Begin DoDot:2
+11 ; Use A/R parent/sat is yes, but DUZ(2) is not parent for this
+12 ; visit loc
+13 IF $PIECE($GET(^BAR(90052.05,ABMPAR,DUZ(2),0)),U,3)'=ABMPAR
QUIT
+14 IF $PIECE($GET(^BAR(90052.05,ABMPAR,DUZ(2),0)),U,6)>ABMP("EDT")
QUIT
+15 IF $PIECE($GET(^BAR(90052.05,ABMPAR,DUZ(2),0)),U,7)&($PIECE(^(0),U,7)<ABMP("SDT"))
QUIT
+16 SET ABMPSFLG=1
End DoDot:2
End DoDot:1
IF ($GET(ABMPSFLG)=1)
QUIT
+17 ;abm*2.6*20 IHS/SD/SDR HEAT256154
IF +ABMPAR=0
QUIT
+18 SET ABMLOC(ABMPAR)=""
+19 SET ABML=0
+20 FOR
SET ABML=$ORDER(^BAR(90052.05,ABMPAR,ABML))
IF 'ABML
QUIT
Begin DoDot:1
+21 IF $PIECE($GET(^BAR(90052.05,ABMPAR,DUZ(2),0)),U,6)>ABMP("EDT")
QUIT
+22 IF $PIECE($GET(^BAR(90052.05,ABMPAR,DUZ(2),0)),U,7)&($PIECE(^(0),U,7)<ABMP("SDT"))
QUIT
+23 SET ABMLOC(ABML)=""
End DoDot:1
+24 QUIT
SETCAT ;
+1 ;swingbed
+2 ;abm*2.6*12
IF (ABMSC="H"!(ABMSC="I"))
IF (+$GET(ABMP("SWINGBED"))=1)!(($EXTRACT(ABMP("BTYP"),1,2)=18)&(ABMP("VTYP")'=999))
SET ABMP("RPT-CAT")="IP SB DISCHGS"
QUIT
+3 ;abm*2.6*7
IF (ABMSC="H"!(ABMSC="I"))
IF +$GET(ABMP("NEWBORN"))=0
IF ($EXTRACT(ABMP("BTYP"),1,2)=11)
IF (ABMP("VTYP")=111)
SET ABMP("RPT-CAT")="IP DISCHGS"
QUIT
+4 ;abm*2.6*7
IF (ABMSC="H"!(ABMSC="I"))
IF +$GET(ABMP("NEWBORN"))=1
IF ($EXTRACT(ABMP("BTYP"),1,2)=11)
IF (ABMP("VTYP")=111)
SET ABMP("RPT-CAT")="IP NB DISCHGS"
QUIT
+5 IF (ABMSC="H"!(ABMSC="I"))
IF ($EXTRACT(ABMP("BTYP"),1,2)=11)
IF (ABMP("VTYP")=999)
SET ABMP("RPT-CAT")="IP CHGS"
QUIT
+6 IF (ABMSC'="H"&(ABMSC'="I"))
IF (($EXTRACT(ABMP("BTYP"),1,2)=13)!($EXTRACT(ABMP("BTYP"),1,2)=85)!($EXTRACT(ABMP("BTYP"),1,2)=73))
IF (ABMP("VTYP")=131)
IF (ABMFFLG=1)
SET ABMP("RPT-CAT")="OP AIR"
QUIT
+7 IF (ABMSC'="H"&(ABMSC'="I"))
IF (($EXTRACT(ABMP("BTYP"),1,2)=13)!($EXTRACT(ABMP("BTYP"),1,2)=85)!($EXTRACT(ABMP("BTYP"),1,2)=73))
IF (ABMP("VTYP")=131)
IF (ABMFFLG=0)
SET ABMP("RPT-CAT")="OP ITEM"
QUIT
+8 IF (ABMSC'="H"&(ABMSC'="I"))
IF (($EXTRACT(ABMP("BTYP"),1,2)=13)!($EXTRACT(ABMP("BTYP"),1,2)=85)!($EXTRACT(ABMP("BTYP"),1,2)=73))
IF (ABMP("VTYP")=999)
SET ABMP("RPT-CAT")="OP CHGS"
QUIT
+9 ;abm*2.6*20 IHS/SD/SDR HEAT256154
IF ABMSC="H"!(ABMSC="I")
IF ($EXTRACT(ABMP("BTYP"),1,2)=12)
SET ABMP("RPT-CAT")="IP ANC DISCHGS"
QUIT
+10 IF ABMSC="H"!(ABMSC="I")
IF ($EXTRACT(ABMP("BTYP"),1,2)'=11)
SET ABMP("RPT-CAT")="IP CHGS"
QUIT
+11 IF +$GET(ABMFFLG)=1
SET ABMP("RPT-CAT")="OP AIR"
QUIT
+12 SET ABMP("RPT-CAT")="OP ITEM"
+13 QUIT
WRTSUM ;
+1 ;abm*2.6*12
IF ABMY("FACHOS")="H"
DO WRTSUMHO^ABMMUFC2
QUIT
+2 ;abm*2.6*7
SET ABM("HD",0)="FACILITY EHR INCENTIVE REPORT"
+3 ;abm*2.6*7
SET ABM("PG")=1
+4 SET ABMTYP="SUM"
DO WHD
+5 SET CENTER=IOM/2
+6 SET ABMITYP=""
+7 ;abm*2.6*12 VMBP RQMT_104
FOR ABMITYP="MEDICARE","MEDICAID","PRIVATE","KIDSCARE/CHIP","VMBP","OTHER"
Begin DoDot:1
+8 WRITE !
+9 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 --"
+10 IF ABMITYP="MEDICARE"
WRITE ?CENTER-($LENGTH("-- M E D I C A R E --")/2),"-- M E D I C A R E --"
+11 IF ABMITYP="MEDICAID"
WRITE ?CENTER-($LENGTH("-- M E D I C A I D --")/2),"-- M E D I C A I D --"
+12 IF ABMITYP="KIDSCARE/CHIP"
WRITE ?CENTER-($LENGTH("-- 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 --"
+13 ;abm*2.6*12 VMBP RQMT_104
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 --"
+14 IF ABMITYP="OTHER"
WRITE ?CENTER-($LENGTH("-- O T H E R --")/2),"-- O T H E R --"
+15 WRITE !?4,"# Paid "_ABMITYP_" IP Discharges",?59,$JUSTIFY(+$GET(^TMP($JOB,"ABM-MUFAC",ABMITYP,"IP DISCHGS")),20)
+16 ;abm*2.6*7
WRITE !?4,"# Paid "_ABMITYP_" IP Newborn Discharges",?59,$JUSTIFY(+$GET(^TMP($JOB,"ABM-MUFAC",ABMITYP,"IP NB DISCHGS")),20)
+17 ;W !?4,"# Paid "_ABMITYP_" IP Charges",?59,$J(+$G(^TMP($J,"ABM-MUFAC",ABMITYP,"IP CHGS")),20) ;abm*2.6*11 MU2 #8
+18 ;abm*2.6*11 MU2 #8
IF $GET(ABMY("FACHOS"))="F"
WRITE !?4,"# Paid "_ABMITYP_" IP Charges",?59,$JUSTIFY(+$GET(^TMP($JOB,"ABM-MUFAC",ABMITYP,"IP CHGS")),20)
+19 WRITE !?4,"# Paid "_ABMITYP_" IP Bed Days",?59,$JUSTIFY(+$GET(^TMP($JOB,"ABM-MUFAC",ABMITYP,"IP DAYS")),20)
+20 ;abm*2.6*7
WRITE !?4,"# Paid "_ABMITYP_" IP Newborn Bed Days",?59,$JUSTIFY(+$GET(^TMP($JOB,"ABM-MUFAC",ABMITYP,"IP NB DAYS")),20)
+21 WRITE !?4,"# Paid "_ABMITYP_" IP Bed Days Charges",?59,$JUSTIFY(+$GET(^TMP($JOB,"ABM-MUFAC",ABMITYP,"IP CHGS DAYS")),20)
+22 WRITE !?4,"# Paid "_ABMITYP_" OP All-Inclusive",?59,$JUSTIFY(+$GET(^TMP($JOB,"ABM-MUFAC",ABMITYP,"OP AIR")),20)
+23 WRITE !?4,"# Paid "_ABMITYP_" OP Charges",?59,$JUSTIFY(+$GET(^TMP($JOB,"ABM-MUFAC",ABMITYP,"OP CHGS")),20)
+24 WRITE !?4,"# Paid "_ABMITYP_" OP Itemized",?59,$JUSTIFY(+$GET(^TMP($JOB,"ABM-MUFAC",ABMITYP,"OP ITEM")),20)
+25 IF $Y>(IOSL-5)
DO HD
IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT
WRITE " (cont)"
+26 WRITE !
End DoDot:1
+27 WRITE !!,"(SUMMARY REPORT COMPLETE):"
+28 DO PAZ^ABMDRUTL
IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT
+29 SET DUZ(2)=ABMDUZ2
+30 QUIT
HD DO PAZ^ABMDRUTL
IF $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
QUIT
WHD ;EP
+1 WRITE $$EN^ABMVDF("IOF"),!
+2 KILL ABM("LINE")
SET $PIECE(ABM("LINE"),"=",$SELECT($DATA(ABM(132)):132,1:80))=""
WRITE ABM("LINE"),!
+3 DO NOW^%DTC
+4 WRITE ABM("HD",0),?$SELECT($DATA(ABM(132)):103,1:48)
SET Y=%
XECUTE ^DD("DD")
WRITE Y,$SELECT(ABMTYP="SUM":" Page "_ABM("PG"),1:"")
+5 IF ABMDTYP="F"
SET ABM("HD",1)="For FISCAL YEAR: "_+(ABMY("DT",1))
+6 IF ABMDTYP="D"
SET ABM("HD",1)="For Date Range: "_$$SDT^ABMDUTL(ABMY("DT",1))_" to "_$$SDT^ABMDUTL(ABMY("DT",2))
+7 ;abm*2.6*11 MU2 #8
IF ABMDTYP="L"
SET ABM("HD",1)="Lookback Date Range: "_$$SDT^ABMDUTL(ABMY("DT",1))_" to "_$$SDT^ABMDUTL(ABMY("DT",2))
+8 IF $GET(ABM("HD",1))]""
WRITE !,ABM("HD",1)
+9 IF $GET(ABM("HD",2))]""
WRITE !,ABM("HD",2)
+10 WRITE !,"Billing Location: ",$PIECE($GET(^AUTTLOC(ABMPAR,0)),U,2)
+11 WRITE !,ABM("LINE")
KILL ABM("LINE")
+12 SET ABM("PG")=+$GET(ABM("PG"))+1
+13 IF ABMTYP="DET"
Begin DoDot:1
+14 ;W !,"INSURER CATEGORY"_U_"IP/OP CATEGORY"_U_"INSURER"_U_"INSURER TYPE" ;abm*2.6*15 HEAT183309 Req#B
+15 ;abm*2.6*15 HEAT183309 Req#B
WRITE !,"INSURER CATEGORY"_U_"RECORD TYPE"_U_"IP/OP CATEGORY"_U_"INSURER"_U_"INSURER TYPE"
+16 WRITE U_"BILL NUMBER"_U_"ADMIT DT"_U_"DISCHG DT"_U_"AMOUNT BILLED"_U_"PAYMENT"_U_"COVD DAYS"_U_"N-COVD DAYS"
+17 ;I ABMY("FACHOS")="H" W U_"HRN"_U_"VISIT"_U_"VISIT LOCATION" ;abm*2.6*20 IHS/SD/SDR HEAT256154
+18 ;abm*2.6*20 IHS/SD/SDR HEAT256154
IF ABMY("FACHOS")="H"
WRITE U_"HRN"_U_"VISIT"_U_"VISIT LOCATION"_U_"BILL TYPE"_U_"VISIT TYPE"_U_"ALL INSURER TYPES"_U_"ADMISSION TYPE"
+19 IF ABMY("FACHOS")="F"
WRITE U_"VISIT"_U_"VISIT LOCATION"
End DoDot:1
+20 IF ABMTYP="SUM"
Begin DoDot:1
+21 ;W !?67,"# Discharges",! ;abm*2.6*15 HEAT183309 Req#A
+22 ;start new abm*2.6*15 HEAT183309 Req#A
+23 IF ABMY("FACHOS")="F"
Begin DoDot:2
+24 WRITE !?67,"# Discharges",!
End DoDot:2
+25 ;end new HEAT183309 Req#A
+26 IF ABMY("FACHOS")="H"
Begin DoDot:2
+27 ;abm*2.6*15 HEAT183309 Req#B
WRITE !?52,"Billed",?63,"Paid",?73,"Total",!
End DoDot:2
+28 FOR ABMI=1:1:80
WRITE "-"
End DoDot:1
+29 QUIT
