ABMDESM1.m

ABMDESM1 ; IHS/SD/SDR - Display Summarized Claim Info ; 

 ;;2.6;IHS Third Party Billing;**1,6,8,11,13,14,23,27**;NOV 12, 2009;Build 486

 ;

 ; IHS/SD/SDR V2.5 P2 5/9/02 - NOIS HQW-0302-100190 Modified to display 2nd and 3rd modifiers and units

 ; IHS/SD/SDR v2.5 p5 5/18/04 Modified to put POS and TOS by line item

 ; IHS/SD/EFG V2.5 P8 IM16385 Added code for misc services if dental visit type

 ; IHS/SD/SDR V2.5 P8 IM10618/IM11164 Prompt/display provider

 ; IHS/SD/SDR v2.5 p8 task 6 Modified to check for ambulance services

 ; IHS/SD/SDR v2.5 p9 task 1 Use new service line provider multiple

 ; IHS/SD/SDR v2.5 p9 IM19707 Make sure ABMP("CLN") is defined before using

 ; IHS/SD/SDR v2.5 p10 IM19843 Added SERVICE TO DATE/TIME

 ; IHS/SD/SDR v2.5 p11 NPI

 ; IHS/SD/SDR v2.5 p12 IM25331 Made change to print Taxonomy if NPI ONLY

 ; IHS/SD/SDR,AML v2.5 p13 IM25899 Alignment changes

 ;

 ;IHS/SD/SDR v2.6 CSV

 ;IHS/SD/SDR 2.6*1 HEAT7884 display if visit type 731

 ;IHS/SD/SDR 2.6*6 HEAT28973 if 55 modifier present use '1' for units when calculating charges

 ;IHS/SD/SDR 2.6*6 NOHEAT Swing bed changes

 ;IHS/SD/SDR 2.6*13 Added check for new export mode 35

 ;IHS/SD/SDR 2.6*14 HEAT161263 Changed to use $$GET^DIQ so output transform will execute for SNOMED/Provider Narrative

 ;IHS/SD/AML 2.6*23 HEAT247169 Gather line items from 8D and 8H if visit type is 997

 ;IHS/SD/AML 2.6*27 CR8897 Added check if not Medi-Cal and not bill type 731 to be treated like flat rate

 ;

 K ABMS

 ;

 ; ABMS(revn)=Totl Charge^units^Unit Charge^CPT Code^Non-Cvd Amount

 ;

 S ABMS("TOT")=0,ABMS("I")=1

 G ITEM:'$D(ABMP("FLAT"))

 I $P(^ABMDEXP(ABMP("EXP"),0),U)'["UB",$P(ABMP("FLAT"),U,8) Q

 I $P(^ABMDEXP(ABMP("EXP"),0),U)["UB" D  G XIT

 .;S ABMX=$P($G(@(ABMP("GL")_"6)")),U,6)+$P($G(^(7)),U,3) S:$E(ABMP("BTYP"),2)'<3 ABMX=1  ;abm*2.6*1 HEAT7884

 .S ABMX=$P($G(@(ABMP("GL")_"6)")),U,6)  ;abm*2.6*1 HEAT7884

 .S ABMX=ABMX+$S((ABMP("VTYP")=999&(ABMP("BTYP")=731)&($P($G(^AUTNINS(ABMP("INS"),0)),U)["MONTANA MEDICAID")):$P($G(@(ABMP("GL")_"5)")),U,7),1:$P($G(@(ABMP("GL")_"7)")),U,3))  ;abm*2.6*1 HEAT7884

 .;S:($E(ABMP("BTYP"),2)'<3&'(ABMP("VTYP")=999&(ABMP("BTYP")=731)&($P($G(^AUTNINS(ABMP("INS"),0)),U)["MONTANA MEDICAID"))) ABMX=1  ;abm*2.6*1 HEAT7884  ;abm*2.6*6 Swing bed

 .;S:($E(ABMP("BTYP"),2)'<3&'(ABMP("VTYP")=999&(ABMP("BTYP")=731)&($P($G(^AUTNINS(ABMP("INS"),0)),U)["MONTANA MEDICAID"))&(ABMP("BTYP")'=181)) ABMX=1  ;abm*2.6*1 HEAT7884  ;abm*2.6*6 Swing bed  ;abm*2.6*27 IHS/SD/AML CR8897

 .S:(($$RCID^ABMUTLP(ABMP("INS"))'["61044"&(ABMP("BTYP")'=731))&$E(ABMP("BTYP"),2)'<3&'(ABMP("VTYP")=999&(ABMP("BTYP")=731)&($P($G(^AUTNINS(ABMP("INS"),0)),U)["MONTANA MEDICAID"))&(ABMP("BTYP")'=181)) ABMX=1  ;abm*2.6*27 IHS/SD/AML CR8897

 .S:ABMX=0 ABMX=1 S ABMS($P(ABMP("FLAT"),U,2))=$P(ABMP("FLAT"),U)*ABMX_U_ABMX_U_$P(ABMP("FLAT"),U)_U_U_($P($G(@(ABMP("GL")_"6)")),U,6)*$P(ABMP("FLAT"),U))

 .S ABMS("TOT")=+ABMS($P(ABMP("FLAT"),U,2)) G ^ABMDESMC:(ABMP("BTYP")=831)

 .I $D(ABMP("FLAT",170)) S ABMX=ABMP("FLAT",170),ABMS(170)=$P(ABMP("FLAT"),U)*ABMX_U_ABMX_U_$P(ABMP("FLAT"),U)_U_U_($P($G(@(ABMP("GL")_"6)")),U,6)*$P(ABMP("FLAT"),U)),ABMS("TOT")=ABMS("TOT")+ABMS(170)

 ; I flat rate HCFA ...

 I ($P(^ABMDEXP(ABMP("EXP"),0),U)["HCFA")!($P(^ABMDEXP(ABMP("EXP"),0),U)["CMS") D  G XIT

 .S (ABMS("TOT"),ABMS(1))=$P(ABMP("FLAT"),U)*$P(ABMP("FLAT"),U,3)

 .S ABMS(1)=ABMS(1)_U_$$HDT^ABMDUTL($P(@(ABMP("GL")_"7)"),U))_U_$$HDT^ABMDUTL($P(@(ABMP("GL")_"7)"),U,2))_U

 .S ABMS(1)=ABMS(1)_$P($G(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),0)),"^",16)

 .S ABMS(1)=ABMS(1)_U_U_$P(ABMP("FLAT"),U,3)_U_U_$P(ABMP("FLAT"),U,6)

 .I $$K24^ABMDFUTL D

 ..Q:'$G(ABMP("BDFN"))

 ..S ABMAPRV=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,"C","A",0))

 ..S ABMAPRV=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,ABMAPRV,0),U)

 ..S $P(ABMS(1),U,9)=$$K24N^ABMDFUTL(ABMAPRV)

 ..S $P(ABMS(ABMS("I")),U,11)=$P($$NPI^XUSNPI("Individual_ID",ABMAPRV),U)

 ..;Below line for South Dakota Urban (SD Urban)

 ..S ABMTLOC=$$GET1^DIQ(9999999.06,ABMP("LDFN"),.05,"E")  ;abm*2.6*8 NOHEAT

 ..I ((ABMTLOC["PIERRE URBAN")!(ABMTLOC["SOUTH DAKOTA URBAN"))&($P($G(^AUTNINS(ABMP("INS"),0)),U)="SOUTH DAKOTA MEDICAID") S $P(ABMS(ABMS("I")),U,11)=$P($$NPI^XUSNPI("Organization_ID",ABMP("LDFN")),U)  ;abm*2.6*8 NOHEAT

 ..I $G(ABMP("NPIS"))="N" S $P(ABMS(1),U,9)=$$PTAX^ABMEEPRV(ABMAPRV)

 I ABMP("PAGE")'[8 G XIT

ITEM ;itemized

 I ABMP("VTYP")=998 D ^ABMDESMD,^ABMDESMU,^ABMDESMX,^ABMDESML,^ABMDESMR,ER G XIT

 ;I ABMP("VTYP")=997 D ^ABMDESMR G XIT  ;abm*2.6*23 IHS/SD/AML HEAT247169

 I ABMP("VTYP")=997 D ^ABMDESMR,MISC^ABMDESMU G XIT  ;abm*2.6*23 IHS/SD/AML HEAT247169

 I ABMP("VTYP")=996 D ^ABMDESML G XIT

 I ABMP("VTYP")=995 D ^ABMDESMX G XIT

 I $G(ABMP("CLN"))'="",($P($G(^DIC(40.7,ABMP("CLN"),0)),U,2)="A3") D MISC^ABMDESMU,AMB^ABMDESMB G XIT

 D MS,^ABMDESMM,^ABMDESMX,^ABMDESML,^ABMDESMA,^ABMDESMD,^ABMDESMR,ER,ROO^ABMDESMU,MISC^ABMDESMU,REVN^ABMDESMU,SUP^ABMDESMU

 ;

 ;start new code abm*2.6*11 HEAT117086

 I (($G(ABMP("ITYPE"))="D")!($G(ABMP("ITYP"))="D")) D

 .S ABMIL=0

 .F  S ABMIL=$O(ABMS(ABMIL)) Q:'ABMIL  D

 ..I $P($G(ABMS(ABMIL)),U,4)'="T1015" Q

 ..S ABMTMP("TMP")=$G(ABMS(1))

 ..S ABMS(1)=$G(ABMS(ABMIL))

 ..S ABMS(ABMIL)=$G(ABMTMP("TMP"))

 K ABMIL,ABMTMP

 ;end new code HEAT117086

 ;

 G XIT

 ;

MS ;

 S ABMCAT=21 D PCK^ABMDESM1 Q:$G(ABMQUIT)

 S ABMX="""""" F ABMS("I")=ABMS("I"):1 S ABMX=$O(@(ABMP("GL")_"21,""C"","_ABMX_")")) Q:'ABMX  S ABMX("X")=$O(^(ABMX,"")) D MS1

 Q

 ;

MS1 S ABMX(0)=@(ABMP("GL")_"21,"_ABMX("X")_",0)"),ABMX(1)=$G(^(1))

 S ABMX("SUB")=$P(ABMX(0),"^",7)*$P(ABMX(0),"^",13)

 S:'+ABMX("SUB") ABMX("SUB")=$P(ABMX(0),U,7)

 I ($P(ABMX(0),U,9)=55!($P(ABMX(0),U,11)=55)!($P(ABMX(0),U,12)=55)) S ABMX("SUB")=$P(ABMX(0),U,7)  ;IHS/SD/SDR 2/15/11 HEAT28973

 S ABMX("R")=$P(ABMX(0),U,3)

 I +$P(ABMX(0),U,7)=0!(ABMX("R")=""&($P(^ABMDEXP(ABMP("EXP"),0),U)["UB")) S ABMS("I")=ABMS("I")-1 Q

MS2 S ABMS("TOT")=ABMS("TOT")+ABMX("SUB")

 I $P(^ABMDEXP(ABMP("EXP"),0),U)'["UB" G MSH

 I ABMX("R")="" S ABMS("I")=ABMS("I")-1 Q

MSU S ABMS(ABMX("R"))=+$G(ABMS(ABMX("R")))+ABMX("SUB")

 S:$P(ABMS(ABMX("R")),U,4)="" $P(ABMS(ABMX("R")),U,4)=$P(ABMX(0),U)

 Q

 ;

MSH S ABMS(ABMS("I"))=ABMX("SUB")

 S ABMS(ABMS("I"))=ABMS(ABMS("I"))_U_$$HDT^ABMDUTL($P(ABMX(0),U,5))

 S $P(ABMS(ABMS("I")),U,3)=$S($P(ABMX(0),U,19)'="":$$HDT^ABMDUTL($P(ABMX(0),U,19)),1:$P(ABMS(ABMS("I")),U,2))

 S ABMX("C")=$P(ABMX(0),U)

 D CPT

 S $P(ABMS(ABMS("I")),U,4)=ABMX("C")_$S($P(ABMX(0),U,9)]"":"-"_$P(ABMX(0),U,9),1:"")

 S $P(ABMS(ABMS("I")),U,4)=$P(ABMS(ABMS("I")),U,4)_$S($P(ABMX(0),U,11)]"":"-"_$P(ABMX(0),U,11),1:"")

 S $P(ABMS(ABMS("I")),U,4)=$P(ABMS(ABMS("I")),U,4)_$S($P(ABMX(0),U,12)]"":"-"_$P(ABMX(0),U,12),1:"")

 S $P(ABMS(ABMS("I")),U,4)=$P(ABMS(ABMS("I")),U,4)_$S($P(ABMX(1),U)]"":"-"_$P(ABMX(1),U),1:"")

 S $P(ABMS(ABMS("I")),U,4)=$P(ABMS(ABMS("I")),U,4)_$S($P(ABMX(1),U,2)]"":"-"_$P(ABMX(1),U,2),1:"")

 ;I ABMP("EXP")=27 D  ;abm*2.6*13 export mode 35

 I ABMP("EXP")=27!(ABMP("EXP")=35) D  ;abm*2.6*13 export mode 35

 .S $P(ABMS(ABMS("I")),U,4)=ABMX("C")_$S($P(ABMX(0),U,9)]"":"   "_$P(ABMX(0),U,9),1:"")

 .S $P(ABMS(ABMS("I")),U,4)=$P(ABMS(ABMS("I")),U,4)_$S($P(ABMX(0),U,11)]"":" "_$P(ABMX(0),U,11),1:"")

 .S $P(ABMS(ABMS("I")),U,4)=$P(ABMS(ABMS("I")),U,4)_$S($P(ABMX(0),U,12)]"":" "_$P(ABMX(0),U,12),1:"")

 .S $P(ABMS(ABMS("I")),U,4)=$P(ABMS(ABMS("I")),U,4)_$S($P(ABMX(1),U)]"":" "_$P(ABMX(1),U),1:"")

 .S $P(ABMS(ABMS("I")),U,4)=$P(ABMS(ABMS("I")),U,4)_$S($P(ABMX(1),U,2)]"":" "_$P(ABMX(1),U,2),1:"")

 S $P(ABMS(ABMS("I")),U,5)=$P(ABMX(0),U,4)

 S $P(ABMS(ABMS("I")),U,6)=$P(ABMX(0),U,13)

 I $P(ABMX(0),U,16) D

 .S $P(ABMS(ABMS("I")),U,7)=$P($G(^ABMDCODE($P(ABMX(0),U,16),0)),U)

 E  S $P(ABMS(ABMS("I")),U,7)=$S($P(^DIC(81.1,$P($$CPT^ABMCVAPI(+ABMX(0),ABMP("VDT")),U,4),0),U,3)=2:2,1:1)  ;CSV-c

 S $P(ABMS(ABMS("I")),U,10)=$P($G(ABMX(0)),U,15)  ;POS

 ;S $P(ABMS(ABMS("I")),U,8)=$P(^AUTNPOV($P(ABMX(0),U,6),0),U)  ;abm*2.6*14 HEAT161263

 S $P(ABMS(ABMS("I")),U,8)=$$GET1^DIQ(9999999.27,$P(ABMX(0),U,6),"01","E")  ;abm*2.6*14 HEAT161263

 S ABMX(0)=@(ABMP("GL")_"21,"_ABMX("X")_",0)")

 S ABMDPRV=$O(@(ABMP("GL")_"21,"_ABMX_",""P"",""C"",""R"",0)"))

 S:+ABMDPRV'=0 ABMDPRV=$P($G(@(ABMP("GL")_"21,"_ABMX_",""P"","_ABMDPRV_",0)")),U)

 I $G(ABMDPRV)="" S ABMDPRV=$$GETPRV^ABMDFUTL

 I +$G(ABMDPRV)'=0 D

 .Q:'$$K24^ABMDFUTL

 .S $P(ABMS(ABMS("I")),U,9)=$$K24N^ABMDFUTL(ABMDPRV)

 .S $P(ABMS(ABMS("I")),U,11)=$P($$NPI^XUSNPI("Individual_ID",ABMDPRV),U)

 .I $G(ABMP("NPIS"))="N" S $P(ABMS(ABMS("I")),U,9)=$$PTAX^ABMEEPRV(ABMDPRV)

 Q

 ;

ER ;

 S ABMX("ER")=+$P($G(@(ABMP("GL")_"8)")),U,10) I 'ABMX("ER") Q

 I $P(^ABMDEXP(ABMP("EXP"),0),U)["UB" S $P(ABMS(450),U)=$S($D(ABMS(450)):$P(ABMS(450),U)+ABMX("ER"),1:ABMX("ER")) G HER

 S ABMS(ABMS("I"))=ABMX("ER")

 S X=$S($P($G(@(ABMP("GL")_"6)")),U)]"":$P(@(ABMP("GL")_"6)"),U),1:$P($G(@(ABMP("GL")_"7)")),U))

 S $P(ABMS(ABMS("I")),U,2)=$$HDT^ABMDUTL(X)

 S $P(ABMS(ABMS("I")),U,3)=$P(ABMS(ABMS("I")),U,2)

 S $P(ABMS(ABMS("I")),U,8)="EMERGENCY ROOM CHARGE"

 S ABMS("I")=ABMS("I")+1

HER S ABMS("TOT")=ABMS("TOT")+ABMX("ER")

 Q

 ;

CPT S:ABMX("C") ABMX("C")=$P($$CPT^ABMCVAPI(ABMX("C"),ABMP("VDT")),U,2) Q  ;CSV-c

 ;

XIT K ABMX

 Q

 ;

HDT ;EP for date format

 S ABMDTF=$P($G(@(ABMP("GL")_"7)")),U)

 S ABMDTT=$P($G(@(ABMP("GL")_"7)")),U,2)

 I '$G(ABMCAT) D  Q

 .S $P(ABMS(ABMS("I")),U,2)=$$HDT^ABMDUTL(ABMDTF)

 .S $P(ABMS(ABMS("I")),U,3)=$$HDT^ABMDUTL(ABMDTT)

 I ABMCAT=21 D

 .Q:$P(ABMX(0),U,5)=""

 .S ABMDTF=$P(ABMX(0),U,5)

 .S ABMDTT=$S($P(ABMX(0),U,19)'="":$P(ABMX(0),U,19),1:$P(ABMX(0),U,5))

 I ABMCAT=23 D

 .Q:$P(ABMX(0),U,14)=""

 .S (ABMDTF,ABMDTT)=$P(ABMX(0),U,14)

 I ABMCAT=25 D

 .Q:$P(ABMX(0),U,4)=""

 .S (ABMDTF,ABMDTT)=$P(ABMX(0),U,4)

 I ABMCAT=27 D

 .Q:$P(ABMX(0),U,7)=""

 .S ABMDTF=$P(ABMX(0),U,7)

 .S ABMDTT=$S($P(ABMX(0),U,12)'="":$P(ABMX(0),U,12),1:$P(ABMX(0),U,7))

 I ABMCAT=33 D

 .Q:$P(ABMX(0),U,7)=""

 .S (ABMDTF,ABMDTT)=$P(ABMX(0),U,7)

 I ABMCAT=35 D

 .Q:$P(ABMX(0),U,9)=""

 .S ABMDTF=$P(ABMX(0),U,9)

 .S ABMDTT=$S($P(ABMX(0),U,12)'="":$P(ABMX(0),U,12),1:$P(ABMX(0),U,9))

 I ABMCAT=37 D

 .Q:$P(ABMX(0),U,5)=""

 .S ABMDTF=$P(ABMX(0),U,5)

 .S ABMDTT=$S($P(ABMX(0),U,12)'="":$P(ABMX(0),U,12),1:$P(ABMX(0),U,5))

 I ABMCAT=39 D

 .Q:'$P(ABMX(0),U,8)

 .S ABMDTT=$P(ABMX(0),U,8)

 .S ABMDTT=$P(ABMDTT,".",1)

 .S ABMDTF=$P(ABMX(0),U,7)

 .S ABMDTF=$P(ABMDTF,".")

 I ABMCAT=43 D

 .Q:$P(ABMX(0),U,7)=""

 .S ABMDTF=$P(ABMX(0),U,7)

 .S ABMDTT=$S($P(ABMX(0),U,12)'="":$P(ABMX(0),U,12),1:$P(ABMX(0),U,7))

 I ABMCAT=45 D

 .Q:$P(ABMX(0),U,2)=""

 .S (ABMDTF,ABMDTT)=$P(ABMX(0),U,2)

 I ABMCAT=47 D

 .Q:$P(ABMX(0),U,7)=""

 .S ABMDTF=$P(ABMX(0),U,7)

 .S ABMDTT=$S($P(ABMX(0),U,12)'="":$P(ABMX(0),U,12),1:$P(ABMX(0),U,7))

 S $P(ABMS(ABMS("I")),U,2)=$$HDT^ABMDUTL(ABMDTF)

 S $P(ABMS(ABMS("I")),U,3)=$$HDT^ABMDUTL(ABMDTT)

 K ABMDTF,ABMDTT,ABMPC,ABMCAT

 Q

PCK ;EP - PAGE CHECK

 K ABMQUIT

 Q:ABMP("GL")'["ABMDCLM"

 S ABMPC=$F("27^21^25^23^37^35^39^43^33^45^47",ABMCAT)/3

 S ABMEXM=$P($G(^ABMDCLM(DUZ(2),ABMP("CDFN"),70)),"^",ABMPC)

 S:ABMEXM="" ABMEXM=$P(^ABMDCLM(DUZ(2),ABMP("CDFN"),0),U,14)

 Q:ABMEXM=""

 S:ABMEXM'=ABMP("EXP") ABMQUIT=1

 K ABMEXM,ABMPC

 Q

ABMDESM1  ; IHS/SD/SDR - Display Summarized Claim Info ; 

 +1       ;;2.6;IHS Third Party Billing;**1,6,8,11,13,14,23,27**;NOV 12, 2009;Build 486

 +2       ;

 +3       ; IHS/SD/SDR V2.5 P2 5/9/02 - NOIS HQW-0302-100190 Modified to display 2nd and 3rd modifiers and units

 +4       ; IHS/SD/SDR v2.5 p5 5/18/04 Modified to put POS and TOS by line item

 +5       ; IHS/SD/EFG V2.5 P8 IM16385 Added code for misc services if dental visit type

 +6       ; IHS/SD/SDR V2.5 P8 IM10618/IM11164 Prompt/display provider

 +7       ; IHS/SD/SDR v2.5 p8 task 6 Modified to check for ambulance services

 +8       ; IHS/SD/SDR v2.5 p9 task 1 Use new service line provider multiple

 +9       ; IHS/SD/SDR v2.5 p9 IM19707 Make sure ABMP("CLN") is defined before using

 +10      ; IHS/SD/SDR v2.5 p10 IM19843 Added SERVICE TO DATE/TIME

 +11      ; IHS/SD/SDR v2.5 p11 NPI

 +12      ; IHS/SD/SDR v2.5 p12 IM25331 Made change to print Taxonomy if NPI ONLY

 +13      ; IHS/SD/SDR,AML v2.5 p13 IM25899 Alignment changes

 +14      ;

 +15      ;IHS/SD/SDR v2.6 CSV

 +16      ;IHS/SD/SDR 2.6*1 HEAT7884 display if visit type 731

 +17      ;IHS/SD/SDR 2.6*6 HEAT28973 if 55 modifier present use '1' for units when calculating charges

 +18      ;IHS/SD/SDR 2.6*6 NOHEAT Swing bed changes

 +19      ;IHS/SD/SDR 2.6*13 Added check for new export mode 35

 +20      ;IHS/SD/SDR 2.6*14 HEAT161263 Changed to use $$GET^DIQ so output transform will execute for SNOMED/Provider Narrative

 +21      ;IHS/SD/AML 2.6*23 HEAT247169 Gather line items from 8D and 8H if visit type is 997

 +22      ;IHS/SD/AML 2.6*27 CR8897 Added check if not Medi-Cal and not bill type 731 to be treated like flat rate

 +23      ;

 +24       KILL ABMS

 +25      ;

 +26      ; ABMS(revn)=Totl Charge^units^Unit Charge^CPT Code^Non-Cvd Amount

 +27      ;

 +28       SET ABMS("TOT")=0

           SET ABMS("I")=1

 +29       IF '$DATA(ABMP("FLAT"))

               GOTO ITEM

 +30       IF $PIECE(^ABMDEXP(ABMP("EXP"),0),U)'["UB"

               IF $PIECE(ABMP("FLAT"),U,8)

                   QUIT 

 +31       IF $PIECE(^ABMDEXP(ABMP("EXP"),0),U)["UB"

               Begin DoDot:1

 +32      ;S ABMX=$P($G(@(ABMP("GL")_"6)")),U,6)+$P($G(^(7)),U,3) S:$E(ABMP("BTYP"),2)'<3 ABMX=1  ;abm*2.6*1 HEAT7884

 +33      ;abm*2.6*1 HEAT7884

                   SET ABMX=$PIECE($GET(@(ABMP("GL")_"6)")),U,6)

 +34      ;abm*2.6*1 HEAT7884

                   SET ABMX=ABMX+$SELECT((ABMP("VTYP")=999&(ABMP("BTYP")=731)&($PIECE($GET(^AUTNINS(ABMP("INS"),0)),U)["MONTANA MEDICAID")):$PIECE($GET(@(ABMP("GL")_"5)")),U,7),1:$PIECE($GET(@(ABMP("GL")_"7)")),U,3))

 +35      ;S:($E(ABMP("BTYP"),2)'<3&'(ABMP("VTYP")=999&(ABMP("BTYP")=731)&($P($G(^AUTNINS(ABMP("INS"),0)),U)["MONTANA MEDICAID"))) ABMX=1  ;abm*2.6*1 HEAT7884  ;abm*2.6*6 Swing bed

 +36      ;S:($E(ABMP("BTYP"),2)'<3&'(ABMP("VTYP")=999&(ABMP("BTYP")=731)&($P($G(^AUTNINS(ABMP("INS"),0)),U)["MONTANA MEDICAID"))&(ABMP("BTYP")'=181)) ABMX=1  ;abm*2.6*1 HEAT7884  ;abm*2.6*6 Swing bed  ;abm*2.6*27 IHS/SD/AML CR8897

 +37      ;abm*2.6*27 IHS/SD/AML CR8897

                   IF (($$RCID^ABMUTLP(ABMP("INS"))'["61044"&(ABMP("BTYP")'=731))&$EXTRACT(ABMP("BTYP"),2)'<3&'(ABMP("VTYP")=999&(ABMP("BTYP")=731)&($PIECE($GET(^AUTNINS(ABMP("INS"),0)),U)["MONTANA MEDICAID"))&(ABMP("BTYP")'=181))

                       SET ABMX=1

 +38               IF ABMX=0

                       SET ABMX=1

                   SET ABMS($PIECE(ABMP("FLAT"),U,2))=$PIECE(ABMP("FLAT"),U)*ABMX_U_ABMX_U_$PIECE(ABMP("FLAT"),U)_U_U_($PIECE($GET(@(ABMP("GL")_"6)")),U,6)*$PIECE(ABMP("FLAT"),U))

 +39               SET ABMS("TOT")=+ABMS($PIECE(ABMP("FLAT"),U,2))

                   IF (ABMP("BTYP")=831)

                       GOTO ^ABMDESMC

 +40               IF $DATA(ABMP("FLAT",170))

                       SET ABMX=ABMP("FLAT",170)

                       SET ABMS(170)=$PIECE(ABMP("FLAT"),U)*ABMX_U_ABMX_U_$PIECE(ABMP("FLAT"),U)_U_U_($PIECE($GET(@(ABMP("GL")_"6)")),U,6)*$PIECE(ABMP("FLAT"),U))

                       SET ABMS("TOT")=ABMS("TOT")+ABMS(170)

               End DoDot:1

               GOTO XIT

 +41      ; I flat rate HCFA ...

 +42       IF ($PIECE(^ABMDEXP(ABMP("EXP"),0),U)["HCFA")!($PIECE(^ABMDEXP(ABMP("EXP"),0),U)["CMS")

               Begin DoDot:1

 +43               SET (ABMS("TOT"),ABMS(1))=$PIECE(ABMP("FLAT"),U)*$PIECE(ABMP("FLAT"),U,3)

 +44               SET ABMS(1)=ABMS(1)_U_$$HDT^ABMDUTL($PIECE(@(ABMP("GL")_"7)"),U))_U_$$HDT^ABMDUTL($PIECE(@(ABMP("GL")_"7)"),U,2))_U

 +45               SET ABMS(1)=ABMS(1)_$PIECE($GET(^ABMNINS(DUZ(2),ABMP("INS"),1,ABMP("VTYP"),0)),"^",16)

 +46               SET ABMS(1)=ABMS(1)_U_U_$PIECE(ABMP("FLAT"),U,3)_U_U_$PIECE(ABMP("FLAT"),U,6)

 +47               IF $$K24^ABMDFUTL

                       Begin DoDot:2

 +48                       IF '$GET(ABMP("BDFN"))

                               QUIT 

 +49                       SET ABMAPRV=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,"C","A",0))

 +50                       SET ABMAPRV=$PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,ABMAPRV,0),U)

 +51                       SET $PIECE(ABMS(1),U,9)=$$K24N^ABMDFUTL(ABMAPRV)

 +52                       SET $PIECE(ABMS(ABMS("I")),U,11)=$PIECE($$NPI^XUSNPI("Individual_ID",ABMAPRV),U)

 +53      ;Below line for South Dakota Urban (SD Urban)

 +54      ;abm*2.6*8 NOHEAT

                           SET ABMTLOC=$$GET1^DIQ(9999999.06,ABMP("LDFN"),.05,"E")

 +55      ;abm*2.6*8 NOHEAT

                           IF ((ABMTLOC["PIERRE URBAN")!(ABMTLOC["SOUTH DAKOTA URBAN"))&($PIECE($GET(^AUTNINS(ABMP("INS"),0)),U)="SOUTH DAKOTA MEDICAID")

                               SET $PIECE(ABMS(ABMS("I")),U,11)=$PIECE($$NPI^XUSNPI("Organization_ID",ABMP("LDFN")),U)

 +56                       IF $GET(ABMP("NPIS"))="N"

                               SET $PIECE(ABMS(1),U,9)=$$PTAX^ABMEEPRV(ABMAPRV)

                       End DoDot:2

               End DoDot:1

               GOTO XIT

 +57       IF ABMP("PAGE")'[8

               GOTO XIT

ITEM      ;itemized

 +1        IF ABMP("VTYP")=998

               DO ^ABMDESMD

               DO ^ABMDESMU

               DO ^ABMDESMX

               DO ^ABMDESML

               DO ^ABMDESMR

               DO ER

               GOTO XIT

 +2       ;I ABMP("VTYP")=997 D ^ABMDESMR G XIT  ;abm*2.6*23 IHS/SD/AML HEAT247169

 +3       ;abm*2.6*23 IHS/SD/AML HEAT247169

           IF ABMP("VTYP")=997

               DO ^ABMDESMR

               DO MISC^ABMDESMU

               GOTO XIT

 +4        IF ABMP("VTYP")=996

               DO ^ABMDESML

               GOTO XIT

 +5        IF ABMP("VTYP")=995

               DO ^ABMDESMX

               GOTO XIT

 +6        IF $GET(ABMP("CLN"))'=""

               IF ($PIECE($GET(^DIC(40.7,ABMP("CLN"),0)),U,2)="A3")

                   DO MISC^ABMDESMU

                   DO AMB^ABMDESMB

                   GOTO XIT

 +7        DO MS

           DO ^ABMDESMM

           DO ^ABMDESMX

           DO ^ABMDESML

           DO ^ABMDESMA

           DO ^ABMDESMD

           DO ^ABMDESMR

           DO ER

           DO ROO^ABMDESMU

           DO MISC^ABMDESMU

           DO REVN^ABMDESMU

           DO SUP^ABMDESMU

 +8       ;

 +9       ;start new code abm*2.6*11 HEAT117086

 +10       IF (($GET(ABMP("ITYPE"))="D")!($GET(ABMP("ITYP"))="D"))

               Begin DoDot:1

 +11               SET ABMIL=0

 +12               FOR 

                       SET ABMIL=$ORDER(ABMS(ABMIL))

                       IF 'ABMIL

                           QUIT 

                       Begin DoDot:2

 +13                       IF $PIECE($GET(ABMS(ABMIL)),U,4)'="T1015"

                               QUIT 

 +14                       SET ABMTMP("TMP")=$GET(ABMS(1))

 +15                       SET ABMS(1)=$GET(ABMS(ABMIL))

 +16                       SET ABMS(ABMIL)=$GET(ABMTMP("TMP"))

                       End DoDot:2

               End DoDot:1

 +17       KILL ABMIL,ABMTMP

 +18      ;end new code HEAT117086

 +19      ;

 +20       GOTO XIT

 +21      ;

MS        ;

 +1        SET ABMCAT=21

           DO PCK^ABMDESM1

           IF $GET(ABMQUIT)

               QUIT 

 +2        SET ABMX=""""""

           FOR ABMS("I")=ABMS("I"):1

               SET ABMX=$ORDER(@(ABMP("GL")_"21,""C"","_ABMX_")"))

               IF 'ABMX

                   QUIT 

               SET ABMX("X")=$ORDER(^(ABMX,""))

               DO MS1

 +3        QUIT 

 +4       ;

MS1        SET ABMX(0)=@(ABMP("GL")_"21,"_ABMX("X")_",0)")

           SET ABMX(1)=$GET(^(1))

 +1        SET ABMX("SUB")=$PIECE(ABMX(0),"^",7)*$PIECE(ABMX(0),"^",13)

 +2        IF '+ABMX("SUB")

               SET ABMX("SUB")=$PIECE(ABMX(0),U,7)

 +3       ;IHS/SD/SDR 2/15/11 HEAT28973

           IF ($PIECE(ABMX(0),U,9)=55!($PIECE(ABMX(0),U,11)=55)!($PIECE(ABMX(0),U,12)=55))

               SET ABMX("SUB")=$PIECE(ABMX(0),U,7)

 +4        SET ABMX("R")=$PIECE(ABMX(0),U,3)

 +5        IF +$PIECE(ABMX(0),U,7)=0!(ABMX("R")=""&($PIECE(^ABMDEXP(ABMP("EXP"),0),U)["UB"))

               SET ABMS("I")=ABMS("I")-1

               QUIT 

MS2        SET ABMS("TOT")=ABMS("TOT")+ABMX("SUB")

 +1        IF $PIECE(^ABMDEXP(ABMP("EXP"),0),U)'["UB"

               GOTO MSH

 +2        IF ABMX("R")=""

               SET ABMS("I")=ABMS("I")-1

               QUIT 

MSU        SET ABMS(ABMX("R"))=+$GET(ABMS(ABMX("R")))+ABMX("SUB")

 +1        IF $PIECE(ABMS(ABMX("R")),U,4)=""

               SET $PIECE(ABMS(ABMX("R")),U,4)=$PIECE(ABMX(0),U)

 +2        QUIT 

 +3       ;

MSH        SET ABMS(ABMS("I"))=ABMX("SUB")

 +1        SET ABMS(ABMS("I"))=ABMS(ABMS("I"))_U_$$HDT^ABMDUTL($PIECE(ABMX(0),U,5))

 +2        SET $PIECE(ABMS(ABMS("I")),U,3)=$SELECT($PIECE(ABMX(0),U,19)'="":$$HDT^ABMDUTL($PIECE(ABMX(0),U,19)),1:$PIECE(ABMS(ABMS("I")),U,2))

 +3        SET ABMX("C")=$PIECE(ABMX(0),U)

 +4        DO CPT

 +5        SET $PIECE(ABMS(ABMS("I")),U,4)=ABMX("C")_$SELECT($PIECE(ABMX(0),U,9)]"":"-"_$PIECE(ABMX(0),U,9),1:"")

 +6        SET $PIECE(ABMS(ABMS("I")),U,4)=$PIECE(ABMS(ABMS("I")),U,4)_$SELECT($PIECE(ABMX(0),U,11)]"":"-"_$PIECE(ABMX(0),U,11),1:"")

 +7        SET $PIECE(ABMS(ABMS("I")),U,4)=$PIECE(ABMS(ABMS("I")),U,4)_$SELECT($PIECE(ABMX(0),U,12)]"":"-"_$PIECE(ABMX(0),U,12),1:"")

 +8        SET $PIECE(ABMS(ABMS("I")),U,4)=$PIECE(ABMS(ABMS("I")),U,4)_$SELECT($PIECE(ABMX(1),U)]"":"-"_$PIECE(ABMX(1),U),1:"")

 +9        SET $PIECE(ABMS(ABMS("I")),U,4)=$PIECE(ABMS(ABMS("I")),U,4)_$SELECT($PIECE(ABMX(1),U,2)]"":"-"_$PIECE(ABMX(1),U,2),1:"")

 +10      ;I ABMP("EXP")=27 D  ;abm*2.6*13 export mode 35

 +11      ;abm*2.6*13 export mode 35

           IF ABMP("EXP")=27!(ABMP("EXP")=35)

               Begin DoDot:1

 +12               SET $PIECE(ABMS(ABMS("I")),U,4)=ABMX("C")_$SELECT($PIECE(ABMX(0),U,9)]"":"   "_$PIECE(ABMX(0),U,9),1:"")

 +13               SET $PIECE(ABMS(ABMS("I")),U,4)=$PIECE(ABMS(ABMS("I")),U,4)_$SELECT($PIECE(ABMX(0),U,11)]"":" "_$PIECE(ABMX(0),U,11),1:"")

 +14               SET $PIECE(ABMS(ABMS("I")),U,4)=$PIECE(ABMS(ABMS("I")),U,4)_$SELECT($PIECE(ABMX(0),U,12)]"":" "_$PIECE(ABMX(0),U,12),1:"")

 +15               SET $PIECE(ABMS(ABMS("I")),U,4)=$PIECE(ABMS(ABMS("I")),U,4)_$SELECT($PIECE(ABMX(1),U)]"":" "_$PIECE(ABMX(1),U),1:"")

 +16               SET $PIECE(ABMS(ABMS("I")),U,4)=$PIECE(ABMS(ABMS("I")),U,4)_$SELECT($PIECE(ABMX(1),U,2)]"":" "_$PIECE(ABMX(1),U,2),1:"")

               End DoDot:1

 +17       SET $PIECE(ABMS(ABMS("I")),U,5)=$PIECE(ABMX(0),U,4)

 +18       SET $PIECE(ABMS(ABMS("I")),U,6)=$PIECE(ABMX(0),U,13)

 +19       IF $PIECE(ABMX(0),U,16)

               Begin DoDot:1

 +20               SET $PIECE(ABMS(ABMS("I")),U,7)=$PIECE($GET(^ABMDCODE($PIECE(ABMX(0),U,16),0)),U)

               End DoDot:1

 +21      ;CSV-c

          IF '$TEST

               SET $PIECE(ABMS(ABMS("I")),U,7)=$SELECT($PIECE(^DIC(81.1,$PIECE($$CPT^ABMCVAPI(+ABMX(0),ABMP("VDT")),U,4),0),U,3)=2:2,1:1)