ABMMUFC3 ;IHS/SD/SDR - EHR Incentive Report (MU) ;
;;2.6;IHS 3P BILLING SYSTEM;**15,20**;NOV 12, 2009;Build 317
;IHS/SD/SDR - 2.6*15 - HEAT183309 - split routine due to size
;IHS/SD/SDR - 2.6*15 - HEAT207910 - made change to fix <SUBSCR>CLAIMS+64^ABMMUFC3; occurs when there isn't an active
; insurer on the claim.
;IHS/SD/SDR - 2.6*20 - HEAT256154 - Fixed paid bug. Paid amount from previous bill was being used because variable wasn't being set to 0.
; Also fixed where service category from visit but other info from Parent visit were being used together, causing wrong visit to show up
; on report. Added check for newborn with bed days >2 to report in adult and ped bed days. Added code to get Kidscare info so it can
; determine if Kidscare is Medicaid or PI to determine title XIX or XXI.
;
PREV ;
S ABMP("PD")=0,ABMPYD=0
D SETVAR^ABMPPAD1
S ABMPHRN=$P($G(^AUPNPAT(ABMP("PDFN"),41,DUZ(2),0)),U,2)
S ABMBSUF=$P($G(^ABMDPARM(ABMP("LDFN"),1,2)),U,4)
;loop thru active bills
S ABMBNUM=$P($G(^ABMDBILL(DUZ(2),ABMPBDFN,0)),U)
;get trans for bills
S ABMHOLD=DUZ(2)
S ABMSAT=ABMP("LDFN") ;Satellite = 3P Visit loc
S DUZ(2)=ABMPAR
S ABMBNUM=$O(^BARBL(DUZ(2),"B",ABMBNUM))
S ABMAIEN=$O(^BARBL(DUZ(2),"B",ABMBNUM,0))
I +$G(ABMAIEN)=0 S:+$G(ABMHOLD)'=0 DUZ(2)=ABMHOLD K ABMHOLD Q ;there isn't an A/R bill w/this number
S ABMTRIEN=0,ABMLN=1
F S ABMTRIEN=$O(^BARTR(DUZ(2),"AC",ABMAIEN,ABMTRIEN)) Q:ABMTRIEN="" D
.S ABMREC=$G(^BARTR(DUZ(2),ABMTRIEN,0))
.I $G(ABMOPDT)="" S ABMOPDT=$P($P(ABMREC,U),".")
.Q:+$P(ABMREC,U,2)=0&(+$P(ABMREC,U,3)=0)
.S ABMBINS=$P(ABMREC,U,6)
.I +$G(ABMBINS)=0 S ABMBINS=$P($G(^BARBL(DUZ(2),ABMAIEN,0)),U,3) ;abm*2.6*7
.S ABMBINS=+$P($G(^BARAC(DUZ(2),ABMBINS,0)),U)
.S ABMTTYP=$P($G(^BARTR(DUZ(2),ABMTRIEN,1)),U,1)
.S ABMADJC=$P($G(^BARTR(DUZ(2),ABMTRIEN,1)),U,2)
.S ABMCAT=""
.I ABMTTYP=40 S ABMCAT="P"
.;treat a pymt credit w/credit amt like a pymt
.I (ABMTTYP=43),(ABMADJC=20),(+$P($G(^BARTR(DUZ(2),ABMTRIEN,0)),U,2)'=0) S ABMCAT="P"
.Q:ABMCAT=""
.S ABMP("PD")=+$G(ABMP("PD"))+$$GET1^DIQ(90050.03,ABMTRIEN,3.5,"E"),ABMPYD=+$G(ABMPYD)+1
I +$G(ABMHOLD)'=0 S DUZ(2)=ABMHOLD K ABMHOLD
Q
CLAIMS ;EP
S ABMPBDFN=0 ;abm2.6*15 to stop bill number from carrying over to other visits
S ABMP("PD")=0 ;abm*2.6*20 IHS/SD/SDR HEAT256154
S ABMPSDT=ABMP("SDT")-10000
F S ABMPSDT=$O(^ABMDCLM(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("CDFN")=0
.F S ABMP("CDFN")=$O(^ABMDCLM(DUZ(2),"AD",ABMPSDT,ABMP("CDFN"))) Q:'ABMP("CDFN") D Q:ABMPFLG=1
..S ABMVDFN=0
..F S ABMVDFN=$O(^ABMDCLM(DUZ(2),ABMP("CDFN"),11,ABMVDFN)) Q:'ABMVDFN D Q:ABMPFLG=1
...I $D(^TMP($J,"ABM-MUVLST",ABMVDFN)) Q ;visit already counted ;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))
....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 ABMPCDFN=0
...S ABMPFLG=0 ;pymt flg
...K ABMB
...F ABMC=1:1 S ABMPCDFN=$O(^ABMDCLM(DUZ(2),"AV",ABMP("PVDFN"),ABMPCDFN)) Q:'ABMPCDFN D Q:ABMPFLG=1
....;S ABMP("BTYP")=$P($G(^ABMDCLM(DUZ(2),ABMPCDFN,0)),U,2) ;bill type ;abm*2.6*20 IHS/SD/SDR HEAT256154
....S ABMP("BTYP")=$P($G(^ABMDCLM(DUZ(2),ABMPCDFN,0)),U,12) ;bill type ;abm*2.6*20 IHS/SD/SDR HEAT256154
....S ABMP("VTYP")=$P($G(^ABMDCLM(DUZ(2),ABMPCDFN,0)),U,7) ;visit type
....I +$P($G(^ABMDCLM(DUZ(2),ABMPCDFN,0)),U,8)=0 Q ;no active insurer on claim - skip abm*2.6*15 HEAT207910
....I $P($G(^ABMDCLM(DUZ(2),ABMPCDFN,0)),U,4)="X" Q ;skip cancelled claims
....S ABMB(ABMP("VTYP"),ABMP("BTYP"),ABMC)=ABMPCDFN
...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 ABMPCDFN=$G(ABMB(ABMP("VTYP"),ABMP("BTYP"),ABMC))
......S ABM=ABMPCDFN
......S ABMP("PDFN")=$P($G(^ABMDCLM(DUZ(2),ABMPCDFN,0)),U)
......Q:$$GET1^DIQ(2,ABMP("PDFN"),".01","E")["DEMO,PATIENT" ;exclude any DEMO,PATIENT
......S ABMP("INS")=$P($G(^ABMDCLM(DUZ(2),ABMPCDFN,0)),U,8)
......I $$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMP("INS"),".211","I"),1,"I")="K" D GETCINS^ABMMUFC3 ;abm*2.6*20 IHS/SD/SDR HEAT256154
......S ABMP("LDFN")=$P($G(^ABMDCLM(DUZ(2),ABMPCDFN,0)),U,3)
......S ABMP("VDT")=$P($G(^ABMDCLM(DUZ(2),ABMPCDFN,7)),U)
......S ABMP("NEWBORN")=0 ;abm*2.6*7
......I $$GET1^DIQ(9002274.03,$P($G(^ABMDCLM(DUZ(2),ABMPCDFN,5)),U),.03,"E")="NEWBORN" S ABMP("NEWBORN")=1
......S ABMATYP=$$GET1^DIQ(9002274.03,$P($G(^ABMDCLM(DUZ(2),ABMPCDFN,5)),U),.03,"E") ;abm*2.6*20 IHS/SD/SDR HEAT256154
.....S ABMIT=$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMP("INS"),".211","I"),1,"I")
.....D INSTYP^ABMMUFC1
.....S ABMP("INS")=$P($G(^ABMDCLM(DUZ(2),ABMPCDFN,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(^ABMDCLM(DUZ(2),ABMPCDFN,7)),U,3)
.....S:'ABMCDAYS ABMCDAYS=$P($G(^ABMDCLM(DUZ(2),ABMPCDFN,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
.....S ABMDOSB=$P($G(^ABMDCLM(DUZ(2),ABMPCDFN,7)),U)
.....S ABMDOSE=$P($G(^ABMDCLM(DUZ(2),ABMPCDFN,7)),U,2)
.....S ABMBILLD=+$P($G(^ABMDCLM(DUZ(2),ABMPCDFN,2)),U)
.....S ABMVLOC=$$GET1^DIQ(9002274.3,ABMPCDFN,".03","E")
.....S ABMNDAYS=+$P($G(^ABMDCLM(DUZ(2),ABMPCDFN,6)),U,6)
.....;start old abm*2.6*20 IHS/SD/SDR HEAT256154
.....;S ABMCDAYS=+$P($G(^ABMDCLM(DUZ(2),ABMPCDFN,7)),U,3)
.....;S:'ABMCDAYS ABMCDAYS=$P($G(^ABMDCLM(DUZ(2),ABMPCDFN,6)),U,9)
.....;S:'ABMCDAYS ABMCDAYS=1
.....;end old abm*2.6*20 IHS/SD/SDR HEAT256154
.....S ABMRT="NOTBLD"
.....;start old abm*2.6*20 IHS/SD/SDR HEAT256154
.....;I "^S^B^"[("^"_ABMSUMDT_"^") D SUMMREC^ABMMUFC1
.....;I "^D^B^"[("^"_ABMSUMDT_"^") D DETREC^ABMMUFC1
.....;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(^ABMDCLM(DUZ(2),ABMPCDFN,13,ABMI)) Q:'ABMI D
......S ABMJ=$P($G(^ABMDCLM(DUZ(2),ABMPCDFN,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(^ABMDCLM(DUZ(2),ABMPCDFN,13,ABMI,0)),U,6)'="",ABMIT="P" S ABMDF=1
......I $P($G(^ABMDCLM(DUZ(2),ABMPCDFN,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^ABMMUFC1
.....I "^D^B^"[("^"_ABMSUMDT_"^") D DETREC^ABMMUFC1
.....;end new abm*2.6*20 IHS/SD/SDR HEAT256154
Q
GETBINS ;EP
S ABMI=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)'=ABMP("INS") Q ;not the active insurer
.I +$P($G(^ABMDBILL(DUZ(2),ABMPBDFN,13,ABMI,0)),U,7)'=0 S ABMIT2="D"
.I +$P($G(^ABMDBILL(DUZ(2),ABMPBDFN,13,ABMI,0)),U,8)'=0 S ABMIT2="P"
Q
;start new abm*2.6*20 IHS/SD/SDR HEAT256154
GETCINS ;EP
S ABMI=0
F S ABMI=$O(^ABMDCLM(DUZ(2),ABMPCDFN,13,ABMI)) Q:'ABMI D
.I $P($G(^ABMDCLM(DUZ(2),ABMPCDFN,13,ABMI,0)),U)'=ABMP("INS") Q ;not the active insurer
.I +$P($G(^ABMDCLM(DUZ(2),ABMPCDFN,13,ABMI,0)),U,7)'=0 S ABMIT2="D"
.I +$P($G(^ABMDCLM(DUZ(2),ABMPCDFN,13,ABMI,0)),U,8)'=0 S ABMIT2="P"
Q
;end new abm*2.6*20 IHS/SD/SDR HEAT256154
ABMMUFC3 ;IHS/SD/SDR - EHR Incentive Report (MU) ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;**15,20**;NOV 12, 2009;Build 317
+2 ;IHS/SD/SDR - 2.6*15 - HEAT183309 - split routine due to size
+3 ;IHS/SD/SDR - 2.6*15 - HEAT207910 - made change to fix <SUBSCR>CLAIMS+64^ABMMUFC3; occurs when there isn't an active
+4 ; insurer on the claim.
+5 ;IHS/SD/SDR - 2.6*20 - HEAT256154 - Fixed paid bug. Paid amount from previous bill was being used because variable wasn't being set to 0.
+6 ; Also fixed where service category from visit but other info from Parent visit were being used together, causing wrong visit to show up
+7 ; on report. Added check for newborn with bed days >2 to report in adult and ped bed days. Added code to get Kidscare info so it can
+8 ; determine if Kidscare is Medicaid or PI to determine title XIX or XXI.
+9 ;
PREV ;
+1 SET ABMP("PD")=0
SET ABMPYD=0
+2 DO SETVAR^ABMPPAD1
+3 SET ABMPHRN=$PIECE($GET(^AUPNPAT(ABMP("PDFN"),41,DUZ(2),0)),U,2)
+4 SET ABMBSUF=$PIECE($GET(^ABMDPARM(ABMP("LDFN"),1,2)),U,4)
+5 ;loop thru active bills
+6 SET ABMBNUM=$PIECE($GET(^ABMDBILL(DUZ(2),ABMPBDFN,0)),U)
+7 ;get trans for bills
+8 SET ABMHOLD=DUZ(2)
+9 ;Satellite = 3P Visit loc
SET ABMSAT=ABMP("LDFN")
+10 SET DUZ(2)=ABMPAR
+11 SET ABMBNUM=$ORDER(^BARBL(DUZ(2),"B",ABMBNUM))
+12 SET ABMAIEN=$ORDER(^BARBL(DUZ(2),"B",ABMBNUM,0))
+13 ;there isn't an A/R bill w/this number
IF +$GET(ABMAIEN)=0
IF +$GET(ABMHOLD)'=0
SET DUZ(2)=ABMHOLD
KILL ABMHOLD
QUIT
+14 SET ABMTRIEN=0
SET ABMLN=1
+15 FOR
SET ABMTRIEN=$ORDER(^BARTR(DUZ(2),"AC",ABMAIEN,ABMTRIEN))
IF ABMTRIEN=""
QUIT
Begin DoDot:1
+16 SET ABMREC=$GET(^BARTR(DUZ(2),ABMTRIEN,0))
+17 IF $GET(ABMOPDT)=""
SET ABMOPDT=$PIECE($PIECE(ABMREC,U),".")
+18 IF +$PIECE(ABMREC,U,2)=0&(+$PIECE(ABMREC,U,3)=0)
QUIT
+19 SET ABMBINS=$PIECE(ABMREC,U,6)
+20 ;abm*2.6*7
IF +$GET(ABMBINS)=0
SET ABMBINS=$PIECE($GET(^BARBL(DUZ(2),ABMAIEN,0)),U,3)
+21 SET ABMBINS=+$PIECE($GET(^BARAC(DUZ(2),ABMBINS,0)),U)
+22 SET ABMTTYP=$PIECE($GET(^BARTR(DUZ(2),ABMTRIEN,1)),U,1)
+23 SET ABMADJC=$PIECE($GET(^BARTR(DUZ(2),ABMTRIEN,1)),U,2)
+24 SET ABMCAT=""
+25 IF ABMTTYP=40
SET ABMCAT="P"
+26 ;treat a pymt credit w/credit amt like a pymt
+27 IF (ABMTTYP=43)
IF (ABMADJC=20)
IF (+$PIECE($GET(^BARTR(DUZ(2),ABMTRIEN,0)),U,2)'=0)
SET ABMCAT="P"
+28 IF ABMCAT=""
QUIT
+29 SET ABMP("PD")=+$GET(ABMP("PD"))+$$GET1^DIQ(90050.03,ABMTRIEN,3.5,"E")
SET ABMPYD=+$GET(ABMPYD)+1
End DoDot:1
+30 IF +$GET(ABMHOLD)'=0
SET DUZ(2)=ABMHOLD
KILL ABMHOLD
+31 QUIT
CLAIMS ;EP
+1 ;abm2.6*15 to stop bill number from carrying over to other visits
SET ABMPBDFN=0
+2 ;abm*2.6*20 IHS/SD/SDR HEAT256154
SET ABMP("PD")=0
+3 SET ABMPSDT=ABMP("SDT")-10000
+4 ;loop thru service date from x-ref
FOR
SET ABMPSDT=$ORDER(^ABMDCLM(DUZ(2),"AD",ABMPSDT))
IF 'ABMPSDT
QUIT
Begin DoDot:1
+5 ;abm*2.6*15 HEAT183309 Req#B
SET ABMPFLG=0
+6 SET ABMP("CDFN")=0
+7 FOR
SET ABMP("CDFN")=$ORDER(^ABMDCLM(DUZ(2),"AD",ABMPSDT,ABMP("CDFN")))
IF 'ABMP("CDFN")
QUIT
Begin DoDot:2
+8 SET ABMVDFN=0
+9 FOR
SET ABMVDFN=$ORDER(^ABMDCLM(DUZ(2),ABMP("CDFN"),11,ABMVDFN))
IF 'ABMVDFN
QUIT
Begin DoDot:3
+10 ;visit already counted ;abm*2.6*15
IF $DATA(^TMP($JOB,"ABM-MUVLST",ABMVDFN))
QUIT
+11 ;deleted visit
IF $PIECE($GET(^AUPNVSIT(ABMVDFN,0)),U,11)=1
QUIT
+12 ;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)
+13 ;S ABMSC=$P($G(^AUPNVSIT(ABMVDFN,0)),U,7) ;service category ;abm*2.6*20 IHS/SD/SDR HEAT256154
+14 ;service category ;abm*2.6*20 IHS/SD/SDR HEAT256154
SET ABMSC=$PIECE($GET(^AUPNVSIT(ABMP("PVDFN"),0)),U,7)
+15 ;ignore all other service categories
IF "HIASRO"'[ABMSC
QUIT
+16 ;H=Hosp
+17 ;I=In Hosp
+18 ;A=Amb
+19 ;S=Day Surg
+20 ;R=Nurs Home
+21 ;O=Observ
+22 ;parent visit link; default to visit if there isn't one
+23 ;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
+24 ;if not Hospitalization, use Visit/Admit Date&Time
+25 ;seen before start date
IF ABMSC'="H"
IF ($PIECE($GET(^AUPNVSIT(ABMP("PVDFN"),0)),U)<ABMP("SDT"))
QUIT
+26 ;seen after end date
IF ABMSC'="H"
IF ($PIECE($GET(^AUPNVSIT(ABMP("PVDFN"),0)),U)>ABMP("EDT"))
QUIT
+27 ;if Hospitalization, get Date of Discharge from V Hospitalization file
+28 SET ABMQFLG=1
+29 IF ABMSC="H"
Begin DoDot:4
+30 SET ABMP("VHIEN")=+$ORDER(^AUPNVINP("AD",ABMP("PVDFN"),0))
+31 IF ABMP("VHIEN")=0
SET ABMQFLG=0
QUIT
+32 SET ABMP("DISCHDT")=$PIECE($GET(^AUPNVINP(ABMP("VHIEN"),0)),U)
+33 ;seen before start date
IF ABMP("DISCHDT")<ABMP("SDT")
SET ABMQFLG=0
QUIT
+34 ;seen after end date
IF ABMP("DISCHDT")>ABMP("EDT")
SET ABMQFLG=0
QUIT
+35 ;start new abm*2.6*12 swingbed
+36 SET ABMP("SWINGBED")=0
+37 IF $$GET1^DIQ(45.7,$$GET1^DIQ(9000010.02,ABMP("VHIEN"),".04","I"),"9999999.01","E")=21
SET ABMP("SWINGBED")=1
+38 IF $$GET1^DIQ(45.7,$$GET1^DIQ(9000010.02,ABMP("VHIEN"),".05","I"),"9999999.01","E")=21
SET ABMP("SWINGBED")=1
+39 ;end new swingbed
End DoDot:4
IF ABMQFLG=0
QUIT
+40 SET ABMPCDFN=0
+41 ;pymt flg
SET ABMPFLG=0
+42 KILL ABMB
+43 FOR ABMC=1:1
SET ABMPCDFN=$ORDER(^ABMDCLM(DUZ(2),"AV",ABMP("PVDFN"),ABMPCDFN))
IF 'ABMPCDFN
QUIT
Begin DoDot:4
+44 ;S ABMP("BTYP")=$P($G(^ABMDCLM(DUZ(2),ABMPCDFN,0)),U,2) ;bill type ;abm*2.6*20 IHS/SD/SDR HEAT256154
+45 ;bill type ;abm*2.6*20 IHS/SD/SDR HEAT256154
SET ABMP("BTYP")=$PIECE($GET(^ABMDCLM(DUZ(2),ABMPCDFN,0)),U,12)
+46 ;visit type
SET ABMP("VTYP")=$PIECE($GET(^ABMDCLM(DUZ(2),ABMPCDFN,0)),U,7)
+47 ;no active insurer on claim - skip abm*2.6*15 HEAT207910
IF +$PIECE($GET(^ABMDCLM(DUZ(2),ABMPCDFN,0)),U,8)=0
QUIT
+48 ;skip cancelled claims
IF $PIECE($GET(^ABMDCLM(DUZ(2),ABMPCDFN,0)),U,4)="X"
QUIT
+49 SET ABMB(ABMP("VTYP"),ABMP("BTYP"),ABMC)=ABMPCDFN
End DoDot:4
IF ABMPFLG=1
QUIT
+50 SET ABMP("VTYP")=0
+51 FOR
SET ABMP("VTYP")=$ORDER(ABMB(ABMP("VTYP")))
IF 'ABMP("VTYP")
QUIT
Begin DoDot:4
+52 SET ABMP("BTYP")=0
+53 FOR
SET ABMP("BTYP")=$ORDER(ABMB(ABMP("VTYP"),ABMP("BTYP")))
IF 'ABMP("BTYP")
QUIT
Begin DoDot:5
+54 SET ABMC=0
+55 FOR
SET ABMC=$ORDER(ABMB(ABMP("VTYP"),ABMP("BTYP"),ABMC))
IF 'ABMC
QUIT
Begin DoDot:6
+56 SET ABMPCDFN=$GET(ABMB(ABMP("VTYP"),ABMP("BTYP"),ABMC))
+57 SET ABM=ABMPCDFN
+58 SET ABMP("PDFN")=$PIECE($GET(^ABMDCLM(DUZ(2),ABMPCDFN,0)),U)
+59 ;exclude any DEMO,PATIENT
IF $$GET1^DIQ(2,ABMP("PDFN"),".01","E")["DEMO,PATIENT"
QUIT
+60 SET ABMP("INS")=$PIECE($GET(^ABMDCLM(DUZ(2),ABMPCDFN,0)),U,8)
+61 ;abm*2.6*20 IHS/SD/SDR HEAT256154
IF $$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMP("INS"),".211","I"),1,"I")="K"
DO GETCINS^ABMMUFC3
+62 SET ABMP("LDFN")=$PIECE($GET(^ABMDCLM(DUZ(2),ABMPCDFN,0)),U,3)
+63 SET ABMP("VDT")=$PIECE($GET(^ABMDCLM(DUZ(2),ABMPCDFN,7)),U)
+64 ;abm*2.6*7
SET ABMP("NEWBORN")=0
+65 IF $$GET1^DIQ(9002274.03,$PIECE($GET(^ABMDCLM(DUZ(2),ABMPCDFN,5)),U),.03,"E")="NEWBORN"
SET ABMP("NEWBORN")=1
+66 ;abm*2.6*20 IHS/SD/SDR HEAT256154
SET ABMATYP=$$GET1^DIQ(9002274.03,$PIECE($GET(^ABMDCLM(DUZ(2),ABMPCDFN,5)),U),.03,"E")
End DoDot:6
IF ABMPFLG=1
QUIT
+67 SET ABMIT=$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMP("INS"),".211","I"),1,"I")
+68 DO INSTYP^ABMMUFC1
+69 SET ABMP("INS")=$PIECE($GET(^ABMDCLM(DUZ(2),ABMPCDFN,0)),U,8)
+70 SET ABMP("FSDT")=0
SET ABMFFLG=0
+71 FOR
SET ABMP("FSDT")=$ORDER(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),11,ABMP("FSDT")))
IF 'ABMP("FSDT")
QUIT
Begin DoDot:6
+72 IF $PIECE($GET(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),11,ABMP("FSDT"),0)),U)>ABMP("EDT")
QUIT
+73 IF $PIECE($GET(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),11,ABMP("FSDT"),0)),U,2)>ABMP("SDT")
QUIT
+74 SET ABMFFLG=1
End DoDot:6
IF ABMFFLG=1
QUIT
+75 ;start new abm*2.6*20 IHS/SD/SDR HEAT256154
+76 SET ABMCDAYS=+$PIECE($GET(^ABMDCLM(DUZ(2),ABMPCDFN,7)),U,3)
+77 IF 'ABMCDAYS
SET ABMCDAYS=$PIECE($GET(^ABMDCLM(DUZ(2),ABMPCDFN,6)),U,9)
+78 IF 'ABMCDAYS
SET ABMCDAYS=1
+79 ;commented out below line in abm*2.6*20 IHS/SD/SDR; Harrell Little said it didn't apply, that newborn is always newborn
+80 ;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
+81 ;end new abm*2.6*20 IHS/SD/SDR HEAT256154
+82 DO SETCAT^ABMMUFAC
+83 ;Q:$D(^TMP($J,"ABM-MUVLST",ABMP("PVDFN"))) ;quit if this visit has already counted
+84 ;S ^TMP($J,"ABM-MUVLST",ABMP("PVDFN"))="" ;add visit to list
+85 SET ABMDOSB=$PIECE($GET(^ABMDCLM(DUZ(2),ABMPCDFN,7)),U)
+86 SET ABMDOSE=$PIECE($GET(^ABMDCLM(DUZ(2),ABMPCDFN,7)),U,2)
+87 SET ABMBILLD=+$PIECE($GET(^ABMDCLM(DUZ(2),ABMPCDFN,2)),U)
+88 SET ABMVLOC=$$GET1^DIQ(9002274.3,ABMPCDFN,".03","E")
+89 SET ABMNDAYS=+$PIECE($GET(^ABMDCLM(DUZ(2),ABMPCDFN,6)),U,6)
+90 ;start old abm*2.6*20 IHS/SD/SDR HEAT256154
+91 ;S ABMCDAYS=+$P($G(^ABMDCLM(DUZ(2),ABMPCDFN,7)),U,3)
+92 ;S:'ABMCDAYS ABMCDAYS=$P($G(^ABMDCLM(DUZ(2),ABMPCDFN,6)),U,9)
+93 ;S:'ABMCDAYS ABMCDAYS=1
+94 ;end old abm*2.6*20 IHS/SD/SDR HEAT256154
+95 SET ABMRT="NOTBLD"
+96 ;start old abm*2.6*20 IHS/SD/SDR HEAT256154
+97 ;I "^S^B^"[("^"_ABMSUMDT_"^") D SUMMREC^ABMMUFC1
+98 ;I "^D^B^"[("^"_ABMSUMDT_"^") D DETREC^ABMMUFC1
+99 ;end old start new abm*2.6*20 IHS/SD/SDR HEAT256154
+100 ;this looks at other insurers on the bill and tries to determine if they are a PI/MCD or MCR/MCD bill;
+101 ;puts these into separate categories.
+102 SET ABMI=0
SET ABMDF=0
SET ABMITYPA=""
+103 FOR
SET ABMI=$ORDER(^ABMDCLM(DUZ(2),ABMPCDFN,13,ABMI))
IF 'ABMI
QUIT
Begin DoDot:6
+104 SET ABMJ=$PIECE($GET(^ABMDCLM(DUZ(2),ABMPCDFN,13,ABMI,0)),U)
+105 IF ABMITYPA'=""
SET ABMITYPA=ABMITYPA_"~"_$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,+ABMJ,".211","I"),1,"I")
+106 IF ABMITYPA=""
SET ABMITYPA=$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,+ABMJ,".211","I"),1,"I")
+107 IF $PIECE($GET(^ABMDCLM(DUZ(2),ABMPCDFN,13,ABMI,0)),U,6)'=""
IF ABMIT="P"
SET ABMDF=1
+108 IF $PIECE($GET(^ABMDCLM(DUZ(2),ABMPCDFN,13,ABMI,0)),U,6)'=""
IF ABMIT="R"
SET ABMDF=2
End DoDot:6
+109 IF ABMDF=1
SET ABMITYP="PRI/MCD"
+110 IF ABMDF=2
SET ABMITYP="MCR/MCD"
+111 ;
+112 IF "^S^B^"[("^"_ABMSUMDT_"^")
DO SUMMREC^ABMMUFC1
+113 IF "^D^B^"[("^"_ABMSUMDT_"^")
DO DETREC^ABMMUFC1
+114 ;end new abm*2.6*20 IHS/SD/SDR HEAT256154
End DoDot:5
IF ABMPFLG=1
QUIT
End DoDot:4
IF ABMPFLG=1
QUIT
End DoDot:3
IF ABMPFLG=1
QUIT
End DoDot:2
IF ABMPFLG=1
QUIT
End DoDot:1
+115 QUIT
GETBINS ;EP
+1 SET ABMI=0
+2 FOR
SET ABMI=$ORDER(^ABMDBILL(DUZ(2),ABMPBDFN,13,ABMI))
IF 'ABMI
QUIT
Begin DoDot:1
+3 ;not the active insurer
IF $PIECE($GET(^ABMDBILL(DUZ(2),ABMPBDFN,13,ABMI,0)),U)'=ABMP("INS")
QUIT
+4 IF +$PIECE($GET(^ABMDBILL(DUZ(2),ABMPBDFN,13,ABMI,0)),U,7)'=0
SET ABMIT2="D"
+5 IF +$PIECE($GET(^ABMDBILL(DUZ(2),ABMPBDFN,13,ABMI,0)),U,8)'=0
SET ABMIT2="P"
End DoDot:1
+6 QUIT
+7 ;start new abm*2.6*20 IHS/SD/SDR HEAT256154
GETCINS ;EP
+1 SET ABMI=0
+2 FOR
SET ABMI=$ORDER(^ABMDCLM(DUZ(2),ABMPCDFN,13,ABMI))
IF 'ABMI
QUIT
Begin DoDot:1
+3 ;not the active insurer
IF $PIECE($GET(^ABMDCLM(DUZ(2),ABMPCDFN,13,ABMI,0)),U)'=ABMP("INS")
QUIT
+4 IF +$PIECE($GET(^ABMDCLM(DUZ(2),ABMPCDFN,13,ABMI,0)),U,7)'=0
SET ABMIT2="D"
+5 IF +$PIECE($GET(^ABMDCLM(DUZ(2),ABMPCDFN,13,ABMI,0)),U,8)'=0
SET ABMIT2="P"
End DoDot:1
+6 QUIT
+7 ;end new abm*2.6*20 IHS/SD/SDR HEAT256154
