- 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
