Routine: ABMMUFC3

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

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

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"

 ;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"

 ;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

ABMMUFC3.m