ABMMUFC6 ;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*20 - HEAT256154 - Split routine from ABMMUFC1 due to size.
; 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. Smartened up check for eligibility when in the
; visit section. It was counting using the first insurer found. If the reason is one of the ones with (NE) it shouldn't use
; that eligibility to count.
;
VISITS ;EP
S ABMNDAYS=0,ABMBILLD=0,ABMPBDFN=0
S ABMDDT=ABMP("SDT")-.0001
F S ABMDDT=$O(^AUPNVINP("B",ABMDDT)) Q:ABMDDT=""!($P(ABMDDT,".")>ABMP("EDT")) D
.S ABMDOSE=ABMDDT
.S ABMHDFN=0
.F S ABMHDFN=$O(^AUPNVINP("B",ABMDDT,ABMHDFN)) Q:ABMHDFN'=+ABMHDFN D
..Q:'$D(^AUPNVINP(ABMHDFN,0))
..S ABMVDFN=$P(^AUPNVINP(ABMHDFN,0),U,3)
..Q:'ABMVDFN
..I $D(^TMP($J,"ABM-MUVLST",ABMVDFN)) Q ;visit already counted ;abm*2.6*15
..Q:'$D(^AUPNVSIT(ABMVDFN,0))
..Q:$P(^AUPNVSIT(ABMVDFN,0),U,11) ;deleted visit
..Q:$P(^AUPNVSIT(ABMVDFN,0),U,7)'="H" ;hospitalizations only
..Q:$P(^AUPNVSIT(ABMVDFN,0),U,3)="C" ;CHS visit
..I '$D(ABMLOC($P(^AUPNVSIT(ABMVDFN,0),U,6))) Q ;not location of interest
..S ABMVLOC=$$GET1^DIQ(9000010,ABMVDFN,".06","E")
..S (DFN,ABMP("PDFN"))=$P(^AUPNVSIT(ABMVDFN,0),U,5)
..Q:$$GET1^DIQ(2,ABMP("PDFN"),".01","E")["DEMO,PATIENT" ;exclude any DEMO,PATIENT
..;exclude DEMO patients
..S ABMNAME=$P(^DPT(DFN,0),U)
..;S (ABMDOSB,ABMP("VDT"))=$P($P($G(^AUPNVSIT(ABMVDFN,0)),U),".") ;visit date ;abm*2.6*20 IHS/SD/SDR HEAT256154
..S (ABMDOSB,ABMVDT,ABMP("VDT"))=$P($P($G(^AUPNVSIT(ABMVDFN,0)),U),".") ;visit date ;abm*2.6*20 IHS/SD/SDR HEAT256154
..S ABMSC=$P($G(^AUPNVSIT(ABMVDFN,0)),U,7) ;serv cat
..S ABMCLN=$P($G(^AUPNVSIT(ABMVDFN,0)),U,8) ;clinic
..S ABMCDAYS=$$LOS^APCLV(ABMVDFN) ;Length of Stay
..S ABMP("NEWBORN")=0 ;abm*2.6*20 IHS/SD/SDR HEAT256154
..;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 $P($G(^AUPNVINP(ABMHDFN,0)),U,4)]"",$P($G(^DIC(45.7,$P($G(^AUPNVINP(ABMHDFN,0)),U,4),9999999)),U)="07",(ABMCDAYS<3) S ABMP("NEWBORN")=1 ;abm*2.6*20 IHS/SD/SDR HEAT256154
..S:$P($G(^AUPNVINP(ABMHDFN,0)),U,4)]"" ABMATYP=$P($G(^DIC(45.7,$P($G(^AUPNVINP(ABMHDFN,0)),U,4),0)),U) ;abm*2.6*20 IHS/SD/SDR HEAT256154
..;Next section will guess what insurer should be. Going to use first insurer found, billable or not.
..;It gets too complicated to figure out when it will or won't count for each insurer type.
..S ABMLSV=$G(ABML)
..N ABML ;abm*2.6*20 IHS/SD/SDR HEAT256154
..S ABML=""
..K ABMDISDT ;abm*2.6*20 IHS/SD/SDR HEAT256154
..D ELG^ABMDLCK(ABMVDFN,.ABML,DFN,ABMP("VDT"))
..;I '$D(ABML) Q ;patient doesn't have eligibility, don't count. ;abm*2.6*15 HEAT208561 ;abm*2.6*20 IHS/SD/SDR HEAT256154
..;start new abm*2.6*20 IHS/SD/SDR HEAT256154
..S ABMPRI=0,ABMITYPA=""
..F S ABMPRI=$O(ABML(ABMPRI)) Q:'ABMPRI D
...S ABMP("INS")=0
...F S ABMP("INS")=$O(ABML(ABMPRI,ABMP("INS"))) Q:'ABMP("INS") D
....I ABMPRI<97,(ABMITYPA'="") S ABMITYPA=ABMITYPA_"~"_$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,+ABMP("INS"),".211","I"),1,"I")
....I ABMPRI<97,(ABMITYPA="") S ABMITYPA=$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,+ABMP("INS"),".211","I"),1,"I")
..;
..S ABMPRI=0,ABMEFLG=0
..S ABMRT="NOTBLD"
..F S ABMPRI=$O(ABML(ABMPRI)) Q:'ABMPRI D Q:ABMEFLG
...S ABMP("INS")=0
...F S ABMP("INS")=$O(ABML(ABMPRI,ABMP("INS"))) Q:'ABMP("INS") D Q:ABMEFLG
....I ABMPRI<97 S ABMEFLG=1 Q
....I (ABMPRI=99)&(+$P(ABML(ABMPRI,ABMP("INS")),U,6)=0) Q
....I $P($G(^ABMDCS(+$P(ABML(ABMPRI,ABMP("INS")),U,6),0)),U)'["(NE)" S ABMEFLG=1 Q
..;
..I '$D(ABML)!('ABMEFLG) D Q ;patient doesn't have eligibility, count as VISIT WITH NO ELIG and quit
...S ABMP("PVDFN")=ABMVDFN
...S (ABMP("VTYP"),ABMP("BTYP"))=0
...I ABMSC="H" S (ABMP("VTYP"),ABMP("BTYP"))=111 ;if no elig and service cat 'H', make it inpatient
...D SETCAT^ABMMUFAC
...S ABMP("INS")=0
...S ABMP("INSN")="NO ELIG"
...S ABMITYP="VISIT W/NO ELIG"
...I "^S^B^"[("^"_ABMSUMDT_"^") D SUMMREC
...I ABMSUMDT="D" D DETREC
..;end new abm*2.6*20 IHS/SD/SDR HEAT256154
..;
..;start old abm*2.6*20 IHS/SD/SDR HEAT256154
..;S ABMPRI=$O(ABML(0))
..;S ABMP("INS")=$O(ABML(ABMPRI,0))
..;end old abm*2.6*20 IHS/SD/SDR HEAT256154
..S ABMIT=$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMP("INS"),".211","I"),1,"I")
..S:(ABMIT="K") ABMIT2=$P(ABML(ABMPRI,ABMP("INS")),U,3) ;this will show if it is title XIX or XXI
..D INSTYP^ABMMUFC1
..S ABMP("VTYP")=$$VTYP^ABMDVCK1(ABMVDFN,ABMSC,ABMP("INS"),ABMCLN)
..D BTYP^ABMMUFC1
..D SETCAT^ABMMUFAC
..S ABML=ABMLSV
..;
..S ABMP("PVDFN")=ABMVDFN
..S ABMRT="NOTBLD"
..;start old abm*2.6*20 IHS/SD/SDR HEAT256154
..;I "^S^B^"[("^"_ABMSUMDT_"^") D SUMMREC
..;;I "^D^B^"[("^"_ABMSUMDT_"^") D DETREC ;abm*2.6*15
..;I ABMSUMDT="D" D DETREC ;abm*2.6*15
..;;below code will check if patient has PI and MCD for this visit abm*2.6*15 HEAT183309 Req#E
..;S ABMPF=0,ABMDF=0
..;S ABMPRI=0
..;F S ABMPRI=$O(ABML(ABMPRI)) Q:'ABMPRI D
..;.S ABMI=0
..;.F S ABMI=$O(ABML(ABMPRI,ABMI)) Q:'ABMI D
..;..I $P(ABML(ABMPRI,ABMI),U,3)="P" S ABMPF=1
..;..I $P(ABML(ABMPRI,ABMI),U,3)="D" S ABMDF=1
..;I ABMPF=1,ABMDF=1 D
..;.S ABMITYP="PRI/MCD"
..;.I "^S^B^"[("^"_ABMSUMDT_"^") D SUMMREC Q
..;.;I "^D^B^"[("^"_ABMSUMDT_"^") D DETREC ;abm*2.6*15
..;.I ABMSUMDT="D" D DETREC ;abm*2.6*15
..;end old start new abm*2.6*20 IHS/SD/SDR HEAT256154
..;below code will check if patient has PI and MCD for this visit abm*2.6*15 HEAT183309 Req#E
..S ABMPF=0,ABMDF=0,ABMMF=0
..S ABMPRI=0
..F S ABMPRI=$O(ABML(ABMPRI)) Q:'ABMPRI D
...Q:ABMPRI>97
...S ABMI=0
...F S ABMI=$O(ABML(ABMPRI,ABMI)) Q:'ABMI D
....I $$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMI,".211","I"),1,"I")="P" S ABMPF=1
....I $$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMI,".211","I"),1,"I")="D" S ABMDF=1
....I $$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMI,".211","I"),1,"I")="M" S ABMMF=1
..I ABMPF=1,ABMDF=1 S ABMITYP="PRI/MCD"
..I ABMMF=1,ABMDF=1 S ABMITYP="MCR/MCD"
..I "^S^B^"[("^"_ABMSUMDT_"^") D SUMMREC Q
..I ABMSUMDT="D" D DETREC
..;end new abm*2.6*20 IHS/SD/SDR HEAT256154
Q
;end new HEAT183309 Req#B
SUMMREC ;EP
;cnt # IP/OP discharges
Q:$$GET1^DIQ(2,ABMP("PDFN"),".01","E")["DEMO,PATIENT" ;exclude any DEMO,PATIENT
I $D(^TMP($J,"ABM-MUVLST",ABMP("PVDFN")))&(ABMITYP'="PRI/MCD") Q ;quit if this visit has already counted
I ABMSUMDT="B" D DETREC
S ^TMP($J,"ABM-MUVLST",ABMP("PVDFN"))="" ;add visit to list
;
S ^TMP($J,"ABM-MUFAC",ABMITYP,ABMRT,ABMP("RPT-CAT"))=+$G(^TMP($J,"ABM-MUFAC",ABMITYP,ABMRT,ABMP("RPT-CAT")))+1
;S ^TMP($J,"ABM-MUFAC","GTOT",ABMRT,ABMP("RPT-CAT"))=+$G(^TMP($J,"ABM-MUFAC","GTOT",ABMRT,ABMP("RPT-CAT")))+1
;tot cov'd days
;start old abm*2.6*15 HEAT183309 Req#B
;S:(ABMP("RPT-CAT")="IP SB DISCHGS") ^TMP($J,"ABM-MUFAC",ABMITYP,"IP SB DAYS")=+$G(^TMP($J,"ABM-MUFAC",ABMITYP,"IP SB DAYS"))+ABMCDAYS ;abm*2.6*12 swingbed
;S:(ABMP("RPT-CAT")="IP DISCHGS") ^TMP($J,"ABM-MUFAC",ABMITYP,"IP DAYS")=+$G(^TMP($J,"ABM-MUFAC",ABMITYP,"IP DAYS"))+ABMCDAYS
;S:(ABMP("RPT-CAT")="IP NB DISCHGS") ^TMP($J,"ABM-MUFAC",ABMITYP,"IP NB DAYS")=+$G(^TMP($J,"ABM-MUFAC",ABMITYP,"IP NB DAYS"))+ABMCDAYS ;abm*2.6*7
;;S:(ABMP("RPT-CAT")="IP CHGS") ^TMP($J,"ABM-MUFAC",ABMITYP,"IP CHGS DAYS")=+$G(^TMP($J,"ABM-MUFAC",ABMITYP,"IP CHG DAYS"))+ABMCDAYS ;abm*2.6*7
;S:(ABMP("RPT-CAT")="IP CHGS") ^TMP($J,"ABM-MUFAC",ABMITYP,"IP CHGS DAYS")=+$G(^TMP($J,"ABM-MUFAC",ABMITYP,"IP CHGS DAYS"))+ABMCDAYS ;abm*2.6*7
;end old start new HEAT183309 Req#B
I (ABMP("RPT-CAT")="IP SB DISCHGS") S ^TMP($J,"ABM-MUFAC",ABMITYP,ABMRT,"IP SB DAYS")=+$G(^TMP($J,"ABM-MUFAC",ABMITYP,ABMRT,"IP SB DAYS"))+ABMCDAYS
I (ABMP("RPT-CAT")="IP DISCHGS") D
.S ^TMP($J,"ABM-MUFAC",ABMITYP,ABMRT,"IP DAYS")=+$G(^TMP($J,"ABM-MUFAC",ABMITYP,ABMRT,"IP DAYS"))+ABMCDAYS
.;S ^TMP($J,"ABM-MUFAC","GTOT",ABMRT,"IP DAYS")=+$G(^TMP($J,"ABM-MUFAC","GTOT",ABMRT,"IP DAYS"))+ABMCDAYS
;start new abm*2.6*20 IHS/SD/SDR HEAT256154
I (ABMP("RPT-CAT")="IP ANC DISCHGS") D
.S ^TMP($J,"ABM-MUFAC",ABMITYP,ABMRT,"IP ANC DAYS")=+$G(^TMP($J,"ABM-MUFAC",ABMITYP,ABMRT,"IP ANC DAYS"))+ABMCDAYS
;end new abm*2.6*20 IHS/SD/SDR HEAT256154
I (ABMP("RPT-CAT")="IP NB DISCHGS") D
.S ^TMP($J,"ABM-MUFAC",ABMITYP,ABMRT,"IP NB DAYS")=+$G(^TMP($J,"ABM-MUFAC",ABMITYP,ABMRT,"IP NB DAYS"))+ABMCDAYS
.;S ^TMP($J,"ABM-MUFAC","GTOT",ABMRT,"IP NB DAYS")=+$G(^TMP($J,"ABM-MUFAC","GTOT",ABMRT,"IP NB DAYS"))+ABMCDAYS
I (ABMP("RPT-CAT")="IP CHGS") D
.S ^TMP($J,"ABM-MUFAC",ABMITYP,ABMRT,"IP CHGS DAYS")=+$G(^TMP($J,"ABM-MUFAC",ABMITYP,ABMRT,"IP CHGS DAYS"))+ABMCDAYS
.;S ^TMP($J,"ABM-MUFAC","GTOT",ABMRT,"IP CHGS DAYS")=+$G(^TMP($J,"ABM-MUFAC","GTOT",ABMRT,"IP CHGS DAYS"))+ABMCDAYS
Q
DETREC ;EP
Q:$$GET1^DIQ(2,ABMP("PDFN"),".01","E")["DEMO,PATIENT" ;exclude any DEMO,PATIENT
I ABMITYP="PRI/MCD" K ^TMP($J,"ABM-MUVLST",ABMP("PVDFN"))
I $D(^TMP($J,"ABM-MUVLST",ABMP("PVDFN"))) Q ;quit if this visit has already counted
S ^TMP($J,"ABM-MUVLST",ABMP("PVDFN"))="" ;add visit to list
;
I ABMY("FACHOS")="H"&(ABMP("RPT-CAT")'["IP") Q ;only include IP lines if option H was selected for rpt
I ABMY("FACHOS")="H"&(ABMP("RPT-CAT")["SB") Q ;skip include Swingbed lines if option H was selected for rpt
;S ABMP("INSN")=$P($G(^AUTNINS(ABMP("INS"),0)),U) ;abm*2.6*20 IHS/SD/SDR HEAT256154
I +ABMP("INS")'=0 S ABMP("INSN")=$P($G(^AUTNINS(ABMP("INS"),0)),U) ;abm*2.6*20 IHS/SD/SDR HEAT256154
S ABMREC=ABMDOSB_U_ABMDOSE_U_ABMBILLD_U_+$G(ABMP("PD"))_U_ABMCDAYS_U_ABMNDAYS_U_ABMVLOC_U_DUZ(2)_U_ABMPBDFN
;I ABMY("FACHOS")="H" S ABMREC=ABMREC_U_ABMRT ;abm*2.6*20 IHS/SD/SDR HEAT256154
I ABMY("FACHOS")="H" S ABMREC=ABMREC_U_ABMRT_U_$G(ABMP("BTYP"))_U_$G(ABMP("VTYP"))_U_$G(ABMITYPA)_U_ABMATYP ;abm*2.6*20 IHS/SD/SDR HEAT256154
S ^TMP($J,"ABM-MUFAC","DETAIL",ABMITYP,ABMRT,ABMP("RPT-CAT"),ABMP("INSN")_"|"_ABMP("INS"),$S(+$G(ABMP("PVDFN")):ABMP("PVDFN"),1:ABMVDFN))=ABMREC
Q
ABMMUFC6 ;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*20 - HEAT256154 - Split routine from ABMMUFC1 due to size.
+3 ; Made changes for Newborn stays for 3+ days to count as Adult&Ped charges and bed days.
+4 ; Also added 2 new categories, Visits w/no Eligibility and Medicare/Medicaid dual eligibles. Corrected PI/Mcd entries so
+5 ; they weren't duplicates any more. Correction to lookup of visit data where parent visit link isn't the same as the visit
+6 ; 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.
+7 ; Added bill type, visit type to detail output to assist with validation. Smartened up check for eligibility when in the
+8 ; visit section. It was counting using the first insurer found. If the reason is one of the ones with (NE) it shouldn't use
+9 ; that eligibility to count.
+10 ;
VISITS ;EP
+1 SET ABMNDAYS=0
SET ABMBILLD=0
SET ABMPBDFN=0
+2 SET ABMDDT=ABMP("SDT")-.0001
+3 FOR
SET ABMDDT=$ORDER(^AUPNVINP("B",ABMDDT))
IF ABMDDT=""!($PIECE(ABMDDT,".")>ABMP("EDT"))
QUIT
Begin DoDot:1
+4 SET ABMDOSE=ABMDDT
+5 SET ABMHDFN=0
+6 FOR
SET ABMHDFN=$ORDER(^AUPNVINP("B",ABMDDT,ABMHDFN))
IF ABMHDFN'=+ABMHDFN
QUIT
Begin DoDot:2
+7 IF '$DATA(^AUPNVINP(ABMHDFN,0))
QUIT
+8 SET ABMVDFN=$PIECE(^AUPNVINP(ABMHDFN,0),U,3)
+9 IF 'ABMVDFN
QUIT
+10 ;visit already counted ;abm*2.6*15
IF $DATA(^TMP($JOB,"ABM-MUVLST",ABMVDFN))
QUIT
+11 IF '$DATA(^AUPNVSIT(ABMVDFN,0))
QUIT
+12 ;deleted visit
IF $PIECE(^AUPNVSIT(ABMVDFN,0),U,11)
QUIT
+13 ;hospitalizations only
IF $PIECE(^AUPNVSIT(ABMVDFN,0),U,7)'="H"
QUIT
+14 ;CHS visit
IF $PIECE(^AUPNVSIT(ABMVDFN,0),U,3)="C"
QUIT
+15 ;not location of interest
IF '$DATA(ABMLOC($PIECE(^AUPNVSIT(ABMVDFN,0),U,6)))
QUIT
+16 SET ABMVLOC=$$GET1^DIQ(9000010,ABMVDFN,".06","E")
+17 SET (DFN,ABMP("PDFN"))=$PIECE(^AUPNVSIT(ABMVDFN,0),U,5)
+18 ;exclude any DEMO,PATIENT
IF $$GET1^DIQ(2,ABMP("PDFN"),".01","E")["DEMO,PATIENT"
QUIT
+19 ;exclude DEMO patients
+20 SET ABMNAME=$PIECE(^DPT(DFN,0),U)
+21 ;S (ABMDOSB,ABMP("VDT"))=$P($P($G(^AUPNVSIT(ABMVDFN,0)),U),".") ;visit date ;abm*2.6*20 IHS/SD/SDR HEAT256154
+22 ;visit date ;abm*2.6*20 IHS/SD/SDR HEAT256154
SET (ABMDOSB,ABMVDT,ABMP("VDT"))=$PIECE($PIECE($GET(^AUPNVSIT(ABMVDFN,0)),U),".")
+23 ;serv cat
SET ABMSC=$PIECE($GET(^AUPNVSIT(ABMVDFN,0)),U,7)
+24 ;clinic
SET ABMCLN=$PIECE($GET(^AUPNVSIT(ABMVDFN,0)),U,8)
+25 ;Length of Stay
SET ABMCDAYS=$$LOS^APCLV(ABMVDFN)
+26 ;abm*2.6*20 IHS/SD/SDR HEAT256154
SET ABMP("NEWBORN")=0
+27 ;commented out below line in abm*2.6*20 IHS/SD/SDR; Harrell Little said it didn't apply, that newborn is always newborn
+28 ;I $P($G(^AUPNVINP(ABMHDFN,0)),U,4)]"",$P($G(^DIC(45.7,$P($G(^AUPNVINP(ABMHDFN,0)),U,4),9999999)),U)="07",(ABMCDAYS<3) S ABMP("NEWBORN")=1 ;abm*2.6*20 IHS/SD/SDR HEAT256154
+29 ;abm*2.6*20 IHS/SD/SDR HEAT256154
IF $PIECE($GET(^AUPNVINP(ABMHDFN,0)),U,4)]""
SET ABMATYP=$PIECE($GET(^DIC(45.7,$PIECE($GET(^AUPNVINP(ABMHDFN,0)),U,4),0)),U)
+30 ;Next section will guess what insurer should be. Going to use first insurer found, billable or not.
+31 ;It gets too complicated to figure out when it will or won't count for each insurer type.
+32 SET ABMLSV=$GET(ABML)
+33 ;abm*2.6*20 IHS/SD/SDR HEAT256154
NEW ABML
+34 SET ABML=""
+35 ;abm*2.6*20 IHS/SD/SDR HEAT256154
KILL ABMDISDT
+36 DO ELG^ABMDLCK(ABMVDFN,.ABML,DFN,ABMP("VDT"))
+37 ;I '$D(ABML) Q ;patient doesn't have eligibility, don't count. ;abm*2.6*15 HEAT208561 ;abm*2.6*20 IHS/SD/SDR HEAT256154
+38 ;start new abm*2.6*20 IHS/SD/SDR HEAT256154
+39 SET ABMPRI=0
SET ABMITYPA=""
+40 FOR
SET ABMPRI=$ORDER(ABML(ABMPRI))
IF 'ABMPRI
QUIT
Begin DoDot:3
+41 SET ABMP("INS")=0
+42 FOR
SET ABMP("INS")=$ORDER(ABML(ABMPRI,ABMP("INS")))
IF 'ABMP("INS")
QUIT
Begin DoDot:4
+43 IF ABMPRI<97
IF (ABMITYPA'="")
SET ABMITYPA=ABMITYPA_"~"_$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,+ABMP("INS"),".211","I"),1,"I")
+44 IF ABMPRI<97
IF (ABMITYPA="")
SET ABMITYPA=$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,+ABMP("INS"),".211","I"),1,"I")
End DoDot:4
End DoDot:3
+45 ;
+46 SET ABMPRI=0
SET ABMEFLG=0
+47 SET ABMRT="NOTBLD"
+48 FOR
SET ABMPRI=$ORDER(ABML(ABMPRI))
IF 'ABMPRI
QUIT
Begin DoDot:3
+49 SET ABMP("INS")=0
+50 FOR
SET ABMP("INS")=$ORDER(ABML(ABMPRI,ABMP("INS")))
IF 'ABMP("INS")
QUIT
Begin DoDot:4
+51 IF ABMPRI<97
SET ABMEFLG=1
QUIT
+52 IF (ABMPRI=99)&(+$PIECE(ABML(ABMPRI,ABMP("INS")),U,6)=0)
QUIT
+53 IF $PIECE($GET(^ABMDCS(+$PIECE(ABML(ABMPRI,ABMP("INS")),U,6),0)),U)'["(NE)"
SET ABMEFLG=1
QUIT
End DoDot:4
IF ABMEFLG
QUIT
End DoDot:3
IF ABMEFLG
QUIT
+54 ;
+55 ;patient doesn't have eligibility, count as VISIT WITH NO ELIG and quit
IF '$DATA(ABML)!('ABMEFLG)
Begin DoDot:3
+56 SET ABMP("PVDFN")=ABMVDFN
+57 SET (ABMP("VTYP"),ABMP("BTYP"))=0
+58 ;if no elig and service cat 'H', make it inpatient
IF ABMSC="H"
SET (ABMP("VTYP"),ABMP("BTYP"))=111
+59 DO SETCAT^ABMMUFAC
+60 SET ABMP("INS")=0
+61 SET ABMP("INSN")="NO ELIG"
+62 SET ABMITYP="VISIT W/NO ELIG"
+63 IF "^S^B^"[("^"_ABMSUMDT_"^")
DO SUMMREC
+64 IF ABMSUMDT="D"
DO DETREC
End DoDot:3
QUIT
+65 ;end new abm*2.6*20 IHS/SD/SDR HEAT256154
+66 ;
+67 ;start old abm*2.6*20 IHS/SD/SDR HEAT256154
+68 ;S ABMPRI=$O(ABML(0))
+69 ;S ABMP("INS")=$O(ABML(ABMPRI,0))
+70 ;end old abm*2.6*20 IHS/SD/SDR HEAT256154
+71 SET ABMIT=$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMP("INS"),".211","I"),1,"I")
+72 ;this will show if it is title XIX or XXI
IF (ABMIT="K")
SET ABMIT2=$PIECE(ABML(ABMPRI,ABMP("INS")),U,3)
+73 DO INSTYP^ABMMUFC1
+74 SET ABMP("VTYP")=$$VTYP^ABMDVCK1(ABMVDFN,ABMSC,ABMP("INS"),ABMCLN)
+75 DO BTYP^ABMMUFC1
+76 DO SETCAT^ABMMUFAC
+77 SET ABML=ABMLSV
+78 ;
+79 SET ABMP("PVDFN")=ABMVDFN
+80 SET ABMRT="NOTBLD"
+81 ;start old abm*2.6*20 IHS/SD/SDR HEAT256154
+82 ;I "^S^B^"[("^"_ABMSUMDT_"^") D SUMMREC
+83 ;;I "^D^B^"[("^"_ABMSUMDT_"^") D DETREC ;abm*2.6*15
+84 ;I ABMSUMDT="D" D DETREC ;abm*2.6*15
+85 ;;below code will check if patient has PI and MCD for this visit abm*2.6*15 HEAT183309 Req#E
+86 ;S ABMPF=0,ABMDF=0
+87 ;S ABMPRI=0
+88 ;F S ABMPRI=$O(ABML(ABMPRI)) Q:'ABMPRI D
+89 ;.S ABMI=0
+90 ;.F S ABMI=$O(ABML(ABMPRI,ABMI)) Q:'ABMI D
+91 ;..I $P(ABML(ABMPRI,ABMI),U,3)="P" S ABMPF=1
+92 ;..I $P(ABML(ABMPRI,ABMI),U,3)="D" S ABMDF=1
+93 ;I ABMPF=1,ABMDF=1 D
+94 ;.S ABMITYP="PRI/MCD"
+95 ;.I "^S^B^"[("^"_ABMSUMDT_"^") D SUMMREC Q
+96 ;.;I "^D^B^"[("^"_ABMSUMDT_"^") D DETREC ;abm*2.6*15
+97 ;.I ABMSUMDT="D" D DETREC ;abm*2.6*15
+98 ;end old start new abm*2.6*20 IHS/SD/SDR HEAT256154
+99 ;below code will check if patient has PI and MCD for this visit abm*2.6*15 HEAT183309 Req#E
+100 SET ABMPF=0
SET ABMDF=0
SET ABMMF=0
+101 SET ABMPRI=0
+102 FOR
SET ABMPRI=$ORDER(ABML(ABMPRI))
IF 'ABMPRI
QUIT
Begin DoDot:3
+103 IF ABMPRI>97
QUIT
+104 SET ABMI=0
+105 FOR
SET ABMI=$ORDER(ABML(ABMPRI,ABMI))
IF 'ABMI
QUIT
Begin DoDot:4
+106 IF $$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMI,".211","I"),1,"I")="P"
SET ABMPF=1
+107 IF $$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMI,".211","I"),1,"I")="D"
SET ABMDF=1
+108 IF $$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMI,".211","I"),1,"I")="M"
SET ABMMF=1
End DoDot:4
End DoDot:3
+109 IF ABMPF=1
IF ABMDF=1
SET ABMITYP="PRI/MCD"
+110 IF ABMMF=1
IF ABMDF=1
SET ABMITYP="MCR/MCD"
+111 IF "^S^B^"[("^"_ABMSUMDT_"^")
DO SUMMREC
QUIT
+112 IF ABMSUMDT="D"
DO DETREC
+113 ;end new abm*2.6*20 IHS/SD/SDR HEAT256154
End DoDot:2
End DoDot:1
+114 QUIT
+115 ;end new HEAT183309 Req#B
SUMMREC ;EP
+1 ;cnt # IP/OP discharges
+2 ;exclude any DEMO,PATIENT
IF $$GET1^DIQ(2,ABMP("PDFN"),".01","E")["DEMO,PATIENT"
QUIT
+3 ;quit if this visit has already counted
IF $DATA(^TMP($JOB,"ABM-MUVLST",ABMP("PVDFN")))&(ABMITYP'="PRI/MCD")
QUIT
+4 IF ABMSUMDT="B"
DO DETREC
+5 ;add visit to list
SET ^TMP($JOB,"ABM-MUVLST",ABMP("PVDFN"))=""
+6 ;
+7 SET ^TMP($JOB,"ABM-MUFAC",ABMITYP,ABMRT,ABMP("RPT-CAT"))=+$GET(^TMP($JOB,"ABM-MUFAC",ABMITYP,ABMRT,ABMP("RPT-CAT")))+1
+8 ;S ^TMP($J,"ABM-MUFAC","GTOT",ABMRT,ABMP("RPT-CAT"))=+$G(^TMP($J,"ABM-MUFAC","GTOT",ABMRT,ABMP("RPT-CAT")))+1
+9 ;tot cov'd days
+10 ;start old abm*2.6*15 HEAT183309 Req#B
+11 ;S:(ABMP("RPT-CAT")="IP SB DISCHGS") ^TMP($J,"ABM-MUFAC",ABMITYP,"IP SB DAYS")=+$G(^TMP($J,"ABM-MUFAC",ABMITYP,"IP SB DAYS"))+ABMCDAYS ;abm*2.6*12 swingbed
+12 ;S:(ABMP("RPT-CAT")="IP DISCHGS") ^TMP($J,"ABM-MUFAC",ABMITYP,"IP DAYS")=+$G(^TMP($J,"ABM-MUFAC",ABMITYP,"IP DAYS"))+ABMCDAYS
+13 ;S:(ABMP("RPT-CAT")="IP NB DISCHGS") ^TMP($J,"ABM-MUFAC",ABMITYP,"IP NB DAYS")=+$G(^TMP($J,"ABM-MUFAC",ABMITYP,"IP NB DAYS"))+ABMCDAYS ;abm*2.6*7
+14 ;;S:(ABMP("RPT-CAT")="IP CHGS") ^TMP($J,"ABM-MUFAC",ABMITYP,"IP CHGS DAYS")=+$G(^TMP($J,"ABM-MUFAC",ABMITYP,"IP CHG DAYS"))+ABMCDAYS ;abm*2.6*7
+15 ;S:(ABMP("RPT-CAT")="IP CHGS") ^TMP($J,"ABM-MUFAC",ABMITYP,"IP CHGS DAYS")=+$G(^TMP($J,"ABM-MUFAC",ABMITYP,"IP CHGS DAYS"))+ABMCDAYS ;abm*2.6*7
+16 ;end old start new HEAT183309 Req#B
+17 IF (ABMP("RPT-CAT")="IP SB DISCHGS")
SET ^TMP($JOB,"ABM-MUFAC",ABMITYP,ABMRT,"IP SB DAYS")=+$GET(^TMP($JOB,"ABM-MUFAC",ABMITYP,ABMRT,"IP SB DAYS"))+ABMCDAYS
+18 IF (ABMP("RPT-CAT")="IP DISCHGS")
Begin DoDot:1
+19 SET ^TMP($JOB,"ABM-MUFAC",ABMITYP,ABMRT,"IP DAYS")=+$GET(^TMP($JOB,"ABM-MUFAC",ABMITYP,ABMRT,"IP DAYS"))+ABMCDAYS
+20 ;S ^TMP($J,"ABM-MUFAC","GTOT",ABMRT,"IP DAYS")=+$G(^TMP($J,"ABM-MUFAC","GTOT",ABMRT,"IP DAYS"))+ABMCDAYS
End DoDot:1
+21 ;start new abm*2.6*20 IHS/SD/SDR HEAT256154
+22 IF (ABMP("RPT-CAT")="IP ANC DISCHGS")
Begin DoDot:1
+23 SET ^TMP($JOB,"ABM-MUFAC",ABMITYP,ABMRT,"IP ANC DAYS")=+$GET(^TMP($JOB,"ABM-MUFAC",ABMITYP,ABMRT,"IP ANC DAYS"))+ABMCDAYS
End DoDot:1
+24 ;end new abm*2.6*20 IHS/SD/SDR HEAT256154
+25 IF (ABMP("RPT-CAT")="IP NB DISCHGS")
Begin DoDot:1
+26 SET ^TMP($JOB,"ABM-MUFAC",ABMITYP,ABMRT,"IP NB DAYS")=+$GET(^TMP($JOB,"ABM-MUFAC",ABMITYP,ABMRT,"IP NB DAYS"))+ABMCDAYS
+27 ;S ^TMP($J,"ABM-MUFAC","GTOT",ABMRT,"IP NB DAYS")=+$G(^TMP($J,"ABM-MUFAC","GTOT",ABMRT,"IP NB DAYS"))+ABMCDAYS
End DoDot:1
+28 IF (ABMP("RPT-CAT")="IP CHGS")
Begin DoDot:1
+29 SET ^TMP($JOB,"ABM-MUFAC",ABMITYP,ABMRT,"IP CHGS DAYS")=+$GET(^TMP($JOB,"ABM-MUFAC",ABMITYP,ABMRT,"IP CHGS DAYS"))+ABMCDAYS
+30 ;S ^TMP($J,"ABM-MUFAC","GTOT",ABMRT,"IP CHGS DAYS")=+$G(^TMP($J,"ABM-MUFAC","GTOT",ABMRT,"IP CHGS DAYS"))+ABMCDAYS
End DoDot:1
+31 QUIT
DETREC ;EP
+1 ;exclude any DEMO,PATIENT
IF $$GET1^DIQ(2,ABMP("PDFN"),".01","E")["DEMO,PATIENT"
QUIT
+2 IF ABMITYP="PRI/MCD"
KILL ^TMP($JOB,"ABM-MUVLST",ABMP("PVDFN"))
+3 ;quit if this visit has already counted
IF $DATA(^TMP($JOB,"ABM-MUVLST",ABMP("PVDFN")))
QUIT
+4 ;add visit to list
SET ^TMP($JOB,"ABM-MUVLST",ABMP("PVDFN"))=""
+5 ;
+6 ;only include IP lines if option H was selected for rpt
IF ABMY("FACHOS")="H"&(ABMP("RPT-CAT")'["IP")
QUIT
+7 ;skip include Swingbed lines if option H was selected for rpt
IF ABMY("FACHOS")="H"&(ABMP("RPT-CAT")["SB")
QUIT
+8 ;S ABMP("INSN")=$P($G(^AUTNINS(ABMP("INS"),0)),U) ;abm*2.6*20 IHS/SD/SDR HEAT256154
+9 ;abm*2.6*20 IHS/SD/SDR HEAT256154
IF +ABMP("INS")'=0
SET ABMP("INSN")=$PIECE($GET(^AUTNINS(ABMP("INS"),0)),U)
+10 SET ABMREC=ABMDOSB_U_ABMDOSE_U_ABMBILLD_U_+$GET(ABMP("PD"))_U_ABMCDAYS_U_ABMNDAYS_U_ABMVLOC_U_DUZ(2)_U_ABMPBDFN
+11 ;I ABMY("FACHOS")="H" S ABMREC=ABMREC_U_ABMRT ;abm*2.6*20 IHS/SD/SDR HEAT256154
+12 ;abm*2.6*20 IHS/SD/SDR HEAT256154
IF ABMY("FACHOS")="H"
SET ABMREC=ABMREC_U_ABMRT_U_$GET(ABMP("BTYP"))_U_$GET(ABMP("VTYP"))_U_$GET(ABMITYPA)_U_ABMATYP
+13 SET ^TMP($JOB,"ABM-MUFAC","DETAIL",ABMITYP,ABMRT,ABMP("RPT-CAT"),ABMP("INSN")_"|"_ABMP("INS"),$SELECT(+$GET(ABMP("PVDFN")):ABMP("PVDFN"),1:ABMVDFN))=ABMREC
+14 QUIT
