ABMMUFC1 ;IHS/SD/SDR - EHR Incentive Report (MU) ;
;;2.6;IHS 3P BILLING SYSTEM;**6,7,12,15,20**;NOV 12, 2009;Build 317
;IHS/SD/SDR - 2.6*12 - VMBP RQMT_104 - Added VA data to report
;IHS/SD/SDR - 2.6*12 - Added swingbed
;IHS/SD/SDR - 2.6*15 - HEAT183309 - Req#B - Added Billed and Total columns
; Req#E - Added new section Private primary/mcd secondary
; Req#G - Split Kidscare into Kidscare Title XIX and XXI
;IHS/SD/SDR - 2.6.15 - HEAT208561 - Made change to fix error <SUBSCR>VISITS+30^ABMMUFC1.
; Occurs when patient has a visit but no eligibility at all on Reg.
;IHS/SD/SDR - 2.6*20 - HEAT256154 - Made changes for Newborn stays for 3+ days to count as Adult&Ped charges and bed days.
; Also added 2 new categories, Visits w/no Eligibility and Medicare/Medicaid dual eligibles. Corrected PI/Mcd entries so
; they weren't duplicates any more. Correction to lookup of visit data where parent visit link isn't the same as the visit
; we are using. For option 'H' only look at bills with bill type 121 or visit type 111 or 3P Visit Type UB-92 BILL TYPE 111.
; Added bill type, visit type to detail output to assist with validation.
;
LBK ;
D ^XBFMK
S DIR("A")="Enter ENDING Date"
S DIR(0)="DO^:"_(DT-1)_":EPX"
D ^DIR
K DIR
Q:$D(DIRUT)!$D(DIROUT)!$D(DTOUT)!$D(DUOUT)
S ABMY("DT",2)=Y
S X1=ABMY("DT",2)
S X2=-365
D C^%DTC
S ABMY("DT",1)=X
Q
FACHOS ;EP
D ^XBFMK
S DIR("A")="Select the type of report to run"
S DIR(0)="S^F:FACILITY EHR INCENTIVE REPORT (COST REPORT);H:HOSPITAL CALCULATION MU INCENTIVE REPORT"
D ^DIR
K DIR
S ABMY("FACHOS")=Y
Q
;start new abm*2.6*15 HEAT183309 Req#B
VISITS ;EP
D VISITS^ABMMUFC6 ;abm*2.6*20 IHS/SD/SDR HEAT256154 - split routine due to size.
Q
;end new HEAT183309 Req#B
GETBILLS ;EP
S ABMPSDT=ABMP("SDT")-10000
F S ABMPSDT=$O(^ABMDBILL(DUZ(2),"AD",ABMPSDT)) Q:'ABMPSDT D ;loop thru service date from x-ref
.S ABMPFLG=0 ;abm*2.6*15 HEAT183309 Req#B
.S ABMP("BDFN")=0
.F S ABMP("BDFN")=$O(^ABMDBILL(DUZ(2),"AD",ABMPSDT,ABMP("BDFN"))) Q:'ABMP("BDFN") D
..S ABMVDFN=0
..F S ABMVDFN=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),11,ABMVDFN)) Q:'ABMVDFN D Q:ABMPFLG=1
...I $D(^TMP($J,"ABM-MUVLST",ABMVDFN)) Q ;visit has already been counted on a different bill abm*2.6*15
...I $P($G(^AUPNVSIT(ABMVDFN,0)),U,11)=1 Q ;deleted visit
...S ABMP("PVDFN")=$S($P($G(^AUPNVSIT(ABMVDFN,0)),U,12):$P(^AUPNVSIT(ABMVDFN,0),U,12),1:ABMVDFN) ;abm*2.6*20 IHS/SD/SDR HEAT256154
...;S ABMSC=$P($G(^AUPNVSIT(ABMVDFN,0)),U,7) ;service category ;abm*2.6*20 IHS/SD/SDR HEAT256154
...S ABMSC=$P($G(^AUPNVSIT(ABMP("PVDFN"),0)),U,7) ;service category ;abm*2.6*20 IHS/SD/SDR HEAT256154
...I "HIASRO"'[ABMSC Q ;ignore all other service categories
...;H=Hosp
...;I=In Hosp
...;A=Amb
...;S=Day Surg
...;R=Nurs Home
...;O=Observ
...;parent visit link; default to visit if there isn't one
...;S ABMP("PVDFN")=$S($P($G(^AUPNVSIT(ABMVDFN,0)),U,12):$P(^AUPNVSIT(ABMVDFN,0),U,12),1:ABMVDFN) ;abm*2.6*20 IHS/SD/SDR HEAT256154
...;if not Hospitalization, use Visit/Admit Date&Time
...I ABMSC'="H",($P($G(^AUPNVSIT(ABMP("PVDFN"),0)),U)<ABMP("SDT")) Q ;seen before start date
...I ABMSC'="H",($P($G(^AUPNVSIT(ABMP("PVDFN"),0)),U)>ABMP("EDT")) Q ;seen after end date
...;if Hospitalization, get Date of Discharge from V Hospitalization file
...S ABMQFLG=1
...I ABMSC="H" D Q:ABMQFLG=0
....;S ABMP("VHIEN")=$O(^AUPNVINP("AD",ABMP("PVDFN"),0)) ;abm*2.6*7
....S ABMP("VHIEN")=+$O(^AUPNVINP("AD",ABMP("PVDFN"),0)) ;abm*2.6*7
....I ABMP("VHIEN")=0 S ABMQFLG=0 Q
....S ABMP("DISCHDT")=$P($G(^AUPNVINP(ABMP("VHIEN"),0)),U)
....I ABMP("DISCHDT")<ABMP("SDT") S ABMQFLG=0 Q ;seen before start date
....I ABMP("DISCHDT")>ABMP("EDT") S ABMQFLG=0 Q ;seen after end date
....;start new abm*2.6*12 swingbed
....S ABMP("SWINGBED")=0
....I $$GET1^DIQ(45.7,$$GET1^DIQ(9000010.02,ABMP("VHIEN"),".04","I"),"9999999.01","E")=21 S ABMP("SWINGBED")=1
....I $$GET1^DIQ(45.7,$$GET1^DIQ(9000010.02,ABMP("VHIEN"),".05","I"),"9999999.01","E")=21 S ABMP("SWINGBED")=1
....;end new swingbed
...S ABMPBDFN=0
...S ABMPFLG=0 ;pymt flg
...K ABMB
...F ABMC=1:1 S ABMPBDFN=$O(^ABMDBILL(DUZ(2),"AV",ABMP("PVDFN"),ABMPBDFN)) Q:'ABMPBDFN D Q:ABMPFLG=1
....S ABMP("BTYP")=$P($G(^ABMDBILL(DUZ(2),ABMPBDFN,0)),U,2) ;bill type
....S ABMP("VTYP")=$P($G(^ABMDBILL(DUZ(2),ABMPBDFN,0)),U,7) ;visit type
....I ABMY("FACHOS")="H"&'((ABMP("BTYP")=121)!(ABMP("VTYP")=111)!(+$P($G(^ABMDVTYP(ABMP("VTYP"),0)),U,2)=111)) Q ;only inpt or ancillary visit types ;abm*2.6*20 IHS/SD/SDR HEAT256154
....I $P($G(^ABMDBILL(DUZ(2),ABMPBDFN,0)),U,4)="X" Q ;skip cancelled bills
....S ABMB(ABMP("VTYP"),ABMP("BTYP"),ABMC)=ABMPBDFN
...I '$D(ABMB) Q ;no active bills found ;abm*2.6*15 HEAT183309
...S ABMP("VTYP")=0
...F S ABMP("VTYP")=$O(ABMB(ABMP("VTYP"))) Q:'ABMP("VTYP") D Q:ABMPFLG=1
....S ABMP("BTYP")=0
....F S ABMP("BTYP")=$O(ABMB(ABMP("VTYP"),ABMP("BTYP"))) Q:'ABMP("BTYP") D Q:ABMPFLG=1
.....S ABMC=0
.....F S ABMC=$O(ABMB(ABMP("VTYP"),ABMP("BTYP"),ABMC)) Q:'ABMC D Q:ABMPFLG=1
......S ABMPBDFN=$G(ABMB(ABMP("VTYP"),ABMP("BTYP"),ABMC))
......S ABM=ABMPBDFN
......S ABMP("PDFN")=$P($G(^ABMDBILL(DUZ(2),ABMPBDFN,0)),U,5)
......Q:$$GET1^DIQ(2,ABMP("PDFN"),".01","E")["DEMO,PATIENT" ;exclude any DEMO,PATIENT
......S ABMP("INS")=$P($G(^ABMDBILL(DUZ(2),ABMPBDFN,0)),U,8)
......I $$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMP("INS"),".211","I"),1,"I")="K" D GETBINS^ABMMUFC3 ;abm*2.6*15 HEAT183309 Req#G
......S ABMP("LDFN")=$P($G(^ABMDBILL(DUZ(2),ABMPBDFN,0)),U,3)
......S ABMP("VDT")=$P($G(^ABMDBILL(DUZ(2),ABMPBDFN,7)),U)
......S ABMP("NEWBORN")=0 ;abm*2.6*7
......I $$GET1^DIQ(9002274.03,$P($G(^ABMDBILL(DUZ(2),ABMPBDFN,5)),U),.03,"E")="NEWBORN" S ABMP("NEWBORN")=1 ;abm*2.6*7
......S ABMATYP=$$GET1^DIQ(9002274.03,$P($G(^ABMDBILL(DUZ(2),ABMPBDFN,5)),U),.03,"E") ;abm*2.6*20 IHS/SD/SDR HEAT256154
......S ABMP("PD")=0 ;abm*2.6*15 HEAT183309 Req#B
......D PREV^ABMMUFC3
......I +$G(ABMP("PD"))=0&('ABMPYD) Q ;skip if no payment made on bill
......S ABMPFLG=1
...I ABMPFLG=0 D ;if ABMPFLG=0 there wasn't a pymt on any bill; use the first one billed
....S ABMP("VTYP")=$O(ABMB(0))
....S ABMP("BTYP")=$O(ABMB(ABMP("VTYP"),0))
....S ABMC=$O(ABMB(ABMP("VTYP"),ABMP("BTYP"),0))
....S ABMPBDFN=$G(ABMB(ABMP("VTYP"),ABMP("BTYP"),ABMC))
...;start old abm*2.6*15 HEAT183309 Req#B
...;;if it gets here and ABMPFLG is 0, no pymt was found for any bill for this visit
...;Q:+$G(ABMPFLG)=0
...;end old HEAT183309 Req#B
...;at this point it will be either 1)the first bill with payment; or 2)the first bill sorted so inpatient is on top
...S ABMIT=$P($G(^ABMDBILL(DUZ(2),ABMPBDFN,2)),U,2)
...D INSTYP
...S ABMP("INS")=$P($G(^ABMDBILL(DUZ(2),ABMPBDFN,0)),U,8)
...S ABMP("FSDT")=0,ABMFFLG=0
...F S ABMP("FSDT")=$O(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),11,ABMP("FSDT"))) Q:'ABMP("FSDT") D Q:ABMFFLG=1
....I $P($G(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),11,ABMP("FSDT"),0)),U)>ABMP("EDT") Q
....I $P($G(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),11,ABMP("FSDT"),0)),U,2)>ABMP("SDT") Q
....S ABMFFLG=1
...;start new abm*2.6*20 IHS/SD/SDR HEAT256154
...S ABMCDAYS=+$P($G(^ABMDBILL(DUZ(2),ABMPBDFN,7)),U,3)
...S:'ABMCDAYS ABMCDAYS=$P($G(^ABMDBILL(DUZ(2),ABMPBDFN,6)),U,9)
...S:'ABMCDAYS ABMCDAYS=1
...;commented out below line in abm*2.6*20 IHS/SD/SDR; Harrell Little said it didn't apply, that newborn is always newborn
...;I ABMCDAYS>2 S ABMP("NEWBORN")=0 ;if stay is more than 2 days it isn't counted as newborn; it should be counted as adult&ped
...;end new abm*2.6*20 IHS/SD/SDR HEAT256154
...D SETCAT^ABMMUFAC
...;Q:$D(^TMP($J,"ABM-MUVLST",ABMP("PVDFN"))) ;quit if this visit has already counted
...;S ^TMP($J,"ABM-MUVLST",ABMP("PVDFN"))="" ;add visit to list
...;start new abm*2.6*15 HEAT183309 Req#B
...S ABMDOSB=$P($G(^ABMDBILL(DUZ(2),ABMPBDFN,7)),U)
...S ABMDOSE=$P($G(^ABMDBILL(DUZ(2),ABMPBDFN,7)),U,2)
...S ABMBILLD=+$P($G(^ABMDBILL(DUZ(2),ABMPBDFN,2)),U)
...S ABMVLOC=$$GET1^DIQ(9002274.4,ABMPBDFN,".03","E")
...S ABMNDAYS=+$P($G(^ABMDBILL(DUZ(2),ABMPBDFN,6)),U,6)
...;start old abm*2.6*20 IHS/SD/SDR HEAT256154
...;S ABMCDAYS=+$P($G(^ABMDBILL(DUZ(2),ABMPBDFN,7)),U,3)
...;S:'ABMCDAYS ABMCDAYS=$P($G(^ABMDBILL(DUZ(2),ABMPBDFN,6)),U,9)
...;S:'ABMCDAYS ABMCDAYS=1
...;end old abm*2.6*20 IHS/SD/SDR HEAT256154
...S ABMRT=$S(+$G(ABMP("PD"))'=0&(ABMPYD):"PD",1:"BLD")
...;start old abm*2.6*20 IHS/SD/SDR HEAT256154
...;I "^S^B^"[("^"_ABMSUMDT_"^") D SUMMREC
...;I "^D^B^"[("^"_ABMSUMDT_"^") D DETREC
...;I ABMIT="P" D ;if Private look for a Medicaid on the same bill abm*2.6*15 HEAT183309 Req#E
...;.S ABMI=0,ABMDF=0
...;.F S ABMI=$O(^ABMDBILL(DUZ(2),ABMPBDFN,13,ABMI)) Q:'ABMI D
...;..I $P($G(^ABMDBILL(DUZ(2),ABMPBDFN,13,ABMI,0)),U,6)'="" S ABMDF=1
...;.I ABMDF=1 S ABMITYP="PRI/MCD" D
...;..I "^S^B^"[("^"_ABMSUMDT_"^") D SUMMREC
...;..I "^D^B^"[("^"_ABMSUMDT_"^") D DETREC
...;end old start new abm*2.6*20 IHS/SD/SDR HEAT256154
...;this looks at other insurers on the bill and tries to determine if they are a PI/MCD or MCR/MCD bill;
...;puts these into separate categories.
...S ABMI=0,ABMDF=0,ABMITYPA=""
...F S ABMI=$O(^ABMDBILL(DUZ(2),ABMPBDFN,13,ABMI)) Q:'ABMI D
....S ABMJ=$P($G(^ABMDBILL(DUZ(2),ABMPBDFN,13,ABMI,0)),U)
....I ABMITYPA'="" S ABMITYPA=ABMITYPA_"~"_$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,+ABMJ,".211","I"),1,"I")
....I ABMITYPA="" S ABMITYPA=$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,+ABMJ,".211","I"),1,"I")
....I $P($G(^ABMDBILL(DUZ(2),ABMPBDFN,13,ABMI,0)),U,6)'="",ABMIT="P" S ABMDF=1
....I $P($G(^ABMDBILL(DUZ(2),ABMPBDFN,13,ABMI,0)),U,6)'="",ABMIT="R" S ABMDF=2
...I ABMDF=1 S ABMITYP="PRI/MCD"
...I ABMDF=2 S ABMITYP="MCR/MCD"
...;
...I "^S^B^"[("^"_ABMSUMDT_"^") D SUMMREC
...I "^D^B^"[("^"_ABMSUMDT_"^") D DETREC
...;end new abm*2.6*20 IHS/SD/SDR HEAT256154
Q
;start new abm*2.6*15 HEAT183309 Req#B
SUMMREC ;EP
D SUMMREC^ABMMUFC6 ;abm*2.6*20 IHS/SD/SDR HEAT256154 - split routine due to size
Q
DETREC ;EP
D DETREC^ABMMUFC6 ;abm*2.6*20 IHS/SD/SDR HEAT256154 - split routine due to size
Q
;end new HEAT183309 Req#B
INSTYP ;EP
I "^R^MH^MD^"[("^"_ABMIT_"^") S ABMITYP="MEDICARE"
I "^P^H^D^F^"[("^"_ABMIT_"^") S ABMITYP="PRIVATE"
I ABMIT="D" S ABMITYP="MEDICAID"
;I ABMIT="K" S ABMITYP="KIDSCARE/CHIP" ;abm*2.6*15 HEAT183309 Req#G
I ABMIT="K"&($G(ABMIT2)="D") S ABMITYP="KIDSCARE XIX" ;abm*2.6*15 HEAT183309 Req#G
I ABMIT="K"&($G(ABMIT2)="P") S ABMITYP="KIDSCARE XXI" ;abm*2.6*15 HEAT183309 Req#G
I ABMIT="V" S ABMITYP="VMBP" ;abm*2.6*12 VMBP RQMT_104
;I "^W^C^N^I^T^G^"[("^"_ABMIT_"^") S ABMITYP="OTHER" ;abm*2.6*15 HEAT183309
I "^W^C^N^I^T^G^FPL^MMC^MC^SEP^TSI^"[("^"_ABMIT_"^") S ABMITYP="OTHER" ;abm*2.6*15 HEAT183309
Q
BTYP ;EP - partial copy of code from BTYP^ABMDEVAR
S ABMP("BTYP")=""
I $P($G(^ABMNINS(DUZ(2),+ABMP("INS"),1,ABMP("VTYP"),0)),U,11) D
.S ABMP("BTYP")=$P(^ABMNINS(DUZ(2),+ABMP("INS"),1,ABMP("VTYP"),0),U,11)
.S ABMP("BTYP")=$P($G(^ABMDCODE(ABMP("BTYP"),0)),U)
S:ABMP("BTYP")<110!(ABMP("BTYP")>999) ABMP("BTYP")=""
S:ABMP("BTYP")="" ABMP("BTYP")=$S(ABMP("VTYP")=111:111,ABMP("VTYP")=121:121,ABMP("VTYP")=831:831,1:131)
I ABMP("VTYP")=111,$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMP("INS"),".211","I"),1,"I")="R" S ABMP("BTYP")=121 D
.N I
.S I=0
.F S I=$O(^AUPNMCR(ABMP("PDFN"),11,I)) Q:'I D
..Q:$P(^AUPNMCR(ABMP("PDFN"),11,I,0),U)>ABMP("VDT")
..I $P(^AUPNMCR(ABMP("PDFN"),11,I,0),U,2)<ABMP("VDT"),$P(^(0),U,2)'="" Q
..Q:$P(^AUPNMCR(ABMP("PDFN"),11,I,0),U,3)'="A"
..S ABMP("BTYP")=111
.I ABMP("BTYP")=121 D
..N I
..S I=0
..F S I=$O(^AUPNRRE(ABMP("PDFN"),11,I)) Q:'I D
...Q:$P(^AUPNRRE(ABMP("PDFN"),11,I,0),U)>ABMP("VDT")
...I $P(^AUPNRRE(ABMP("PDFN"),11,I,0),U,2)<ABMP("VDT"),$P(^(0),U,2)'="" Q
...Q:$P(^AUPNRRE(ABMP("PDFN"),11,I,0),U,3)'="A"
...S ABMP("BTYP")=111
Q
ABMMUFC1 ;IHS/SD/SDR - EHR Incentive Report (MU) ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;**6,7,12,15,20**;NOV 12, 2009;Build 317
+2 ;IHS/SD/SDR - 2.6*12 - VMBP RQMT_104 - Added VA data to report
+3 ;IHS/SD/SDR - 2.6*12 - Added swingbed
+4 ;IHS/SD/SDR - 2.6*15 - HEAT183309 - Req#B - Added Billed and Total columns
+5 ; Req#E - Added new section Private primary/mcd secondary
+6 ; Req#G - Split Kidscare into Kidscare Title XIX and XXI
+7 ;IHS/SD/SDR - 2.6.15 - HEAT208561 - Made change to fix error <SUBSCR>VISITS+30^ABMMUFC1.
+8 ; Occurs when patient has a visit but no eligibility at all on Reg.
+9 ;IHS/SD/SDR - 2.6*20 - HEAT256154 - Made changes for Newborn stays for 3+ days to count as Adult&Ped charges and bed days.
+10 ; Also added 2 new categories, Visits w/no Eligibility and Medicare/Medicaid dual eligibles. Corrected PI/Mcd entries so
+11 ; they weren't duplicates any more. Correction to lookup of visit data where parent visit link isn't the same as the visit
+12 ; we are using. For option 'H' only look at bills with bill type 121 or visit type 111 or 3P Visit Type UB-92 BILL TYPE 111.
+13 ; Added bill type, visit type to detail output to assist with validation.
+14 ;
LBK ;
+1 DO ^XBFMK
+2 SET DIR("A")="Enter ENDING Date"
+3 SET DIR(0)="DO^:"_(DT-1)_":EPX"
+4 DO ^DIR
+5 KILL DIR
+6 IF $DATA(DIRUT)!$DATA(DIROUT)!$DATA(DTOUT)!$DATA(DUOUT)
QUIT
+7 SET ABMY("DT",2)=Y
+8 SET X1=ABMY("DT",2)
+9 SET X2=-365
+10 DO C^%DTC
+11 SET ABMY("DT",1)=X
+12 QUIT
FACHOS ;EP
+1 DO ^XBFMK
+2 SET DIR("A")="Select the type of report to run"
+3 SET DIR(0)="S^F:FACILITY EHR INCENTIVE REPORT (COST REPORT);H:HOSPITAL CALCULATION MU INCENTIVE REPORT"
+4 DO ^DIR
+5 KILL DIR
+6 SET ABMY("FACHOS")=Y
+7 QUIT
+8 ;start new abm*2.6*15 HEAT183309 Req#B
VISITS ;EP
+1 ;abm*2.6*20 IHS/SD/SDR HEAT256154 - split routine due to size.
DO VISITS^ABMMUFC6
+2 QUIT
+3 ;end new HEAT183309 Req#B
GETBILLS ;EP
+1 SET ABMPSDT=ABMP("SDT")-10000
+2 ;loop thru service date from x-ref
FOR
SET ABMPSDT=$ORDER(^ABMDBILL(DUZ(2),"AD",ABMPSDT))
IF 'ABMPSDT
QUIT
Begin DoDot:1
+3 ;abm*2.6*15 HEAT183309 Req#B
SET ABMPFLG=0
+4 SET ABMP("BDFN")=0
+5 FOR
SET ABMP("BDFN")=$ORDER(^ABMDBILL(DUZ(2),"AD",ABMPSDT,ABMP("BDFN")))
IF 'ABMP("BDFN")
QUIT
Begin DoDot:2
+6 SET ABMVDFN=0
+7 FOR
SET ABMVDFN=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),11,ABMVDFN))
IF 'ABMVDFN
QUIT
Begin DoDot:3
+8 ;visit has already been counted on a different bill abm*2.6*15
IF $DATA(^TMP($JOB,"ABM-MUVLST",ABMVDFN))
QUIT
+9 ;deleted visit
IF $PIECE($GET(^AUPNVSIT(ABMVDFN,0)),U,11)=1
QUIT
+10 ;abm*2.6*20 IHS/SD/SDR HEAT256154
SET ABMP("PVDFN")=$SELECT($PIECE($GET(^AUPNVSIT(ABMVDFN,0)),U,12):$PIECE(^AUPNVSIT(ABMVDFN,0),U,12),1:ABMVDFN)
+11 ;S ABMSC=$P($G(^AUPNVSIT(ABMVDFN,0)),U,7) ;service category ;abm*2.6*20 IHS/SD/SDR HEAT256154
+12 ;service category ;abm*2.6*20 IHS/SD/SDR HEAT256154
SET ABMSC=$PIECE($GET(^AUPNVSIT(ABMP("PVDFN"),0)),U,7)
+13 ;ignore all other service categories
IF "HIASRO"'[ABMSC
QUIT
+14 ;H=Hosp
+15 ;I=In Hosp
+16 ;A=Amb
+17 ;S=Day Surg
+18 ;R=Nurs Home
+19 ;O=Observ
+20 ;parent visit link; default to visit if there isn't one
+21 ;S ABMP("PVDFN")=$S($P($G(^AUPNVSIT(ABMVDFN,0)),U,12):$P(^AUPNVSIT(ABMVDFN,0),U,12),1:ABMVDFN) ;abm*2.6*20 IHS/SD/SDR HEAT256154
+22 ;if not Hospitalization, use Visit/Admit Date&Time
+23 ;seen before start date
IF ABMSC'="H"
IF ($PIECE($GET(^AUPNVSIT(ABMP("PVDFN"),0)),U)<ABMP("SDT"))
QUIT
+24 ;seen after end date
IF ABMSC'="H"
IF ($PIECE($GET(^AUPNVSIT(ABMP("PVDFN"),0)),U)>ABMP("EDT"))
QUIT
+25 ;if Hospitalization, get Date of Discharge from V Hospitalization file
+26 SET ABMQFLG=1
+27 IF ABMSC="H"
Begin DoDot:4
+28 ;S ABMP("VHIEN")=$O(^AUPNVINP("AD",ABMP("PVDFN"),0)) ;abm*2.6*7
+29 ;abm*2.6*7
SET ABMP("VHIEN")=+$ORDER(^AUPNVINP("AD",ABMP("PVDFN"),0))
+30 IF ABMP("VHIEN")=0
SET ABMQFLG=0
QUIT
+31 SET ABMP("DISCHDT")=$PIECE($GET(^AUPNVINP(ABMP("VHIEN"),0)),U)
+32 ;seen before start date
IF ABMP("DISCHDT")<ABMP("SDT")
SET ABMQFLG=0
QUIT
+33 ;seen after end date
IF ABMP("DISCHDT")>ABMP("EDT")
SET ABMQFLG=0
QUIT
+34 ;start new abm*2.6*12 swingbed
+35 SET ABMP("SWINGBED")=0
+36 IF $$GET1^DIQ(45.7,$$GET1^DIQ(9000010.02,ABMP("VHIEN"),".04","I"),"9999999.01","E")=21
SET ABMP("SWINGBED")=1
+37 IF $$GET1^DIQ(45.7,$$GET1^DIQ(9000010.02,ABMP("VHIEN"),".05","I"),"9999999.01","E")=21
SET ABMP("SWINGBED")=1
+38 ;end new swingbed
End DoDot:4
IF ABMQFLG=0
QUIT
+39 SET ABMPBDFN=0
+40 ;pymt flg
SET ABMPFLG=0
+41 KILL ABMB
+42 FOR ABMC=1:1
SET ABMPBDFN=$ORDER(^ABMDBILL(DUZ(2),"AV",ABMP("PVDFN"),ABMPBDFN))
IF 'ABMPBDFN
QUIT
Begin DoDot:4
+43 ;bill type
SET ABMP("BTYP")=$PIECE($GET(^ABMDBILL(DUZ(2),ABMPBDFN,0)),U,2)
+44 ;visit type
SET ABMP("VTYP")=$PIECE($GET(^ABMDBILL(DUZ(2),ABMPBDFN,0)),U,7)
+45 ;only inpt or ancillary visit types ;abm*2.6*20 IHS/SD/SDR HEAT256154
IF ABMY("FACHOS")="H"&'((ABMP("BTYP")=121)!(ABMP("VTYP")=111)!(+$PIECE($GET(^ABMDVTYP(ABMP("VTYP"),0)),U,2)=111))
QUIT
+46 ;skip cancelled bills
IF $PIECE($GET(^ABMDBILL(DUZ(2),ABMPBDFN,0)),U,4)="X"
QUIT
+47 SET ABMB(ABMP("VTYP"),ABMP("BTYP"),ABMC)=ABMPBDFN
End DoDot:4
IF ABMPFLG=1
QUIT
+48 ;no active bills found ;abm*2.6*15 HEAT183309
IF '$DATA(ABMB)
QUIT
+49 SET ABMP("VTYP")=0
+50 FOR
SET ABMP("VTYP")=$ORDER(ABMB(ABMP("VTYP")))
IF 'ABMP("VTYP")
QUIT
Begin DoDot:4
+51 SET ABMP("BTYP")=0
+52 FOR
SET ABMP("BTYP")=$ORDER(ABMB(ABMP("VTYP"),ABMP("BTYP")))
IF 'ABMP("BTYP")
QUIT
Begin DoDot:5
+53 SET ABMC=0
+54 FOR
SET ABMC=$ORDER(ABMB(ABMP("VTYP"),ABMP("BTYP"),ABMC))
IF 'ABMC
QUIT
Begin DoDot:6
+55 SET ABMPBDFN=$GET(ABMB(ABMP("VTYP"),ABMP("BTYP"),ABMC))
+56 SET ABM=ABMPBDFN
+57 SET ABMP("PDFN")=$PIECE($GET(^ABMDBILL(DUZ(2),ABMPBDFN,0)),U,5)
+58 ;exclude any DEMO,PATIENT
IF $$GET1^DIQ(2,ABMP("PDFN"),".01","E")["DEMO,PATIENT"
QUIT
+59 SET ABMP("INS")=$PIECE($GET(^ABMDBILL(DUZ(2),ABMPBDFN,0)),U,8)
+60 ;abm*2.6*15 HEAT183309 Req#G
IF $$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMP("INS"),".211","I"),1,"I")="K"
DO GETBINS^ABMMUFC3
+61 SET ABMP("LDFN")=$PIECE($GET(^ABMDBILL(DUZ(2),ABMPBDFN,0)),U,3)
+62 SET ABMP("VDT")=$PIECE($GET(^ABMDBILL(DUZ(2),ABMPBDFN,7)),U)
+63 ;abm*2.6*7
SET ABMP("NEWBORN")=0
+64 ;abm*2.6*7
IF $$GET1^DIQ(9002274.03,$PIECE($GET(^ABMDBILL(DUZ(2),ABMPBDFN,5)),U),.03,"E")="NEWBORN"
SET ABMP("NEWBORN")=1
+65 ;abm*2.6*20 IHS/SD/SDR HEAT256154
SET ABMATYP=$$GET1^DIQ(9002274.03,$PIECE($GET(^ABMDBILL(DUZ(2),ABMPBDFN,5)),U),.03,"E")
+66 ;abm*2.6*15 HEAT183309 Req#B
SET ABMP("PD")=0
+67 DO PREV^ABMMUFC3
+68 ;skip if no payment made on bill
IF +$GET(ABMP("PD"))=0&('ABMPYD)
QUIT
+69 SET ABMPFLG=1
End DoDot:6
IF ABMPFLG=1
QUIT
End DoDot:5
IF ABMPFLG=1
QUIT
End DoDot:4
IF ABMPFLG=1
QUIT
+70 ;if ABMPFLG=0 there wasn't a pymt on any bill; use the first one billed
IF ABMPFLG=0
Begin DoDot:4
+71 SET ABMP("VTYP")=$ORDER(ABMB(0))
+72 SET ABMP("BTYP")=$ORDER(ABMB(ABMP("VTYP"),0))
+73 SET ABMC=$ORDER(ABMB(ABMP("VTYP"),ABMP("BTYP"),0))
+74 SET ABMPBDFN=$GET(ABMB(ABMP("VTYP"),ABMP("BTYP"),ABMC))
End DoDot:4
+75 ;start old abm*2.6*15 HEAT183309 Req#B
+76 ;;if it gets here and ABMPFLG is 0, no pymt was found for any bill for this visit
+77 ;Q:+$G(ABMPFLG)=0
+78 ;end old HEAT183309 Req#B
+79 ;at this point it will be either 1)the first bill with payment; or 2)the first bill sorted so inpatient is on top
+80 SET ABMIT=$PIECE($GET(^ABMDBILL(DUZ(2),ABMPBDFN,2)),U,2)
+81 DO INSTYP
+82 SET ABMP("INS")=$PIECE($GET(^ABMDBILL(DUZ(2),ABMPBDFN,0)),U,8)
+83 SET ABMP("FSDT")=0
SET ABMFFLG=0
+84 FOR
SET ABMP("FSDT")=$ORDER(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),11,ABMP("FSDT")))
IF 'ABMP("FSDT")
QUIT
Begin DoDot:4
+85 IF $PIECE($GET(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),11,ABMP("FSDT"),0)),U)>ABMP("EDT")
QUIT
+86 IF $PIECE($GET(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),11,ABMP("FSDT"),0)),U,2)>ABMP("SDT")
QUIT
+87 SET ABMFFLG=1
End DoDot:4
IF ABMFFLG=1
QUIT
+88 ;start new abm*2.6*20 IHS/SD/SDR HEAT256154
+89 SET ABMCDAYS=+$PIECE($GET(^ABMDBILL(DUZ(2),ABMPBDFN,7)),U,3)
+90 IF 'ABMCDAYS
SET ABMCDAYS=$PIECE($GET(^ABMDBILL(DUZ(2),ABMPBDFN,6)),U,9)
+91 IF 'ABMCDAYS
SET ABMCDAYS=1
+92 ;commented out below line in abm*2.6*20 IHS/SD/SDR; Harrell Little said it didn't apply, that newborn is always newborn
+93 ;I ABMCDAYS>2 S ABMP("NEWBORN")=0 ;if stay is more than 2 days it isn't counted as newborn; it should be counted as adult&ped
+94 ;end new abm*2.6*20 IHS/SD/SDR HEAT256154
+95 DO SETCAT^ABMMUFAC
+96 ;Q:$D(^TMP($J,"ABM-MUVLST",ABMP("PVDFN"))) ;quit if this visit has already counted
+97 ;S ^TMP($J,"ABM-MUVLST",ABMP("PVDFN"))="" ;add visit to list
+98 ;start new abm*2.6*15 HEAT183309 Req#B
+99 SET ABMDOSB=$PIECE($GET(^ABMDBILL(DUZ(2),ABMPBDFN,7)),U)
+100 SET ABMDOSE=$PIECE($GET(^ABMDBILL(DUZ(2),ABMPBDFN,7)),U,2)
+101 SET ABMBILLD=+$PIECE($GET(^ABMDBILL(DUZ(2),ABMPBDFN,2)),U)
+102 SET ABMVLOC=$$GET1^DIQ(9002274.4,ABMPBDFN,".03","E")
+103 SET ABMNDAYS=+$PIECE($GET(^ABMDBILL(DUZ(2),ABMPBDFN,6)),U,6)
+104 ;start old abm*2.6*20 IHS/SD/SDR HEAT256154
+105 ;S ABMCDAYS=+$P($G(^ABMDBILL(DUZ(2),ABMPBDFN,7)),U,3)
+106 ;S:'ABMCDAYS ABMCDAYS=$P($G(^ABMDBILL(DUZ(2),ABMPBDFN,6)),U,9)
+107 ;S:'ABMCDAYS ABMCDAYS=1
+108 ;end old abm*2.6*20 IHS/SD/SDR HEAT256154
+109 SET ABMRT=$SELECT(+$GET(ABMP("PD"))'=0&(ABMPYD):"PD",1:"BLD")
+110 ;start old abm*2.6*20 IHS/SD/SDR HEAT256154
+111 ;I "^S^B^"[("^"_ABMSUMDT_"^") D SUMMREC
+112 ;I "^D^B^"[("^"_ABMSUMDT_"^") D DETREC
+113 ;I ABMIT="P" D ;if Private look for a Medicaid on the same bill abm*2.6*15 HEAT183309 Req#E
+114 ;.S ABMI=0,ABMDF=0
+115 ;.F S ABMI=$O(^ABMDBILL(DUZ(2),ABMPBDFN,13,ABMI)) Q:'ABMI D
+116 ;..I $P($G(^ABMDBILL(DUZ(2),ABMPBDFN,13,ABMI,0)),U,6)'="" S ABMDF=1
+117 ;.I ABMDF=1 S ABMITYP="PRI/MCD" D
+118 ;..I "^S^B^"[("^"_ABMSUMDT_"^") D SUMMREC
+119 ;..I "^D^B^"[("^"_ABMSUMDT_"^") D DETREC
+120 ;end old start new abm*2.6*20 IHS/SD/SDR HEAT256154
+121 ;this looks at other insurers on the bill and tries to determine if they are a PI/MCD or MCR/MCD bill;
+122 ;puts these into separate categories.
+123 SET ABMI=0
SET ABMDF=0
SET ABMITYPA=""
+124 FOR
SET ABMI=$ORDER(^ABMDBILL(DUZ(2),ABMPBDFN,13,ABMI))
IF 'ABMI
QUIT
Begin DoDot:4
+125 SET ABMJ=$PIECE($GET(^ABMDBILL(DUZ(2),ABMPBDFN,13,ABMI,0)),U)
+126 IF ABMITYPA'=""
SET ABMITYPA=ABMITYPA_"~"_$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,+ABMJ,".211","I"),1,"I")
+127 IF ABMITYPA=""
SET ABMITYPA=$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,+ABMJ,".211","I"),1,"I")
+128 IF $PIECE($GET(^ABMDBILL(DUZ(2),ABMPBDFN,13,ABMI,0)),U,6)'=""
IF ABMIT="P"
SET ABMDF=1
+129 IF $PIECE($GET(^ABMDBILL(DUZ(2),ABMPBDFN,13,ABMI,0)),U,6)'=""
IF ABMIT="R"
SET ABMDF=2
End DoDot:4
+130 IF ABMDF=1
SET ABMITYP="PRI/MCD"
+131 IF ABMDF=2
SET ABMITYP="MCR/MCD"
+132 ;
+133 IF "^S^B^"[("^"_ABMSUMDT_"^")
DO SUMMREC
+134 IF "^D^B^"[("^"_ABMSUMDT_"^")
DO DETREC
+135 ;end new abm*2.6*20 IHS/SD/SDR HEAT256154
End DoDot:3
IF ABMPFLG=1
QUIT
End DoDot:2
End DoDot:1
+136 QUIT
+137 ;start new abm*2.6*15 HEAT183309 Req#B
SUMMREC ;EP
+1 ;abm*2.6*20 IHS/SD/SDR HEAT256154 - split routine due to size
DO SUMMREC^ABMMUFC6
+2 QUIT
DETREC ;EP
+1 ;abm*2.6*20 IHS/SD/SDR HEAT256154 - split routine due to size
DO DETREC^ABMMUFC6
+2 QUIT
+3 ;end new HEAT183309 Req#B
INSTYP ;EP
+1 IF "^R^MH^MD^"[("^"_ABMIT_"^")
SET ABMITYP="MEDICARE"
+2 IF "^P^H^D^F^"[("^"_ABMIT_"^")
SET ABMITYP="PRIVATE"
+3 IF ABMIT="D"
SET ABMITYP="MEDICAID"
+4 ;I ABMIT="K" S ABMITYP="KIDSCARE/CHIP" ;abm*2.6*15 HEAT183309 Req#G
+5 ;abm*2.6*15 HEAT183309 Req#G
IF ABMIT="K"&($GET(ABMIT2)="D")
SET ABMITYP="KIDSCARE XIX"
+6 ;abm*2.6*15 HEAT183309 Req#G
IF ABMIT="K"&($GET(ABMIT2)="P")
SET ABMITYP="KIDSCARE XXI"
+7 ;abm*2.6*12 VMBP RQMT_104
IF ABMIT="V"
SET ABMITYP="VMBP"
+8 ;I "^W^C^N^I^T^G^"[("^"_ABMIT_"^") S ABMITYP="OTHER" ;abm*2.6*15 HEAT183309
+9 ;abm*2.6*15 HEAT183309
IF "^W^C^N^I^T^G^FPL^MMC^MC^SEP^TSI^"[("^"_ABMIT_"^")
SET ABMITYP="OTHER"
+10 QUIT
BTYP ;EP - partial copy of code from BTYP^ABMDEVAR
+1 SET ABMP("BTYP")=""
+2 IF $PIECE($GET(^ABMNINS(DUZ(2),+ABMP("INS"),1,ABMP("VTYP"),0)),U,11)
Begin DoDot:1
+3 SET ABMP("BTYP")=$PIECE(^ABMNINS(DUZ(2),+ABMP("INS"),1,ABMP("VTYP"),0),U,11)
+4 SET ABMP("BTYP")=$PIECE($GET(^ABMDCODE(ABMP("BTYP"),0)),U)
End DoDot:1
+5 IF ABMP("BTYP")<110!(ABMP("BTYP")>999)
SET ABMP("BTYP")=""
+6 IF ABMP("BTYP")=""
SET ABMP("BTYP")=$SELECT(ABMP("VTYP")=111:111,ABMP("VTYP")=121:121,ABMP("VTYP")=831:831,1:131)
+7 IF ABMP("VTYP")=111
IF $$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMP("INS"),".211","I"),1,"I")="R"
SET ABMP("BTYP")=121
Begin DoDot:1
+8 NEW I
+9 SET I=0
+10 FOR
SET I=$ORDER(^AUPNMCR(ABMP("PDFN"),11,I))
IF 'I
QUIT
Begin DoDot:2
+11 IF $PIECE(^AUPNMCR(ABMP("PDFN"),11,I,0),U)>ABMP("VDT")
QUIT
+12 IF $PIECE(^AUPNMCR(ABMP("PDFN"),11,I,0),U,2)<ABMP("VDT")
IF $PIECE(^(0),U,2)'=""
QUIT
+13 IF $PIECE(^AUPNMCR(ABMP("PDFN"),11,I,0),U,3)'="A"
QUIT
+14 SET ABMP("BTYP")=111
End DoDot:2
+15 IF ABMP("BTYP")=121
Begin DoDot:2
+16 NEW I
+17 SET I=0
+18 FOR
SET I=$ORDER(^AUPNRRE(ABMP("PDFN"),11,I))
IF 'I
QUIT
Begin DoDot:3
+19 IF $PIECE(^AUPNRRE(ABMP("PDFN"),11,I,0),U)>ABMP("VDT")
QUIT
+20 IF $PIECE(^AUPNRRE(ABMP("PDFN"),11,I,0),U,2)<ABMP("VDT")
IF $PIECE(^(0),U,2)'=""
QUIT
+21 IF $PIECE(^AUPNRRE(ABMP("PDFN"),11,I,0),U,3)'="A"
QUIT
+22 SET ABMP("BTYP")=111
End DoDot:3
End DoDot:2
End DoDot:1
+23 QUIT
