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)
+22 ;POS
SET $PIECE(ABMS(ABMS("I")),U,10)=$PIECE($GET(ABMX(0)),U,15)
+23 ;S $P(ABMS(ABMS("I")),U,8)=$P(^AUTNPOV($P(ABMX(0),U,6),0),U) ;abm*2.6*14 HEAT161263
+24 ;abm*2.6*14 HEAT161263
SET $PIECE(ABMS(ABMS("I")),U,8)=$$GET1^DIQ(9999999.27,$PIECE(ABMX(0),U,6),"01","E")
+25 SET ABMX(0)=@(ABMP("GL")_"21,"_ABMX("X")_",0)")
+26 SET ABMDPRV=$ORDER(@(ABMP("GL")_"21,"_ABMX_",""P"",""C"",""R"",0)"))
+27 IF +ABMDPRV'=0
SET ABMDPRV=$PIECE($GET(@(ABMP("GL")_"21,"_ABMX_",""P"","_ABMDPRV_",0)")),U)
+28 IF $GET(ABMDPRV)=""
SET ABMDPRV=$$GETPRV^ABMDFUTL
+29 IF +$GET(ABMDPRV)'=0
Begin DoDot:1
+30 IF '$$K24^ABMDFUTL
QUIT
+31 SET $PIECE(ABMS(ABMS("I")),U,9)=$$K24N^ABMDFUTL(ABMDPRV)
+32 SET $PIECE(ABMS(ABMS("I")),U,11)=$PIECE($$NPI^XUSNPI("Individual_ID",ABMDPRV),U)
+33 IF $GET(ABMP("NPIS"))="N"
SET $PIECE(ABMS(ABMS("I")),U,9)=$$PTAX^ABMEEPRV(ABMDPRV)
End DoDot:1
+34 QUIT
+35 ;
ER ;
+1 SET ABMX("ER")=+$PIECE($GET(@(ABMP("GL")_"8)")),U,10)
IF 'ABMX("ER")
QUIT
+2 IF $PIECE(^ABMDEXP(ABMP("EXP"),0),U)["UB"
SET $PIECE(ABMS(450),U)=$SELECT($DATA(ABMS(450)):$PIECE(ABMS(450),U)+ABMX("ER"),1:ABMX("ER"))
GOTO HER
+3 SET ABMS(ABMS("I"))=ABMX("ER")
+4 SET X=$SELECT($PIECE($GET(@(ABMP("GL")_"6)")),U)]"":$PIECE(@(ABMP("GL")_"6)"),U),1:$PIECE($GET(@(ABMP("GL")_"7)")),U))
+5 SET $PIECE(ABMS(ABMS("I")),U,2)=$$HDT^ABMDUTL(X)
+6 SET $PIECE(ABMS(ABMS("I")),U,3)=$PIECE(ABMS(ABMS("I")),U,2)
+7 SET $PIECE(ABMS(ABMS("I")),U,8)="EMERGENCY ROOM CHARGE"
+8 SET ABMS("I")=ABMS("I")+1
HER SET ABMS("TOT")=ABMS("TOT")+ABMX("ER")
+1 QUIT
+2 ;
CPT ;CSV-c
IF ABMX("C")
SET ABMX("C")=$PIECE($$CPT^ABMCVAPI(ABMX("C"),ABMP("VDT")),U,2)
QUIT
+1 ;
XIT KILL ABMX
+1 QUIT
+2 ;
HDT ;EP for date format
+1 SET ABMDTF=$PIECE($GET(@(ABMP("GL")_"7)")),U)
+2 SET ABMDTT=$PIECE($GET(@(ABMP("GL")_"7)")),U,2)
+3 IF '$GET(ABMCAT)
Begin DoDot:1
+4 SET $PIECE(ABMS(ABMS("I")),U,2)=$$HDT^ABMDUTL(ABMDTF)
+5 SET $PIECE(ABMS(ABMS("I")),U,3)=$$HDT^ABMDUTL(ABMDTT)
End DoDot:1
QUIT
+6 IF ABMCAT=21
Begin DoDot:1
+7 IF $PIECE(ABMX(0),U,5)=""
QUIT
+8 SET ABMDTF=$PIECE(ABMX(0),U,5)
+9 SET ABMDTT=$SELECT($PIECE(ABMX(0),U,19)'="":$PIECE(ABMX(0),U,19),1:$PIECE(ABMX(0),U,5))
End DoDot:1
+10 IF ABMCAT=23
Begin DoDot:1
+11 IF $PIECE(ABMX(0),U,14)=""
QUIT
+12 SET (ABMDTF,ABMDTT)=$PIECE(ABMX(0),U,14)
End DoDot:1
+13 IF ABMCAT=25
Begin DoDot:1
+14 IF $PIECE(ABMX(0),U,4)=""
QUIT
+15 SET (ABMDTF,ABMDTT)=$PIECE(ABMX(0),U,4)
End DoDot:1
+16 IF ABMCAT=27
Begin DoDot:1
+17 IF $PIECE(ABMX(0),U,7)=""
QUIT
+18 SET ABMDTF=$PIECE(ABMX(0),U,7)
+19 SET ABMDTT=$SELECT($PIECE(ABMX(0),U,12)'="":$PIECE(ABMX(0),U,12),1:$PIECE(ABMX(0),U,7))
End DoDot:1
+20 IF ABMCAT=33
Begin DoDot:1
+21 IF $PIECE(ABMX(0),U,7)=""
QUIT
+22 SET (ABMDTF,ABMDTT)=$PIECE(ABMX(0),U,7)
End DoDot:1
+23 IF ABMCAT=35
Begin DoDot:1
+24 IF $PIECE(ABMX(0),U,9)=""
QUIT
+25 SET ABMDTF=$PIECE(ABMX(0),U,9)
+26 SET ABMDTT=$SELECT($PIECE(ABMX(0),U,12)'="":$PIECE(ABMX(0),U,12),1:$PIECE(ABMX(0),U,9))
End DoDot:1
+27 IF ABMCAT=37
Begin DoDot:1
+28 IF $PIECE(ABMX(0),U,5)=""
QUIT
+29 SET ABMDTF=$PIECE(ABMX(0),U,5)
+30 SET ABMDTT=$SELECT($PIECE(ABMX(0),U,12)'="":$PIECE(ABMX(0),U,12),1:$PIECE(ABMX(0),U,5))
End DoDot:1
+31 IF ABMCAT=39
Begin DoDot:1
+32 IF '$PIECE(ABMX(0),U,8)
QUIT
+33 SET ABMDTT=$PIECE(ABMX(0),U,8)
+34 SET ABMDTT=$PIECE(ABMDTT,".",1)
+35 SET ABMDTF=$PIECE(ABMX(0),U,7)
+36 SET ABMDTF=$PIECE(ABMDTF,".")
End DoDot:1
+37 IF ABMCAT=43
Begin DoDot:1
+38 IF $PIECE(ABMX(0),U,7)=""
QUIT
+39 SET ABMDTF=$PIECE(ABMX(0),U,7)
+40 SET ABMDTT=$SELECT($PIECE(ABMX(0),U,12)'="":$PIECE(ABMX(0),U,12),1:$PIECE(ABMX(0),U,7))
End DoDot:1
+41 IF ABMCAT=45
Begin DoDot:1
+42 IF $PIECE(ABMX(0),U,2)=""
QUIT
+43 SET (ABMDTF,ABMDTT)=$PIECE(ABMX(0),U,2)
End DoDot:1
+44 IF ABMCAT=47
Begin DoDot:1
+45 IF $PIECE(ABMX(0),U,7)=""
QUIT
+46 SET ABMDTF=$PIECE(ABMX(0),U,7)
+47 SET ABMDTT=$SELECT($PIECE(ABMX(0),U,12)'="":$PIECE(ABMX(0),U,12),1:$PIECE(ABMX(0),U,7))
End DoDot:1
+48 SET $PIECE(ABMS(ABMS("I")),U,2)=$$HDT^ABMDUTL(ABMDTF)
+49 SET $PIECE(ABMS(ABMS("I")),U,3)=$$HDT^ABMDUTL(ABMDTT)
+50 KILL ABMDTF,ABMDTT,ABMPC,ABMCAT
+51 QUIT
PCK ;EP - PAGE CHECK
+1 KILL ABMQUIT
+2 IF ABMP("GL")'["ABMDCLM"
QUIT
+3 SET ABMPC=$FIND("27^21^25^23^37^35^39^43^33^45^47",ABMCAT)/3
+4 SET ABMEXM=$PIECE($GET(^ABMDCLM(DUZ(2),ABMP("CDFN"),70)),"^",ABMPC)
+5 IF ABMEXM=""
SET ABMEXM=$PIECE(^ABMDCLM(DUZ(2),ABMP("CDFN"),0),U,14)
+6 IF ABMEXM=""
QUIT
+7 IF ABMEXM'=ABMP("EXP")
SET ABMQUIT=1
+8 KILL ABMEXM,ABMPC
+9 QUIT
