ABMUTLP2 ; IHS/SD/SDR - PAYER UTILITIES ;
;;2.6;IHS 3P BILLING SYSTEM;**10,11,21**;NOV 12, 2009;Build 379
;abm*2.6*10 - split from ABMUTLP
;IHS/SD/AML - 2.6*21 HEAT178693 - Made change for electronic VA billing
;IHS/SD/SDR - 2.6*21 HEAT107645 - Made change to put MC (Medicaid) or CI (Private) for Kidscare.
;
SOP ;EP - source of pay (claim filing indicator)
S ABMTYP=$P($G(^AUTNINS(+ABMP("INS",ABMI),2)),U,11)
I ABMTYP D Q
.S ABMP("SOP",ABMI)=$P(^AUTTCFI(ABMTYP,0),U)
S ABMTYP=$P(ABMP("INS",ABMI),"^",2)
;S Y=$F("HMDRPWCFNIK",ABMTYP) ;abm*2.6*8 5010
;S Y=$F("HMDRPWCFIK",ABMTYP) ;abm*2.6*8 5010 ;abm*2.6*10 HEAT69121
;S ABMP("SOP",ABMI)=$P("^HM^SP^MC^MA^CI^WC^CH^ZZ^09^OF^MC","^",Y) ;abm*2.6*8 5010
;S ABMP("SOP",ABMI)=$P("^HM^SP^MC^MA^CI^WC^CH^ZZ^OF^MC","^",Y) ;abm*2.6*8 5010 ;abm*2.6*10 HEAT69121
;start new code abm*2.6*10 HEAT69121
I ABMTYP="H" S ABMP("SOP",ABMI)="HM"
I ABMTYP="M" S ABMP("SOP",ABMI)="SP"
I ABMTYP="D" S ABMP("SOP",ABMI)="MC"
I ABMTYP="R" S ABMP("SOP",ABMI)="MA"
I ABMTYP="P" S ABMP("SOP",ABMI)="CI"
I ABMTYP="W" S ABMP("SOP",ABMI)="WC"
I ABMTYP="C" S ABMP("SOP",ABMI)="CH"
I ABMTYP="F" S ABMP("SOP",ABMI)="ZZ"
I ABMTYP="I"!(ABMTYP="MD") S ABMP("SOP",ABMI)="OF"
;I ABMTYP="K" S ABMP("SOP",ABMI)="MC" ;abm*2.6*21 IHS/SD/SDR HEAT107645
I ABMTYP="K",($$GET1^DIQ(9999999.18,+ABMP("INS",ABMI),".38","I")="P") S ABMP("SOP",ABMI)="CI" ;abm*2.6*21 IHS/SD/SDR HEAT107645
I ABMTYP="K",($$GET1^DIQ(9999999.18,+ABMP("INS",ABMI),".38","I")'="P") S ABMP("SOP",ABMI)="MC" ;abm*2.6*21 IHS/SD/SDR HEAT107645
I ABMTYP="MH" S ABMP("SOP",ABMI)="16"
;end new code HEAT69121
I ABMTYP="V" S ABMP("SOP",ABMI)="VA" ;abm*2.6*21 IHS/SD/AML 8/21/14 - HEAT178693
I $$BCBS1^ABMERUTL(+ABMP("INS",ABMI)) D
.S ABMP("SOP",ABMI)="BL"
;I ABMP("SOP",ABMI)="MA",(ABMP("VTYP")=999!($P($G(^ABMDPARM(DUZ(2),1,5)),U,3)="C00900"))!((ABMP("BTYP")=831)&(ABMP("EXP")=22)) D ;abm*2.6*11 HEAT96809
I $G(ABMP("SOP",ABMI))="MA",(ABMP("VTYP")=999!($P($G(^ABMDPARM(DUZ(2),1,5)),U,3)="C00900"))!((ABMP("BTYP")=831)&(ABMP("EXP")=22)) D ;abm*2.6*11 HEAT96809
.S ABMP("SOP",ABMI)="MB"
;I ABMP("SOP",ABMI)="MA",(ABMP("VTYP")=999!($P($G(^ABMDPARM(DUZ(2),1,5)),U,3)="04402"))!((ABMP("BTYP")=831)&(ABMP("EXP")=22)) D ;abm*2.6*10 NOHEAT
;I ABMP("SOP",ABMI)="MA",(ABMP("VTYP")=999!($P($G(^ABMDPARM(DUZ(2),1,5)),U,3)="04402"))!((ABMP("BTYP")=831)&((ABMP("EXP")=22)!(ABMP("EXP")=32))) D ;abm*2.6*10 NOHEAT ;abm*2.6*10 HEAT68447
;I ABMP("SOP",ABMI)="MA",(ABMP("VTYP")=999!($P($G(^ABMDPARM(ABMP("LDFN"),1,5)),U,3)="04402"))!((ABMP("BTYP")=831)&((ABMP("EXP")=22)!(ABMP("EXP")=32))) D ;abm*2.6*10 NOHEAT ;abm*2.6*10 HEAT68447 ;abm*2.6*10 HEAT74059
;I ABMP("SOP",ABMI)="MA",(ABMP("VTYP")=999!(("^04312^04212^04112^04412^04402^")[("^"_$P($G(^ABMDPARM(ABMP("LDFN"),1,5)),U,3)_"^")))!((ABMP("BTYP")=831)&((ABMP("EXP")=22)!(ABMP("EXP")=32))) D ;abm*2.6*10 NOHEAT HEAT68447 HEAT74059 ;abm*2.6*11 HEAT96809
I $G(ABMP("SOP",ABMI))="MA",(ABMP("VTYP")=999!(("^04312^04212^04112^04412^04402^")[("^"_$P($G(^ABMDPARM(ABMP("LDFN"),1,5)),U,3)_"^")))!((ABMP("BTYP")=831)&((ABMP("EXP")=22)!(ABMP("EXP")=32))) D ;abm*2.6*11 HEAT96809
.S ABMP("SOP",ABMI)="MB"
Q
OVER ;EP - get override values from 3P Ins file
;S ABMOEXP=$S(ABMP("EXP")=21:11,ABMP("EXP")=22:14,ABMP("EXP")=23:18,1:0) ;abm*2.6*10 HEAT65683
S ABMOEXP=$S(ABMP("EXP")=21!(ABMP("EXP")=31):11,ABMP("EXP")=22!(ABMP("EXP")=32):14,ABMP("EXP")=23!(ABMP("EXP")=33):18,1:0) ;abm*2.6*10 HEAT65683
Q:ABMOEXP=0
S ABMOPC=0
;F S ABMOPC=$O(^ABMNINS(DUZ(2),ABMP("INS"),2,"AOVR",ABMOEXP,ABMOLN,ABMOPC)) Q:'ABMOPC D ;abm*2.6*10 HEAT53137
F S ABMOPC=$O(^ABMNINS(ABMP("LDFN"),ABMP("INS"),2,"AOVR",ABMOEXP,ABMOLN,ABMOPC)) Q:'ABMOPC D ;abm*2.6*10 HEAT53137
.K ABMOVTYP
.;start old code abm*2.6*10 HEAT53137
.;I $D(^ABMNINS(DUZ(2),ABMP("INS"),2,"AOVR",ABMOEXP,ABMOLN,ABMOPC,0)) S ABMOVTYP=0
.;I $D(^ABMNINS(DUZ(2),ABMP("INS"),2,"AOVR",ABMOEXP,ABMOLN,ABMOPC,ABMP("VTYP"))) S ABMOVTYP=ABMP("VTYP")
.;end old code start new code HEAT53137
.I $D(^ABMNINS(ABMP("LDFN"),ABMP("INS"),2,"AOVR",ABMOEXP,ABMOLN,ABMOPC,0)) S ABMOVTYP=0
.I $D(^ABMNINS(ABMP("LDFN"),ABMP("INS"),2,"AOVR",ABMOEXP,ABMOLN,ABMOPC,ABMP("VTYP"))) S ABMOVTYP=ABMP("VTYP")
.;end new code HEAT53137
.Q:'$D(ABMOVTYP)
.S ABMVALUE=^ABMNINS(DUZ(2),ABMP("INS"),2,"AOVR",ABMOEXP,ABMOLN,ABMOPC,ABMOVTYP)
.;
.I ABMOLN=51 S ABMOLN=40,ABMPC=4 D Q
..S $P(ABMR("NM1",ABMOLN),"^",ABMPC)=ABMVALUE
..S $P(ABMREC("NM1"),"*",ABMPC)=ABMVALUE
.;
.I ABMOLN=52 S ABMOLN=20,ABMPC=2 D Q
..S $P(ABMR("N3",ABMOLN),"^",ABMPC)=ABMVALUE
..S $P(ABMREC("N3"),"*",ABMPC)=ABMVALUE
.;
.I ABMOLN=53 D Q
..S ABMR("N4",20)=$P(ABMVALUE,",") ;city
..S $P(ABMREC("N4"),"*",2)=ABMR("N4",20)
..S ABMR("N4",30)=$P($P(ABMVALUE,", ",2)," ") ;state
..S $P(ABMREC("N4"),"*",3)=ABMR("N4",30)
..S ABMR("N4",40)=$P($P(ABMVALUE,",",2)," ",2) ;zip
..S $P(ABMREC("N4"),"*",4)=ABMR("N4",40)
;
K ABMOLN,ABMOPC,ABMVALUE,ABMOVTYP
Q
PAYED ; EP ;abm*2.6*19 IHS/SD/SDR HEAT168248 - split from ABMUTLP
; Build Ins Pymt Array
K ABMP("PAYED")
S (ABMOACNT,ABMPRCNT)=1
S ABMCOCNT=1
S:'$G(ABMDUZ2) ABMDUZ2=DUZ(2)
N L
S L=+$P(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),0),U)_" " ;Bill#
F S L=$O(^ABMDBILL(ABMDUZ2,"B",L)) Q:+L'=+$P(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),0),U)!(L="") D
.N I
.S I=$O(^ABMDBILL(ABMDUZ2,"B",L,0)) ;IEN
.Q:$P(^ABMDBILL(ABMDUZ2,I,0),U,4)="X" ;Quit if cancelled
.N K
.S K=$P(^ABMDBILL(ABMDUZ2,I,0),U,8) ;Active ins IEN
.N J
.S J=0
.F S J=$O(^ABMDBILL(ABMDUZ2,I,3,J)) Q:'J D
..N ABMPAY
..K ABMSAR ;abm*2.6*10 COB billing
..S ABMPAY=+$P(^ABMDBILL(ABMDUZ2,I,3,J,0),U,2) ;Amt paid
..S ABMP("PAYED",K)=+$G(ABMP("PAYED",K))+ABMPAY ;Add amt paid per ins
..S $P(ABMP("PAYED",K),"^",2)=$P(^ABMDBILL(ABMDUZ2,I,3,J,0),U)
..S ABMP("PAYED")=+$G(ABMP("PAYED"))+ABMPAY ;Add amt paid
..S ABMADJC=$P($G(^ABMDBILL(ABMDUZ2,I,3,J,0)),U,15) ;adj category
..I $P($G(^ABMNINS(ABMP("LDFN"),K,0)),U,11)="Y" S ABMADJC=4,ABMSAR=96 ;abm*2.6*3 HEAT7574
..Q:(ABMADJC="") ;no adj cat
..I ABMADJC=14 S ABMAMT=+$P($G(^ABMDBILL(ABMDUZ2,I,3,J,0)),U,4) ;co-ins
..I ABMADJC=13 S ABMAMT=+$P($G(^ABMDBILL(ABMDUZ2,I,3,J,0)),U,3) ;deduct
..I ABMADJC=3 S ABMAMT=+$P($G(^ABMDBILL(ABMDUZ2,I,3,J,0)),U,6) ;w-off
..I ABMADJC=4 S ABMAMT=+$P($G(^ABMDBILL(ABMDUZ2,I,3,J,0)),U,7) ;non-cov
..I ABMADJC=15 S ABMAMT=+$P($G(^ABMDBILL(ABMDUZ2,I,3,J,0)),U,9) ;penalty
..I ABMADJC=16 S ABMAMT=+$P($G(^ABMDBILL(ABMDUZ2,I,3,J,0)),U,12) ;g. allow
..I ABMADJC=19 S ABMAMT=+$P($G(^ABMDBILL(ABMDUZ2,I,3,J,0)),U,13) ;ref
..I ABMADJC=20 S ABMAMT=+$P($G(^ABMDBILL(ABMDUZ2,I,3,J,0)),U,14) ;pymt credit
..;abm*2.6*10 COB billing - switched below lines back because ABMSAR wasn't getting set; added "E" to first line
..S:(+$G(ABMSAR)=0) ABMSAR=$$GET1^DIQ("90056.06",$P($G(^ABMDBILL(ABMDUZ2,I,3,J,0)),U,17),".01","E") ;std reason ;abm*2.6*3 HEAT7574 ;abm*2.6*9 NOHEAT
..;S:(+$G(ABMSAR)'=0) ABMSAR=$$GET1^DIQ(90056.06,($P($G(^ABMDBILL(ABMDUZ2,I,3,J,0)),U,17)),".01","E") ;std reason ;abm*2.6*3 HEAT7574 ;abm*2.6*9 NOHEAT
..;I ABMADJC=4,(ABMSAR=96),($P($G(^ABMNINS(ABMP("LDFN"),K,0)),U,11)="Y") S ABMAMT=$P($G(^ABMDBILL(ABMDUZ2,I,2)),U) ;abm*2.6*3 HEAT7574 ;abm*2.6*9
..;I ABMADJC=4,($G(ABMSAR)=96),($P($G(^ABMNINS(ABMP("LDFN"),K,0)),U,11)="Y") S ABMAMT=$P($G(^ABMDBILL(ABMDUZ2,I,2)),U) ;abm*2.6*3 HEAT7574 ;abm*2.6*9 ;abm*2.6*10 COB billing
..;start new code abm*2.6*10 COB billing
..I ($P($G(^ABMNINS(ABMP("LDFN"),K,0)),U,11)="Y"),$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,+ABMP("INS"),".211","I"),1,"I")="R" D Q
...S ABMP(K,"OA",ABMOACNT)="96^"_$S((ABMP("EXP")>30):ABMP("BILL"),1:$P($G(^ABMDBILL(ABMDUZ2,I,2)),U))_"^1"
...S (ABMP("PAYED"),$P(ABMP("PAYED",K),"^",0,2))=0
..;end abm*2.6*10 COB billing
..I ($G(ABMSAR)="A2") S ABMP(K,"CO",ABMCOCNT)=ABMSAR_"^"_ABMAMT_"^1",ABMCOCNT=ABMCOCNT+1 Q
..I $G(ABMSAR)=1!($G(ABMSAR)=2)!($G(ABMSAR)=3) S ABMP(K,"PR",ABMPRCNT)=ABMSAR_"^"_ABMAMT_"^1",ABMPRCNT=ABMPRCNT+1
..;I $G(ABMSAR)'=1&($G(ABMSAR)'=2)&($G(ABMSAR)'=3) S ABMP(K,"OA",ABMOACNT)=ABMSAR_"^"_ABMAMT_"^1",ABMOACNT=ABMOACNT+1 ;abm*2.6*9 NOHEAT
..I +$G(ABMSAR)'=0&($G(ABMSAR)'=1)&($G(ABMSAR)'=2)&($G(ABMSAR)'=3) S ABMP(K,"OA",ABMOACNT)=ABMSAR_"^"_ABMAMT_"^1",ABMOACNT=ABMOACNT+1 ;abm*2.6*9 NOHEAT
.;start new abm*2.6*19 IHS/SD/SDR HEAT168248
.K ABMTP,ABMTI,ABMTSAR,ABMTREAL
.S ABMTI=0
.F S ABMTI=$O(ABMP(ABMTI)) Q:'ABMTI D
..F ABMTCD="OA","CO","PR" D
...S ABMTT=0
...F S ABMTT=$O(ABMP(ABMTI,ABMTCD,ABMTT)) Q:'ABMTT D
....S ABMTSAR=$P(ABMP(ABMTI,ABMTCD,ABMTT),U)
....I $D(ABMTP(ABMTSAR)) D
.....S ABMTREAL=$O(ABMTP(ABMTSAR,""))
.....S $P(ABMP(ABMTI,ABMTCD,ABMTREAL),U,2)=$P(ABMP(ABMTI,ABMTCD,ABMTREAL),U,2)+$P(ABMP(ABMTI,ABMTCD,ABMTT),U,2)
.....K ABMP(ABMTI,ABMTCD,ABMTT)
....I '$D(ABMTP(ABMTSAR)) S ABMTP(ABMTSAR,ABMTT)=""
.K ABMTP,ABMTI,ABMTSAR,ABMTREAL
.S ABMTI=0
.F S ABMTI=$O(ABMP(ABMTI)) Q:'ABMTI D
..F ABMTTTYP="OA","CO","PR" D
..M ABMTP(ABMTI,ABMTTTYP)=ABMP(ABMTI,ABMTTTYP)
..K ABMP(ABMTI,ABMTTTYP)
.S ABMCNT=1
.S ABMTI=0
.F S ABMTI=$O(ABMTP(ABMTI)) Q:'ABMTI D
..S ABMTTTYP=""
..F S ABMTTTYP=$O(ABMTP(ABMTI,ABMTTTYP)) Q:ABMTTTYP="" D
...S ABMTT=0
...F S ABMTT=$O(ABMTP(ABMTI,ABMTTTYP,ABMTT)) Q:'ABMTT D
....S ABMP(ABMTI,ABMTTTYP,ABMCNT)=$G(ABMTP(ABMTI,ABMTTTYP,ABMTT))
....S ABMCNT=ABMCNT+1
.K ABMTP,ABMTI,ABMTSAR,ABMTREAL,ABMTTTYP,ABMCNT,ABMTT
.;end new abm*2.6*19 IHS/SD/SDR HEAT168248
Q
ABMUTLP2 ; IHS/SD/SDR - PAYER UTILITIES ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;**10,11,21**;NOV 12, 2009;Build 379
+2 ;abm*2.6*10 - split from ABMUTLP
+3 ;IHS/SD/AML - 2.6*21 HEAT178693 - Made change for electronic VA billing
+4 ;IHS/SD/SDR - 2.6*21 HEAT107645 - Made change to put MC (Medicaid) or CI (Private) for Kidscare.
+5 ;
SOP ;EP - source of pay (claim filing indicator)
+1 SET ABMTYP=$PIECE($GET(^AUTNINS(+ABMP("INS",ABMI),2)),U,11)
+2 IF ABMTYP
Begin DoDot:1
+3 SET ABMP("SOP",ABMI)=$PIECE(^AUTTCFI(ABMTYP,0),U)
End DoDot:1
QUIT
+4 SET ABMTYP=$PIECE(ABMP("INS",ABMI),"^",2)
+5 ;S Y=$F("HMDRPWCFNIK",ABMTYP) ;abm*2.6*8 5010
+6 ;S Y=$F("HMDRPWCFIK",ABMTYP) ;abm*2.6*8 5010 ;abm*2.6*10 HEAT69121
+7 ;S ABMP("SOP",ABMI)=$P("^HM^SP^MC^MA^CI^WC^CH^ZZ^09^OF^MC","^",Y) ;abm*2.6*8 5010
+8 ;S ABMP("SOP",ABMI)=$P("^HM^SP^MC^MA^CI^WC^CH^ZZ^OF^MC","^",Y) ;abm*2.6*8 5010 ;abm*2.6*10 HEAT69121
+9 ;start new code abm*2.6*10 HEAT69121
+10 IF ABMTYP="H"
SET ABMP("SOP",ABMI)="HM"
+11 IF ABMTYP="M"
SET ABMP("SOP",ABMI)="SP"
+12 IF ABMTYP="D"
SET ABMP("SOP",ABMI)="MC"
+13 IF ABMTYP="R"
SET ABMP("SOP",ABMI)="MA"
+14 IF ABMTYP="P"
SET ABMP("SOP",ABMI)="CI"
+15 IF ABMTYP="W"
SET ABMP("SOP",ABMI)="WC"
+16 IF ABMTYP="C"
SET ABMP("SOP",ABMI)="CH"
+17 IF ABMTYP="F"
SET ABMP("SOP",ABMI)="ZZ"
+18 IF ABMTYP="I"!(ABMTYP="MD")
SET ABMP("SOP",ABMI)="OF"
+19 ;I ABMTYP="K" S ABMP("SOP",ABMI)="MC" ;abm*2.6*21 IHS/SD/SDR HEAT107645
+20 ;abm*2.6*21 IHS/SD/SDR HEAT107645
IF ABMTYP="K"
IF ($$GET1^DIQ(9999999.18,+ABMP("INS",ABMI),".38","I")="P")
SET ABMP("SOP",ABMI)="CI"
+21 ;abm*2.6*21 IHS/SD/SDR HEAT107645
IF ABMTYP="K"
IF ($$GET1^DIQ(9999999.18,+ABMP("INS",ABMI),".38","I")'="P")
SET ABMP("SOP",ABMI)="MC"
+22 IF ABMTYP="MH"
SET ABMP("SOP",ABMI)="16"
+23 ;end new code HEAT69121
+24 ;abm*2.6*21 IHS/SD/AML 8/21/14 - HEAT178693
IF ABMTYP="V"
SET ABMP("SOP",ABMI)="VA"
+25 IF $$BCBS1^ABMERUTL(+ABMP("INS",ABMI))
Begin DoDot:1
+26 SET ABMP("SOP",ABMI)="BL"
End DoDot:1
+27 ;I ABMP("SOP",ABMI)="MA",(ABMP("VTYP")=999!($P($G(^ABMDPARM(DUZ(2),1,5)),U,3)="C00900"))!((ABMP("BTYP")=831)&(ABMP("EXP")=22)) D ;abm*2.6*11 HEAT96809
+28 ;abm*2.6*11 HEAT96809
IF $GET(ABMP("SOP",ABMI))="MA"
IF (ABMP("VTYP")=999!($PIECE($GET(^ABMDPARM(DUZ(2),1,5)),U,3)="C00900"))!((ABMP("BTYP")=831)&(ABMP("EXP")=22))
Begin DoDot:1
+29 SET ABMP("SOP",ABMI)="MB"
End DoDot:1
+30 ;I ABMP("SOP",ABMI)="MA",(ABMP("VTYP")=999!($P($G(^ABMDPARM(DUZ(2),1,5)),U,3)="04402"))!((ABMP("BTYP")=831)&(ABMP("EXP")=22)) D ;abm*2.6*10 NOHEAT
+31 ;I ABMP("SOP",ABMI)="MA",(ABMP("VTYP")=999!($P($G(^ABMDPARM(DUZ(2),1,5)),U,3)="04402"))!((ABMP("BTYP")=831)&((ABMP("EXP")=22)!(ABMP("EXP")=32))) D ;abm*2.6*10 NOHEAT ;abm*2.6*10 HEAT68447
+32 ;I ABMP("SOP",ABMI)="MA",(ABMP("VTYP")=999!($P($G(^ABMDPARM(ABMP("LDFN"),1,5)),U,3)="04402"))!((ABMP("BTYP")=831)&((ABMP("EXP")=22)!(ABMP("EXP")=32))) D ;abm*2.6*10 NOHEAT ;abm*2.6*10 HEAT68447 ;abm*2.6*10 HEAT74059
+33 ;I ABMP("SOP",ABMI)="MA",(ABMP("VTYP")=999!(("^04312^04212^04112^04412^04402^")[("^"_$P($G(^ABMDPARM(ABMP("LDFN"),1,5)),U,3)_"^")))!((ABMP("BTYP")=831)&((ABMP("EXP")=22)!(ABMP("EXP")=32))) D ;abm*2.6*10 NOHEAT HEAT68447 HEAT74059 ;abm*2.6*11 H
EAT96809
+34 ;abm*2.6*11 HEAT96809
IF $GET(ABMP("SOP",ABMI))="MA"
IF (ABMP("VTYP")=999!(("^04312^04212^04112^04412^04402^")[("^"_$PIECE($GET(^ABMDPARM(ABMP("LDFN"),1,5)),U,3)_"^")))!((ABMP("BTYP")=831)&((ABMP("EXP")=22)!(ABMP("EXP")=32)))
Begin DoDot:1
+35 SET ABMP("SOP",ABMI)="MB"
End DoDot:1
+36 QUIT
OVER ;EP - get override values from 3P Ins file
+1 ;S ABMOEXP=$S(ABMP("EXP")=21:11,ABMP("EXP")=22:14,ABMP("EXP")=23:18,1:0) ;abm*2.6*10 HEAT65683
+2 ;abm*2.6*10 HEAT65683
SET ABMOEXP=$SELECT(ABMP("EXP")=21!(ABMP("EXP")=31):11,ABMP("EXP")=22!(ABMP("EXP")=32):14,ABMP("EXP")=23!(ABMP("EXP")=33):18,1:0)
+3 IF ABMOEXP=0
QUIT
+4 SET ABMOPC=0
+5 ;F S ABMOPC=$O(^ABMNINS(DUZ(2),ABMP("INS"),2,"AOVR",ABMOEXP,ABMOLN,ABMOPC)) Q:'ABMOPC D ;abm*2.6*10 HEAT53137
+6 ;abm*2.6*10 HEAT53137
FOR
SET ABMOPC=$ORDER(^ABMNINS(ABMP("LDFN"),ABMP("INS"),2,"AOVR",ABMOEXP,ABMOLN,ABMOPC))
IF 'ABMOPC
QUIT
Begin DoDot:1
+7 KILL ABMOVTYP
+8 ;start old code abm*2.6*10 HEAT53137
+9 ;I $D(^ABMNINS(DUZ(2),ABMP("INS"),2,"AOVR",ABMOEXP,ABMOLN,ABMOPC,0)) S ABMOVTYP=0
+10 ;I $D(^ABMNINS(DUZ(2),ABMP("INS"),2,"AOVR",ABMOEXP,ABMOLN,ABMOPC,ABMP("VTYP"))) S ABMOVTYP=ABMP("VTYP")
+11 ;end old code start new code HEAT53137
+12 IF $DATA(^ABMNINS(ABMP("LDFN"),ABMP("INS"),2,"AOVR",ABMOEXP,ABMOLN,ABMOPC,0))
SET ABMOVTYP=0
+13 IF $DATA(^ABMNINS(ABMP("LDFN"),ABMP("INS"),2,"AOVR",ABMOEXP,ABMOLN,ABMOPC,ABMP("VTYP")))
SET ABMOVTYP=ABMP("VTYP")
+14 ;end new code HEAT53137
+15 IF '$DATA(ABMOVTYP)
QUIT
+16 SET ABMVALUE=^ABMNINS(DUZ(2),ABMP("INS"),2,"AOVR",ABMOEXP,ABMOLN,ABMOPC,ABMOVTYP)
+17 ;
+18 IF ABMOLN=51
SET ABMOLN=40
SET ABMPC=4
Begin DoDot:2
+19 SET $PIECE(ABMR("NM1",ABMOLN),"^",ABMPC)=ABMVALUE
+20 SET $PIECE(ABMREC("NM1"),"*",ABMPC)=ABMVALUE
End DoDot:2
QUIT
+21 ;
+22 IF ABMOLN=52
SET ABMOLN=20
SET ABMPC=2
Begin DoDot:2
+23 SET $PIECE(ABMR("N3",ABMOLN),"^",ABMPC)=ABMVALUE
+24 SET $PIECE(ABMREC("N3"),"*",ABMPC)=ABMVALUE
End DoDot:2
QUIT
+25 ;
+26 IF ABMOLN=53
Begin DoDot:2
+27 ;city
SET ABMR("N4",20)=$PIECE(ABMVALUE,",")
+28 SET $PIECE(ABMREC("N4"),"*",2)=ABMR("N4",20)
+29 ;state
SET ABMR("N4",30)=$PIECE($PIECE(ABMVALUE,", ",2)," ")
+30 SET $PIECE(ABMREC("N4"),"*",3)=ABMR("N4",30)
+31 ;zip
SET ABMR("N4",40)=$PIECE($PIECE(ABMVALUE,",",2)," ",2)
+32 SET $PIECE(ABMREC("N4"),"*",4)=ABMR("N4",40)
End DoDot:2
QUIT
End DoDot:1
+33 ;
+34 KILL ABMOLN,ABMOPC,ABMVALUE,ABMOVTYP
+35 QUIT
PAYED ; EP ;abm*2.6*19 IHS/SD/SDR HEAT168248 - split from ABMUTLP
+1 ; Build Ins Pymt Array
+2 KILL ABMP("PAYED")
+3 SET (ABMOACNT,ABMPRCNT)=1
+4 SET ABMCOCNT=1
+5 IF '$GET(ABMDUZ2)
SET ABMDUZ2=DUZ(2)
+6 NEW L
+7 ;Bill#
SET L=+$PIECE(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),0),U)_" "
+8 FOR
SET L=$ORDER(^ABMDBILL(ABMDUZ2,"B",L))
IF +L'=+$PIECE(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),0),U)!(L="")
QUIT
Begin DoDot:1
+9 NEW I
+10 ;IEN
SET I=$ORDER(^ABMDBILL(ABMDUZ2,"B",L,0))
+11 ;Quit if cancelled
IF $PIECE(^ABMDBILL(ABMDUZ2,I,0),U,4)="X"
QUIT
+12 NEW K
+13 ;Active ins IEN
SET K=$PIECE(^ABMDBILL(ABMDUZ2,I,0),U,8)
+14 NEW J
+15 SET J=0
+16 FOR
SET J=$ORDER(^ABMDBILL(ABMDUZ2,I,3,J))
IF 'J
QUIT
Begin DoDot:2
+17 NEW ABMPAY
+18 ;abm*2.6*10 COB billing
KILL ABMSAR
+19 ;Amt paid
SET ABMPAY=+$PIECE(^ABMDBILL(ABMDUZ2,I,3,J,0),U,2)
+20 ;Add amt paid per ins
SET ABMP("PAYED",K)=+$GET(ABMP("PAYED",K))+ABMPAY
+21 SET $PIECE(ABMP("PAYED",K),"^",2)=$PIECE(^ABMDBILL(ABMDUZ2,I,3,J,0),U)
+22 ;Add amt paid
SET ABMP("PAYED")=+$GET(ABMP("PAYED"))+ABMPAY
+23 ;adj category
SET ABMADJC=$PIECE($GET(^ABMDBILL(ABMDUZ2,I,3,J,0)),U,15)
+24 ;abm*2.6*3 HEAT7574
IF $PIECE($GET(^ABMNINS(ABMP("LDFN"),K,0)),U,11)="Y"
SET ABMADJC=4
SET ABMSAR=96
+25 ;no adj cat
IF (ABMADJC="")
QUIT
+26 ;co-ins
IF ABMADJC=14
SET ABMAMT=+$PIECE($GET(^ABMDBILL(ABMDUZ2,I,3,J,0)),U,4)
+27 ;deduct
IF ABMADJC=13
SET ABMAMT=+$PIECE($GET(^ABMDBILL(ABMDUZ2,I,3,J,0)),U,3)
+28 ;w-off
IF ABMADJC=3
SET ABMAMT=+$PIECE($GET(^ABMDBILL(ABMDUZ2,I,3,J,0)),U,6)
+29 ;non-cov
IF ABMADJC=4
SET ABMAMT=+$PIECE($GET(^ABMDBILL(ABMDUZ2,I,3,J,0)),U,7)
+30 ;penalty
IF ABMADJC=15
SET ABMAMT=+$PIECE($GET(^ABMDBILL(ABMDUZ2,I,3,J,0)),U,9)
+31 ;g. allow
IF ABMADJC=16
SET ABMAMT=+$PIECE($GET(^ABMDBILL(ABMDUZ2,I,3,J,0)),U,12)
+32 ;ref
IF ABMADJC=19
SET ABMAMT=+$PIECE($GET(^ABMDBILL(ABMDUZ2,I,3,J,0)),U,13)
+33 ;pymt credit
IF ABMADJC=20
SET ABMAMT=+$PIECE($GET(^ABMDBILL(ABMDUZ2,I,3,J,0)),U,14)
+34 ;abm*2.6*10 COB billing - switched below lines back because ABMSAR wasn't getting set; added "E" to first line
+35 ;std reason ;abm*2.6*3 HEAT7574 ;abm*2.6*9 NOHEAT
IF (+$GET(ABMSAR)=0)
SET ABMSAR=$$GET1^DIQ("90056.06",$PIECE($GET(^ABMDBILL(ABMDUZ2,I,3,J,0)),U,17),".01","E")
+36 ;S:(+$G(ABMSAR)'=0) ABMSAR=$$GET1^DIQ(90056.06,($P($G(^ABMDBILL(ABMDUZ2,I,3,J,0)),U,17)),".01","E") ;std reason ;abm*2.6*3 HEAT7574 ;abm*2.6*9 NOHEAT
+37 ;I ABMADJC=4,(ABMSAR=96),($P($G(^ABMNINS(ABMP("LDFN"),K,0)),U,11)="Y") S ABMAMT=$P($G(^ABMDBILL(ABMDUZ2,I,2)),U) ;abm*2.6*3 HEAT7574 ;abm*2.6*9
+38 ;I ABMADJC=4,($G(ABMSAR)=96),($P($G(^ABMNINS(ABMP("LDFN"),K,0)),U,11)="Y") S ABMAMT=$P($G(^ABMDBILL(ABMDUZ2,I,2)),U) ;abm*2.6*3 HEAT7574 ;abm*2.6*9 ;abm*2.6*10 COB billing
+39 ;start new code abm*2.6*10 COB billing
+40 IF ($PIECE($GET(^ABMNINS(ABMP("LDFN"),K,0)),U,11)="Y")
IF $$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,+ABMP("INS"),".211","I"),1,"I")="R"
Begin DoDot:3
+41 SET ABMP(K,"OA",ABMOACNT)="96^"_$SELECT((ABMP("EXP")>30):ABMP("BILL"),1:$PIECE($GET(^ABMDBILL(ABMDUZ2,I,2)),U))_"^1"
+42 SET (ABMP("PAYED"),$PIECE(ABMP("PAYED",K),"^",0,2))=0
End DoDot:3
QUIT
+43 ;end abm*2.6*10 COB billing
+44 IF ($GET(ABMSAR)="A2")
SET ABMP(K,"CO",ABMCOCNT)=ABMSAR_"^"_ABMAMT_"^1"
SET ABMCOCNT=ABMCOCNT+1
QUIT
+45 IF $GET(ABMSAR)=1!($GET(ABMSAR)=2)!($GET(ABMSAR)=3)
SET ABMP(K,"PR",ABMPRCNT)=ABMSAR_"^"_ABMAMT_"^1"
SET ABMPRCNT=ABMPRCNT+1
+46 ;I $G(ABMSAR)'=1&($G(ABMSAR)'=2)&($G(ABMSAR)'=3) S ABMP(K,"OA",ABMOACNT)=ABMSAR_"^"_ABMAMT_"^1",ABMOACNT=ABMOACNT+1 ;abm*2.6*9 NOHEAT
+47 ;abm*2.6*9 NOHEAT
IF +$GET(ABMSAR)'=0&($GET(ABMSAR)'=1)&($GET(ABMSAR)'=2)&($GET(ABMSAR)'=3)
SET ABMP(K,"OA",ABMOACNT)=ABMSAR_"^"_ABMAMT_"^1"
SET ABMOACNT=ABMOACNT+1
End DoDot:2
+48 ;start new abm*2.6*19 IHS/SD/SDR HEAT168248
+49 KILL ABMTP,ABMTI,ABMTSAR,ABMTREAL
+50 SET ABMTI=0
+51 FOR
SET ABMTI=$ORDER(ABMP(ABMTI))
IF 'ABMTI
QUIT
Begin DoDot:2
+52 FOR ABMTCD="OA","CO","PR"
Begin DoDot:3
+53 SET ABMTT=0
+54 FOR
SET ABMTT=$ORDER(ABMP(ABMTI,ABMTCD,ABMTT))
IF 'ABMTT
QUIT
Begin DoDot:4
+55 SET ABMTSAR=$PIECE(ABMP(ABMTI,ABMTCD,ABMTT),U)
+56 IF $DATA(ABMTP(ABMTSAR))
Begin DoDot:5
+57 SET ABMTREAL=$ORDER(ABMTP(ABMTSAR,""))
+58 SET $PIECE(ABMP(ABMTI,ABMTCD,ABMTREAL),U,2)=$PIECE(ABMP(ABMTI,ABMTCD,ABMTREAL),U,2)+$PIECE(ABMP(ABMTI,ABMTCD,ABMTT),U,2)
+59 KILL ABMP(ABMTI,ABMTCD,ABMTT)
End DoDot:5
+60 IF '$DATA(ABMTP(ABMTSAR))
SET ABMTP(ABMTSAR,ABMTT)=""
End DoDot:4
End DoDot:3
End DoDot:2
+61 KILL ABMTP,ABMTI,ABMTSAR,ABMTREAL
+62 SET ABMTI=0
+63 FOR
SET ABMTI=$ORDER(ABMP(ABMTI))
IF 'ABMTI
QUIT
Begin DoDot:2
+64 FOR ABMTTTYP="OA","CO","PR"
Begin DoDot:3
End DoDot:3
+65 MERGE ABMTP(ABMTI,ABMTTTYP)=ABMP(ABMTI,ABMTTTYP)
+66 KILL ABMP(ABMTI,ABMTTTYP)
End DoDot:2
+67 SET ABMCNT=1
+68 SET ABMTI=0
+69 FOR
SET ABMTI=$ORDER(ABMTP(ABMTI))
IF 'ABMTI
QUIT
Begin DoDot:2
+70 SET ABMTTTYP=""
+71 FOR
SET ABMTTTYP=$ORDER(ABMTP(ABMTI,ABMTTTYP))
IF ABMTTTYP=""
QUIT
Begin DoDot:3
+72 SET ABMTT=0
+73 FOR
SET ABMTT=$ORDER(ABMTP(ABMTI,ABMTTTYP,ABMTT))
IF 'ABMTT
QUIT
Begin DoDot:4
+74 SET ABMP(ABMTI,ABMTTTYP,ABMCNT)=$GET(ABMTP(ABMTI,ABMTTTYP,ABMTT))
+75 SET ABMCNT=ABMCNT+1
End DoDot:4
End DoDot:3
End DoDot:2
+76 KILL ABMTP,ABMTI,ABMTSAR,ABMTREAL,ABMTTTYP,ABMCNT,ABMTT
+77 ;end new abm*2.6*19 IHS/SD/SDR HEAT168248
End DoDot:1
+78 QUIT
