ABMUTLP ; IHS/ASDST/DMJ - PAYER UTILITIES ;
;;2.6;IHS 3P BILLING SYSTEM;**3,6,8,9,10,11,19,21,26**;NOV 12, 2009;Build 440
;abm*2.6*10 split into ABMUTLP2 due to routine size
;IHS/SD/SDR 2.6*19 HEAT136922 -made changes for relationship code for grandchildren, nephew, niece
;IHS/SD/SDR 2.6*19 HEAT168248 -Made changes to merge same SARs into one entry, not one for each A/R trans.
;IHS/SD/SDR 2.6*21 HEAT107645 - SBR - made change to check if insurer type K should be mcd or prvt and pull appropriate data
;IHS/SD/SDR 2.6*26 CR9265 Added code to call AUPN API to return either MBI or default to old code for HIC
;*********************
SET(X,ABMDUZ2) ; EP set up standard vars
;x=bill ien
;abmduz2=duz(2)
S:'$G(ABMDUZ2) ABMDUZ2=DUZ(2)
K ABMCDNUM
S ABMP("BDFN")=X
N I
F I=0:1:9 D
.S @("ABMB"_I)=$G(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),I))
I $G(ABMB6) F I=2,4 D
.I $L($P(ABMB6,"^",I))=1 D
..S $P(ABMB6,"^",I)="0"_$P(ABMB6,"^",I)
S ABMP("PDFN")=$P(ABMB0,U,5) ;Pt IEN
S ABMP("LDFN")=$P(ABMB0,U,3) ;Visit loc IEN
S ABMP("BTYP")=$P(ABMB0,U,2) ;Bill type
S ABMP("EXP")=$P(ABMB0,U,6) ;Exp mode IEN
S ABMP("VTYP")=$P(ABMB0,U,7) ;Visit type IEN
S ABMP("INS")=$P(ABMB0,U,8) ;Active Ins IEN
S ABMP("CLIN")=$P(ABMB0,U,10) ;Clinic
S ABMP("CLIN")=$P($G(^DIC(40.7,+ABMP("CLIN"),0)),U,2)
S ABMP("VDT")=$P($G(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),7)),U) ;Service date from
;S ABMP("ITYPE")=$P($G(^AUTNINS(+ABMP("INS"),2)),U) ;Type of ins ;abm*2.6*10 HEAT73780
S ABMP("ITYPE")=$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,+ABMP("INS"),".211","I"),1,"I") ;Type of ins ;abm*2.6*10 HEAT73780
S ABMP("RTYPE")=$S(ABMP("ITYPE")="R":"1G",ABMP("ITYPE")="D":"1D",$P($G(^ABMNINS(ABMDUZ2,ABMP("INS"),1,ABMP("VTYP"),1)),U)'="":$P($G(^ABMREFID($P($G(^ABMNINS(ABMDUZ2,ABMP("INS"),1,ABMP("VTYP"),1)),U),0)),U),1:"0B")
I ABMP("EXP")=22,ABMP("RTYPE")="1G" S ABMP("RTYPE")="1C"
D PCN^ABMERUTL
Q
ISET ; EP
;Set up Insurers
K ABMCDNUM
K ABMP("INS")
S ABMP("INS")=$P(ABMB0,U,8) ;Active Ins IEN
S ABME("PRIO")=0
S ABME("INS#")=0
;Loop down priority
F S ABME("PRIO")=$O(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),13,"C",ABME("PRIO"))) Q:'ABME("PRIO")!($G(ABMP("INS",3))) D
.N I
.S I=0
.F S I=$O(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),13,"C",ABME("PRIO"),I)) Q:'I!($G(ABMP("INS",3))) D
..;Quit if insurer unbillable
..Q:$P(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),13,I,0),U,3)="U" S ABME("INS")=$P(^(0),U) ;Ins IEN
..;S ABME("ITYPE")=$P(^AUTNINS(ABME("INS"),2),U) ;type insurer ;abm*2.6*10 HEAT73780
..S ABME("ITYPE")=$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABME("INS"),".211","I"),1,"I") ;type insurer ;abm*2.6*10 HEAT73780
..Q:"I"[ABME("ITYPE") ;Quit if indian pt
..;Quit if non-beneficiary & not active ins
..Q:"N"[ABME("ITYPE")&($P(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),0),U,8)'=ABME("INS"))
..I ABME("ITYPE")="D"!(ABME("ITYPE")="K") D
...S ABMCDNUM=$P(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),13,I,0),U,6)
...S:'$G(ABMP("PDFN")) ABMP("PDFN")=$P(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),0),U,5)
...Q:$P($G(^AUPNMCD(+ABMCDNUM,0)),U)=ABMP("PDFN")
...D DBFX^ABMDEFIP(ABMP("BDFN"),I)
...S ABMCDNUM=$P(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),13,I,0),U,6)
..S ABME("INS#")=ABME("INS#")+1 ;increment cntr
..S ABMP("INS",ABME("INS#"))=^ABMDBILL(ABMDUZ2,ABMP("BDFN"),13,I,0)
..S $P(ABMP("INS",ABME("INS#")),U,2)=ABME("ITYPE")
Q
PAYED ; EP
; Build Ins Pymt Array
D PAYED^ABMUTLP2 ;abm*2.6*19 IHS/SD/SDR HEAT168248
Q
TCR(X) ; EP
; Total credits for bill
;x=bill ien
S ABM("TCREDITS")=0
S I=0
F S I=$O(^ABMDBILL(ABMDUZ2,X,3,I)) Q:'I D
.F J=2,3,4 S ABM("TCREDITS")=ABM("TCREDITS")+$P(^ABMDBILL(ABMDUZ2,X,3,I,0),"^",J)
S X=ABM("TCREDITS")
K ABM("TCREDITS")
Q X
MCDBFX(X,Y) ; EP
; Fix BILL Ins Multiple if broken ptr mcd
; INPUT:X = IEN (CLAIM OR BILL)
; Y = INS IEN UNDER FIELD #13 (INS MULTIPLE)
; OUTPUT:
N ABMP
S ABMP("D0")=X
S ABMP("D1")=Y
S ABMP("ZERO")=^ABMDBILL(ABMDUZ2,ABMP("D0"),13,ABMP("D1"),0)
S ABMP("PDFN")=$P(^ABMDBILL(ABMDUZ2,ABMP("D0"),0),"^",5)
S ABMP("VDT")=$P(^ABMDBILL(ABMDUZ2,ABMP("D0"),7),U)
D MGET
I $G(ABMP(1)) S $P(^ABMDBILL(ABMDUZ2,ABMP("D0"),13,ABMP("D1"),0),U,6)=ABMP(1),$P(^(0),U,7)=ABMP(2)
Q
MGET ; EP
; Get new ptr
S ABMP("INSCO")=$P(ABMP("ZERO"),U)
S ABMP("PTR")=$P(ABMP("ZERO"),U,6)
Q:ABMP("PTR")=""
Q:$D(^AUPNMCD(ABMP("PTR"),0))
;Q:$P($G(^AUTNINS(ABMP("INSCO"),2)),U)'="D" ;abm*2.6*10 HEAT73780
Q:$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMP("INSCO"),".211","I"),1,"I")'="D" ;abm*2.6*10 HEAT73780
D 4^ABMDLCK2
S ABMP("PRI")=$O(ABML(0)) Q:'ABMP("PRI")
S ABMP("INS")=$O(ABML(ABMP("PRI"),0)) Q:'ABMP("INS")
Q:ABMP("INS")'=ABMP("INSCO")
N I
F I=1,2 S ABMP(I)=$P(ABML(ABMP("PRI"),ABMP("INS")),"^",I)
Q
SBR(X,ABMDUZ2) ;PEP - subscriber
;x=bill IEN
;abmduz2=duz(2)
S:'$G(ABMDUZ2) ABMDUZ2=DUZ(2)
D SET(X,ABMDUZ2)
D ISET
K ABMPSQ,ABMSBR
N ABMI,ABMINS
S ABMI=0
F S ABMI=$O(ABMP("INS",ABMI)) Q:'ABMI D
.S ABMINS=ABMP("INS",ABMI)
.I ($P(ABMINS,U)=ABMP("INS")!($P(ABMINS,U,11)=ABMP("INS"))) S ABMPSQ=ABMI
.D SOP
.;I $P(ABMINS,U,2)="D"!($P(ABMINS,U,2)="K") D MCD Q ;abm*2.6*21 IHS/SD/SDR HEAT107645
.;start new abm*2.6*21 IHS/SD/SDR HEAT107645
.I $P(ABMINS,U,2)="D" D MCD Q
.I $P(ABMINS,U,2)="K" D Q
..I $$GET1^DIQ(9999999.18,+ABMINS,".38","I")="M" D MCD
..I $$GET1^DIQ(9999999.18,+ABMINS,".38","I")="P" D PRVT
.;end new abm*2.6*21 IHS/SD/SDR HEAT107645
.I $P(ABMINS,U,2)="R" D MCR Q
.D PRVT
I '$G(ABMPSQ) S ABMPSQ=0
S ABMSBR=$G(ABMSBR(ABMPSQ))
I '$G(ABMSBR) S ABMSBR=2_"-"_ABMP("PDFN")
S ABMP("REL")=$G(ABMP("REL",ABMPSQ))
S ABMP("PH")=$G(ABMP("PH",ABMPSQ))
S ABMP("PNUM")=$G(ABMP("PNUM",ABMPSQ))
S ABMP("SNUM")=$G(ABMP("SNUM",ABMPSQ))
S:ABMP("SNUM")="" ABMP("SNUM")=$G(ABMP("PNUM"))
S:ABMP("PNUM")="" ABMP("PNUM")=$G(ABMP("SNUM"))
S ABMP("GRPNM")=$G(ABMP("GRPNM",ABMPSQ))
S ABMP("GRP#")=$G(ABMP("GRP#",ABMPSQ))
S ABMP("SOP")=$G(ABMP("SOP",ABMPSQ))
Q ABMSBR
MCD ;mcd
S ABMCDNUM=+$P(ABMINS,U,6)
S ABMP("PH",ABMI)=+$P($G(^AUPNMCD(ABMCDNUM,0)),U,9)
S ABMP("REL",ABMI)=$P($G(^AUPNMCD(ABMCDNUM,0)),U,6)
;S ABMP("REL",ABMI)=$P($G(^AUTTRLSH(+ABMP("REL",ABMI),0)),U,5) ;abm*2.6*19 IHS/SD/SDR HEAT136922
;start new abm*2.6*19 IHS/SD/SDR HEAT136922
I "^STEP^STEPSON^STEPDAUGHTER^GRANDCHILD^CHILD^DAUGHTER^SON^NEPHEW^NIECE^STEP CHILD^"[("^"_$P($G(^AUTTRLSH(+ABMP("REL",ABMI),0)),U)_"^") S ABMP("REL",ABMI)=19
E S ABMP("REL",ABMI)=$P($G(^AUTTRLSH(+ABMP("REL",ABMI),0)),U,5)
;end new abm*2.6*19 HEAT136922
I 'ABMP("PH",ABMI) D Q
.S ABMSBR(ABMI)=2_"-"_ABMP("PDFN")
.S ABMP("PNUM",ABMI)=$P($G(^AUPNMCD(ABMCDNUM,0)),U,3)
.S ABMP("SNUM",ABMI)=$P($G(^AUPNMCD(ABMCDNUM,0)),U,3)
.S ABMP("REL",ABMI)=18
I '$D(^AUPN3PPH(ABMP("PH",ABMI),0)) D Q
.S ABMSBR(ABMI)=2_"-"_ABMP("PDFN")
.S ABMP("PNUM",ABMI)=$P($G(^AUPNMCD(ABMCDNUM,0)),U,3)
.S ABMP("REL",ABMI)=18
S ABMSBR(ABMI)=3_"-"_ABMP("PH",ABMI)
S ABMP("SNUM",ABMI)=$P(^AUPN3PPH(ABMP("PH",ABMI),0),U,4)
D GRP(ABMP("PH",ABMI))
Q
PRVT ;private
S ABMIEN=+$P(ABMINS,U,8)
Q:$P($G(^AUPNPRVT(ABMP("PDFN"),11,+ABMIEN,0)),U)=""
S ABMP("PH",ABMI)=+$P($G(^AUPNPRVT(ABMP("PDFN"),11,+ABMIEN,0)),U,8)
S ABMP("PNUM",ABMI)=$S($P($G(^AUPNPRVT(ABMP("PDFN"),11,+ABMIEN,2)),U)'="":$P(^(2),U),$P($G(^AUPNPRVT(ABMP("PDFN"),11,+ABMIEN,0)),U,8)'="":$P($G(^AUPN3PPH($P($G(^AUPNPRVT(ABMP("PDFN"),11,+ABMIEN,0)),U,8),0)),U,4),1:"")
I 'ABMP("PH",ABMI) D Q
.S ABMSBR(ABMI)=2_"-"_ABMP("PDFN")
.S ABMP("REL",ABMI)=18
S ABMP("REL",ABMI)=+$P($G(^AUPNPRVT(ABMP("PDFN"),11,+ABMIEN,0)),U,5)
;S ABMP("REL",ABMI)=$P($G(^AUTTRLSH(+ABMP("REL",ABMI),0)),U,5) ;abm*2.6*19 IHS/SD/SDR HEAT136922
;start new abm*2.6*19 IHS/SD/SDR HEAT136922
I "^STEPSON^STEPDAUGHTER^GRANDCHILD^CHILD^DAUGHTER^SON^NEPHEW^NIECE^STEP CHILD^NIECE/NEPHEW^GRANDDAUGHTER^GRANDSON^DAUGHTER-IN-LAW^"[("^"_$P($G(^AUTTRLSH(+ABMP("REL",ABMI),0)),U)_"^") S ABMP("REL",ABMI)=19
E S ABMP("REL",ABMI)=$P($G(^AUTTRLSH(+ABMP("REL",ABMI),0)),U,5)
;end new abm*2.6*19 HEAT136922
S ABMSBR(ABMI)=3_"-"_ABMP("PH",ABMI)
;S ABMP("SNUM",ABMI)=$P($G(^AUPN3PPH(ABMP("PH",ABMI),0)),U,4) ;abm*2.6*11 HEAT97889
S ABMP("SNUM",ABMI)=$S($P($G(^AUPNPRVT(ABMP("PDFN"),11,+ABMIEN,2)),U)'="":$P(^(2),U),1:$P($G(^AUPN3PPH(ABMP("PH",ABMI),0)),U,4)) ;abm*2.6*11 HEAT97889
D GRP(ABMP("PH",ABMI))
Q
MCR ;mcr
I $P(^AUTNINS(+ABMINS,0),U)["RAILROAD" D Q ;abm*2.6*3 HEAT12676
.;start old abm*2.6*26 IHS/SD/SDR CR9265
.;S ABMPRFX=$P($G(^AUPNRRE(ABMP("PDFN"),0)),U,3),ABMHIC=$P($G(^(0)),U,4)
.;S ABMPRFX=$P($G(^AUTTRRP(+ABMPRFX,0)),U)
.;S ABMP("PNUM",ABMI)=ABMPRFX_ABMHIC
.;K ABMPRFX,ABMHIC
.;end old start new abm*2.6*26 IHS/SD/SDR CR9265
.K ABMMBI
.S ABMMBI=""
.S ABMMBI=$$HISTMBI^AUPNMBI(ABMP("PDFN"),.ABMMBI)
.S ABMMBI=+$O(ABMMBI(999999999),-1)
.S:(ABMMBI'=0) ABMP("PNUM",ABMI)=$P(ABMMBI(ABMMBI),U)
.I $G(ABMP("PNUM",ABMI))="" D
..S ABMPRFX=$P($G(^AUPNRRE(ABMP("PDFN"),0)),U,3),ABMHIC=$P($G(^(0)),U,4)
..S ABMPRFX=$P($G(^AUTTRRP(+ABMPRFX,0)),U)
..S ABMP("PNUM",ABMI)=ABMPRFX_ABMHIC
..K ABMPRFX,ABMHIC
.;end new abm*2.6*26 IHS/SD/SDR CR9265
.;start new abm*2.6*3 HEAT12676
.S ABMP("SNUM",ABMI)=ABMP("PNUM",ABMI)
.S ABMP("REL",ABMI)=18
.S ABMP("GRP#",ABMI)=""
.S ABMSBR(ABMI)=2_"-"_ABMP("PDFN")
;end new HEAT12676
;I $P($G(^AUTNINS(+ABMINS,2)),U)="R"!($P(^AUTNINS(+ABMINS,0),U)["MEDICARE") D Q ;abm*2.6*3 HEAT12676 ;abm*2.6*10 HEAT73780
I $$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,+ABMINS,".211","I"),1,"I")="R"!($P(^AUTNINS(+ABMINS,0),U)["MEDICARE") D Q ;abm*2.6*3 HEAT12676 ;abm*2.6*10 HEAT73780
.;start old abm*2.6*26 IHS/SD/SDR CR9265
.;S ABMHIC=$P($G(^AUPNMCR(ABMP("PDFN"),0)),U,3),ABMSUFX=$P($G(^(0)),U,4)
.;S ABMSUFX=$P($G(^AUTTMCS(+ABMSUFX,0)),U)
.;S ABMP("PNUM",ABMI)=ABMHIC_ABMSUFX
.;K ABMHIC,ABMSUFX
.;end old start new abm*2.6*26 IHS/SD/SDR CR9265
.K ABMMBI
.S ABMMBI=""
.S ABMMBI=$$HISTMBI^AUPNMBI(ABMP("PDFN"),.ABMMBI)
.S ABMMBI=+$O(ABMMBI(999999999),-1)
.S:(ABMMBI'=0) ABMP("PNUM",ABMI)=$P(ABMMBI(ABMMBI),U)
.I $G(ABMP("PNUM",ABMI))="" D
..S ABMHIC=$P($G(^AUPNMCR(ABMP("PDFN"),0)),U,3),ABMSUFX=$P($G(^(0)),U,4)
..S ABMSUFX=$P($G(^AUTTMCS(+ABMSUFX,0)),U)
..S ABMP("PNUM",ABMI)=ABMHIC_ABMSUFX
..K ABMHIC,ABMSUFX
.;end new abm*2.6*26 IHS/SD/SDR CR9265
.;start new abm*2.6*3 HEAT12676
.S ABMP("SNUM",ABMI)=ABMP("PNUM",ABMI)
.S ABMP("REL",ABMI)=18
.S ABMP("GRP#",ABMI)=""
.S ABMSBR(ABMI)=2_"-"_ABMP("PDFN")
;end new HEAT12676
;start old abm*2.6*3 HEAT12676
;S ABMP("SNUM",ABMI)=ABMP("PNUM",ABMI)
;S ABMP("REL",ABMI)=18
;S ABMP("GRP#",ABMI)=""
;S ABMSBR(ABMI)=2_"-"_ABMP("PDFN")
;end old HEAT12676
Q
PST(X) ;EP - primary, secondary, tertiary
D SET(X)
D ISET
S ABMCNT=0
S X=""
N I
S I=0
F S I=$O(ABMP("INS",I)) Q:'I D
.S ABMCNT=ABMCNT+1
.I $P(ABMP("INS",I),U)=ABMP("INS"),$P(ABMP("INS",I),U,3)="I" S X=ABMCNT Q
S X=$S(X=1:"P",X=2:"S",X=3:"T",1:"P")
Q X
GRP(X) ;EP - group name & #
;x=policy holder ien
S ABMP("GRP#",ABMI)=""
S ABMP("GRPNM",ABMI)=""
S X=$P($G(^AUPN3PPH(+X,0)),U,6)
I $D(^AUTNEGRP(+X,0)) D
.S ABMP("GRP#",ABMI)=$P(^AUTNEGRP(X,0),U,2)
.S ABMP("GRPNM",ABMI)=$P(^AUTNEGRP(X,0),U)
I ABMP("GRP#",ABMI)="",ABMP("GRPNM",ABMI)="" D
.S ABMP("GRPNM",ABMI)="UNKNOWN"
Q
SNUM(X) ;EP - subscriber policy#
;x=bill ien
S ABMSBR=$$SBR(X)
S X=$G(ABMP("SNUM"))
Q X
PNUM(X) ;EP - patient policy#
;x=bill ien
S ABMSBR=$$SBR(X)
S X=$G(ABMP("PNUM"))
Q X
REL(X) ;EP - rel.
;x=bill ien
S ABMSBR=$$SBR(X)
Q $G(ABMP("REL"))
SOP ;EP - source of pay (claim filing indicator)
D SOP^ABMUTLP2 ;abm*2.6*10
Q
MPP(X) ;EP - medicare primary payer
;x=bill ien
Q:X="" 0
N ABMIEN
S ABMIEN=X
Q:'$D(^ABMDBILL(DUZ(2),ABMIEN)) 0
N ABMPINS,ABMPTYP
S ABMPINS=$P(^ABMDBILL(DUZ(2),ABMIEN,0),U,8)
;S ABMPTYP=$P($G(^AUTNINS(+ABMPINS,2)),U) ;abm*2.6*10 HEAT73780
S ABMPTYP=$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,+ABMPINS,".211","I"),1,"I") ;abm*2.6*10 HEAT73780
Q:$G(ABMPTYP)'="R" 0
N I
S I=0
N ABMMPP
S ABMMPP=1
F S I=$O(^ABMDBILL(DUZ(2),ABMIEN,13,I)) Q:'I D
.N ABMX0
.S ABMX0=^ABMDBILL(DUZ(2),ABMIEN,13,I,0)
.Q:$P(ABMX0,U)=ABMPINS
.Q:$P(ABMX0,U,3)'="C"
.S ABMMPP=0
Q ABMMPP
RCID(X) ;EP - receiver id
;x=insurer
K Y
S X=$G(X)
;start new abm*2.6*6 5010
I $D(^ABMRECVR("C",X)) D
.Q:$G(ABMLOOP)="2330B" ;abm*2.6*9 HEAT55022
.S ABMCHIEN=$O(^ABMRECVR("C",X,0))
.;S:ABMCHIEN Y=$P($G(^ABMRECVR(ABMCHIEN,0)),U,2) ;abm*2.6*8
.S:ABMCHIEN Y=$P($G(^ABMRECVR(ABMCHIEN,0)),U,3) ;abm*2.6*8
.K ABMCHIEN
Q:$G(Y) Y
;end new 5010
;I $P($G(^AUTNINS(+X,2)),U)="R" S Y=$P($G(^ABMDPARM(DUZ(2),1,5)),U,3) ;abm*2.6*10 HEAT73780
I $$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,+X,".211","I"),1,"I")="R" S Y=$P($G(^ABMDPARM(DUZ(2),1,5)),U,3) ;abm*2.6*10 HEAT73780
I $G(Y)="" S Y=$P($G(^AUTNINS(+X,2)),U,12)
I $G(Y)="" S Y=$$RCID^ABMERUTL(X)
Q Y
SNDR(X,Y) ;EP - sender id
;x=insurer
;y=visit type
S X=$G(X)
S Y=$G(Y)
N Z ;abm*2.6*10
;S Z=$P($G(^ABMNINS(DUZ(2),+X,1,+Y,0)),U,19) ;abm*2.6*6 5010
;start new abm*2.6*6 5010
I $D(^ABMRECVR("C",X)) D
.S ABMCHIEN=$O(^ABMRECVR("C",X,0))
.;S:ABMCHIEN Z=$P($G(^ABMRECVR(ABMCHIEN,0)),U,2) ;abm*2.6*8 HEAT45044
.S:ABMCHIEN&($G(ABMR("ISA",10))'="") Z=$P($G(^ABMRECVR(ABMCHIEN,0)),U,2) ;abm*2.6*8 HEAT45044
.S:ABMCHIEN&($G(ABMR("GS",10))'="") Z=$P($G(^ABMRECVR(ABMCHIEN,0)),U,4) ;abm*2.6*8 HEAT45044
.K ABMCHIEN
S:$G(Z)="" Z=$P($G(^ABMNINS(DUZ(2),+X,1,+Y,0)),U,19)
;end new 5010
;S:Z="" Z=$P($G(^ABMNINS(DUZ(2),+X,0)),U,2) ;abm*2.6*10
S:$G(Z)="" Z=$P($G(^ABMNINS(DUZ(2),+X,0)),U,2) ;abm*2.6*10
S:Z="" Z=$P($G(^AUTTLOC(DUZ(2),0)),U,18)
Q Z
TRIM(%X,%F,%V) ;EP
;Trim spaces\char from front(left)/back(right) of string
N %R,%L S %F=$$UP^XLFSTR($G(%F,"LR")),%L=1,%R=$L(%X),%V=$G(%V," ")
I %F["R" F %R=$L(%X):-1:1 Q:$E(%X,%R)'=%V
I %F["L" F %L=1:1:$L(%X) Q:$E(%X,%L)'=%V
Q $E(%X,%L,%R)
OVER(ABMOLN) ;EP - get override values from 3P Ins file
D OVER^ABMUTLP2 ;abm*2.6*10
Q
ABMUTLP ; IHS/ASDST/DMJ - PAYER UTILITIES ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;**3,6,8,9,10,11,19,21,26**;NOV 12, 2009;Build 440
+2 ;abm*2.6*10 split into ABMUTLP2 due to routine size
+3 ;IHS/SD/SDR 2.6*19 HEAT136922 -made changes for relationship code for grandchildren, nephew, niece
+4 ;IHS/SD/SDR 2.6*19 HEAT168248 -Made changes to merge same SARs into one entry, not one for each A/R trans.
+5 ;IHS/SD/SDR 2.6*21 HEAT107645 - SBR - made change to check if insurer type K should be mcd or prvt and pull appropriate data
+6 ;IHS/SD/SDR 2.6*26 CR9265 Added code to call AUPN API to return either MBI or default to old code for HIC
+7 ;*********************
SET(X,ABMDUZ2) ; EP set up standard vars
+1 ;x=bill ien
+2 ;abmduz2=duz(2)
+3 IF '$GET(ABMDUZ2)
SET ABMDUZ2=DUZ(2)
+4 KILL ABMCDNUM
+5 SET ABMP("BDFN")=X
+6 NEW I
+7 FOR I=0:1:9
Begin DoDot:1
+8 SET @("ABMB"_I)=$GET(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),I))
End DoDot:1
+9 IF $GET(ABMB6)
FOR I=2,4
Begin DoDot:1
+10 IF $LENGTH($PIECE(ABMB6,"^",I))=1
Begin DoDot:2
+11 SET $PIECE(ABMB6,"^",I)="0"_$PIECE(ABMB6,"^",I)
End DoDot:2
End DoDot:1
+12 ;Pt IEN
SET ABMP("PDFN")=$PIECE(ABMB0,U,5)
+13 ;Visit loc IEN
SET ABMP("LDFN")=$PIECE(ABMB0,U,3)
+14 ;Bill type
SET ABMP("BTYP")=$PIECE(ABMB0,U,2)
+15 ;Exp mode IEN
SET ABMP("EXP")=$PIECE(ABMB0,U,6)
+16 ;Visit type IEN
SET ABMP("VTYP")=$PIECE(ABMB0,U,7)
+17 ;Active Ins IEN
SET ABMP("INS")=$PIECE(ABMB0,U,8)
+18 ;Clinic
SET ABMP("CLIN")=$PIECE(ABMB0,U,10)
+19 SET ABMP("CLIN")=$PIECE($GET(^DIC(40.7,+ABMP("CLIN"),0)),U,2)
+20 ;Service date from
SET ABMP("VDT")=$PIECE($GET(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),7)),U)
+21 ;S ABMP("ITYPE")=$P($G(^AUTNINS(+ABMP("INS"),2)),U) ;Type of ins ;abm*2.6*10 HEAT73780
+22 ;Type of ins ;abm*2.6*10 HEAT73780
SET ABMP("ITYPE")=$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,+ABMP("INS"),".211","I"),1,"I")
+23 SET ABMP("RTYPE")=$SELECT(ABMP("ITYPE")="R":"1G",ABMP("ITYPE")="D":"1D",$PIECE($GET(^ABMNINS(ABMDUZ2,ABMP("INS"),1,ABMP("VTYP"),1)),U)'="":$PIECE($GET(^ABMREFID($PIECE($GET(^ABMNINS(ABMDUZ2,ABMP("INS"),1,ABMP("VTYP"),1)),U),0)),U),1:"0B")
+24 IF ABMP("EXP")=22
IF ABMP("RTYPE")="1G"
SET ABMP("RTYPE")="1C"
+25 DO PCN^ABMERUTL
+26 QUIT
ISET ; EP
+1 ;Set up Insurers
+2 KILL ABMCDNUM
+3 KILL ABMP("INS")
+4 ;Active Ins IEN
SET ABMP("INS")=$PIECE(ABMB0,U,8)
+5 SET ABME("PRIO")=0
+6 SET ABME("INS#")=0
+7 ;Loop down priority
+8 FOR
SET ABME("PRIO")=$ORDER(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),13,"C",ABME("PRIO")))
IF 'ABME("PRIO")!($GET(ABMP("INS",3)))
QUIT
Begin DoDot:1
+9 NEW I
+10 SET I=0
+11 FOR
SET I=$ORDER(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),13,"C",ABME("PRIO"),I))
IF 'I!($GET(ABMP("INS",3)))
QUIT
Begin DoDot:2
+12 ;Quit if insurer unbillable
+13 ;Ins IEN
IF $PIECE(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),13,I,0),U,3)="U"
QUIT
SET ABME("INS")=$PIECE(^(0),U)
+14 ;S ABME("ITYPE")=$P(^AUTNINS(ABME("INS"),2),U) ;type insurer ;abm*2.6*10 HEAT73780
+15 ;type insurer ;abm*2.6*10 HEAT73780
SET ABME("ITYPE")=$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABME("INS"),".211","I"),1,"I")
+16 ;Quit if indian pt
IF "I"[ABME("ITYPE")
QUIT
+17 ;Quit if non-beneficiary & not active ins
+18 IF "N"[ABME("ITYPE")&($PIECE(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),0),U,8)'=ABME("INS"))
QUIT
+19 IF ABME("ITYPE")="D"!(ABME("ITYPE")="K")
Begin DoDot:3
+20 SET ABMCDNUM=$PIECE(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),13,I,0),U,6)
+21 IF '$GET(ABMP("PDFN"))
SET ABMP("PDFN")=$PIECE(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),0),U,5)
+22 IF $PIECE($GET(^AUPNMCD(+ABMCDNUM,0)),U)=ABMP("PDFN")
QUIT
+23 DO DBFX^ABMDEFIP(ABMP("BDFN"),I)
+24 SET ABMCDNUM=$PIECE(^ABMDBILL(ABMDUZ2,ABMP("BDFN"),13,I,0),U,6)
End DoDot:3
+25 ;increment cntr
SET ABME("INS#")=ABME("INS#")+1
+26 SET ABMP("INS",ABME("INS#"))=^ABMDBILL(ABMDUZ2,ABMP("BDFN"),13,I,0)
+27 SET $PIECE(ABMP("INS",ABME("INS#")),U,2)=ABME("ITYPE")
End DoDot:2
End DoDot:1
+28 QUIT
PAYED ; EP
+1 ; Build Ins Pymt Array
+2 ;abm*2.6*19 IHS/SD/SDR HEAT168248
DO PAYED^ABMUTLP2
+3 QUIT
TCR(X) ; EP
+1 ; Total credits for bill
+2 ;x=bill ien
+3 SET ABM("TCREDITS")=0
+4 SET I=0
+5 FOR
SET I=$ORDER(^ABMDBILL(ABMDUZ2,X,3,I))
IF 'I
QUIT
Begin DoDot:1
+6 FOR J=2,3,4
SET ABM("TCREDITS")=ABM("TCREDITS")+$PIECE(^ABMDBILL(ABMDUZ2,X,3,I,0),"^",J)
End DoDot:1
+7 SET X=ABM("TCREDITS")
+8 KILL ABM("TCREDITS")
+9 QUIT X
MCDBFX(X,Y) ; EP
+1 ; Fix BILL Ins Multiple if broken ptr mcd
+2 ; INPUT:X = IEN (CLAIM OR BILL)
+3 ; Y = INS IEN UNDER FIELD #13 (INS MULTIPLE)
+4 ; OUTPUT:
+5 NEW ABMP
+6 SET ABMP("D0")=X
+7 SET ABMP("D1")=Y
+8 SET ABMP("ZERO")=^ABMDBILL(ABMDUZ2,ABMP("D0"),13,ABMP("D1"),0)
+9 SET ABMP("PDFN")=$PIECE(^ABMDBILL(ABMDUZ2,ABMP("D0"),0),"^",5)
+10 SET ABMP("VDT")=$PIECE(^ABMDBILL(ABMDUZ2,ABMP("D0"),7),U)
+11 DO MGET
+12 IF $GET(ABMP(1))
SET $PIECE(^ABMDBILL(ABMDUZ2,ABMP("D0"),13,ABMP("D1"),0),U,6)=ABMP(1)
SET $PIECE(^(0),U,7)=ABMP(2)
+13 QUIT
MGET ; EP
+1 ; Get new ptr
+2 SET ABMP("INSCO")=$PIECE(ABMP("ZERO"),U)
+3 SET ABMP("PTR")=$PIECE(ABMP("ZERO"),U,6)
+4 IF ABMP("PTR")=""
QUIT
+5 IF $DATA(^AUPNMCD(ABMP("PTR"),0))
QUIT
+6 ;Q:$P($G(^AUTNINS(ABMP("INSCO"),2)),U)'="D" ;abm*2.6*10 HEAT73780
+7 ;abm*2.6*10 HEAT73780
IF $$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMP("INSCO"),".211","I"),1,"I")'="D"
QUIT
+8 DO 4^ABMDLCK2
+9 SET ABMP("PRI")=$ORDER(ABML(0))
IF 'ABMP("PRI")
QUIT
+10 SET ABMP("INS")=$ORDER(ABML(ABMP("PRI"),0))
IF 'ABMP("INS")
QUIT
+11 IF ABMP("INS")'=ABMP("INSCO")
QUIT
+12 NEW I
+13 FOR I=1,2
SET ABMP(I)=$PIECE(ABML(ABMP("PRI"),ABMP("INS")),"^",I)
+14 QUIT
SBR(X,ABMDUZ2) ;PEP - subscriber
+1 ;x=bill IEN
+2 ;abmduz2=duz(2)
+3 IF '$GET(ABMDUZ2)
SET ABMDUZ2=DUZ(2)
+4 DO SET(X,ABMDUZ2)
+5 DO ISET
+6 KILL ABMPSQ,ABMSBR
+7 NEW ABMI,ABMINS
+8 SET ABMI=0
+9 FOR
SET ABMI=$ORDER(ABMP("INS",ABMI))
IF 'ABMI
QUIT
Begin DoDot:1
+10 SET ABMINS=ABMP("INS",ABMI)
+11 IF ($PIECE(ABMINS,U)=ABMP("INS")!($PIECE(ABMINS,U,11)=ABMP("INS")))
SET ABMPSQ=ABMI
+12 DO SOP
+13 ;I $P(ABMINS,U,2)="D"!($P(ABMINS,U,2)="K") D MCD Q ;abm*2.6*21 IHS/SD/SDR HEAT107645
+14 ;start new abm*2.6*21 IHS/SD/SDR HEAT107645
+15 IF $PIECE(ABMINS,U,2)="D"
DO MCD
QUIT
+16 IF $PIECE(ABMINS,U,2)="K"
Begin DoDot:2
+17 IF $$GET1^DIQ(9999999.18,+ABMINS,".38","I")="M"
DO MCD
+18 IF $$GET1^DIQ(9999999.18,+ABMINS,".38","I")="P"
DO PRVT
End DoDot:2
QUIT
+19 ;end new abm*2.6*21 IHS/SD/SDR HEAT107645
+20 IF $PIECE(ABMINS,U,2)="R"
DO MCR
QUIT
+21 DO PRVT
End DoDot:1
+22 IF '$GET(ABMPSQ)
SET ABMPSQ=0
+23 SET ABMSBR=$GET(ABMSBR(ABMPSQ))
+24 IF '$GET(ABMSBR)
SET ABMSBR=2_"-"_ABMP("PDFN")
+25 SET ABMP("REL")=$GET(ABMP("REL",ABMPSQ))
+26 SET ABMP("PH")=$GET(ABMP("PH",ABMPSQ))
+27 SET ABMP("PNUM")=$GET(ABMP("PNUM",ABMPSQ))
+28 SET ABMP("SNUM")=$GET(ABMP("SNUM",ABMPSQ))
+29 IF ABMP("SNUM")=""
SET ABMP("SNUM")=$GET(ABMP("PNUM"))
+30 IF ABMP("PNUM")=""
SET ABMP("PNUM")=$GET(ABMP("SNUM"))
+31 SET ABMP("GRPNM")=$GET(ABMP("GRPNM",ABMPSQ))
+32 SET ABMP("GRP#")=$GET(ABMP("GRP#",ABMPSQ))
+33 SET ABMP("SOP")=$GET(ABMP("SOP",ABMPSQ))
+34 QUIT ABMSBR
MCD ;mcd
+1 SET ABMCDNUM=+$PIECE(ABMINS,U,6)
+2 SET ABMP("PH",ABMI)=+$PIECE($GET(^AUPNMCD(ABMCDNUM,0)),U,9)
+3 SET ABMP("REL",ABMI)=$PIECE($GET(^AUPNMCD(ABMCDNUM,0)),U,6)
+4 ;S ABMP("REL",ABMI)=$P($G(^AUTTRLSH(+ABMP("REL",ABMI),0)),U,5) ;abm*2.6*19 IHS/SD/SDR HEAT136922
+5 ;start new abm*2.6*19 IHS/SD/SDR HEAT136922
+6 IF "^STEP^STEPSON^STEPDAUGHTER^GRANDCHILD^CHILD^DAUGHTER^SON^NEPHEW^NIECE^STEP CHILD^"[("^"_$PIECE($GET(^AUTTRLSH(+ABMP("REL",ABMI),0)),U)_"^")
SET ABMP("REL",ABMI)=19
+7 IF '$TEST
SET ABMP("REL",ABMI)=$PIECE($GET(^AUTTRLSH(+ABMP("REL",ABMI),0)),U,5)
+8 ;end new abm*2.6*19 HEAT136922
+9 IF 'ABMP("PH",ABMI)
Begin DoDot:1
+10 SET ABMSBR(ABMI)=2_"-"_ABMP("PDFN")
+11 SET ABMP("PNUM",ABMI)=$PIECE($GET(^AUPNMCD(ABMCDNUM,0)),U,3)
+12 SET ABMP("SNUM",ABMI)=$PIECE($GET(^AUPNMCD(ABMCDNUM,0)),U,3)
+13 SET ABMP("REL",ABMI)=18
End DoDot:1
QUIT
+14 IF '$DATA(^AUPN3PPH(ABMP("PH",ABMI),0))
Begin DoDot:1
+15 SET ABMSBR(ABMI)=2_"-"_ABMP("PDFN")
+16 SET ABMP("PNUM",ABMI)=$PIECE($GET(^AUPNMCD(ABMCDNUM,0)),U,3)
+17 SET ABMP("REL",ABMI)=18
End DoDot:1
QUIT
+18 SET ABMSBR(ABMI)=3_"-"_ABMP("PH",ABMI)
+19 SET ABMP("SNUM",ABMI)=$PIECE(^AUPN3PPH(ABMP("PH",ABMI),0),U,4)
+20 DO GRP(ABMP("PH",ABMI))
+21 QUIT
PRVT ;private
+1 SET ABMIEN=+$PIECE(ABMINS,U,8)
+2 IF $PIECE($GET(^AUPNPRVT(ABMP("PDFN"),11,+ABMIEN,0)),U)=""
QUIT
+3 SET ABMP("PH",ABMI)=+$PIECE($GET(^AUPNPRVT(ABMP("PDFN"),11,+ABMIEN,0)),U,8)
+4 SET ABMP("PNUM",ABMI)=$SELECT($PIECE($GET(^AUPNPRVT(ABMP("PDFN"),11,+ABMIEN,2)),U)'="":$PIECE(^(2),U),$PIECE($GET(^AUPNPRVT(ABMP("PDFN"),11,+ABMIEN,0)),U,8)'="":$PIECE($GET(^AUPN3PPH($PIECE(...
... $GET(^AUPNPRVT(ABMP("PDFN"),11,+ABMIEN,0)),U,8),0)),U,4),1:"")
+5 IF 'ABMP("PH",ABMI)
Begin DoDot:1
+6 SET ABMSBR(ABMI)=2_"-"_ABMP("PDFN")
+7 SET ABMP("REL",ABMI)=18
End DoDot:1
QUIT
+8 SET ABMP("REL",ABMI)=+$PIECE($GET(^AUPNPRVT(ABMP("PDFN"),11,+ABMIEN,0)),U,5)
+9 ;S ABMP("REL",ABMI)=$P($G(^AUTTRLSH(+ABMP("REL",ABMI),0)),U,5) ;abm*2.6*19 IHS/SD/SDR HEAT136922
+10 ;start new abm*2.6*19 IHS/SD/SDR HEAT136922
+11 IF "^STEPSON^STEPDAUGHTER^GRANDCHILD^CHILD^DAUGHTER^SON^NEPHEW^NIECE^STEP CHILD^NIECE/NEPHEW^GRANDDAUGHTER^GRANDSON^DAUGHTER-IN-LAW^"[("^"_$PIECE($GET(^AUTTRLSH(+ABMP("REL",ABMI),0)),U)_"^")
SET ABMP("REL",ABMI)=19
+12 IF '$TEST
SET ABMP("REL",ABMI)=$PIECE($GET(^AUTTRLSH(+ABMP("REL",ABMI),0)),U,5)
+13 ;end new abm*2.6*19 HEAT136922
+14 SET ABMSBR(ABMI)=3_"-"_ABMP("PH",ABMI)
+15 ;S ABMP("SNUM",ABMI)=$P($G(^AUPN3PPH(ABMP("PH",ABMI),0)),U,4) ;abm*2.6*11 HEAT97889
+16 ;abm*2.6*11 HEAT97889
SET ABMP("SNUM",ABMI)=$SELECT($PIECE($GET(^AUPNPRVT(ABMP("PDFN"),11,+ABMIEN,2)),U)'="":$PIECE(^(2),U),1:$PIECE($GET(^AUPN3PPH(ABMP("PH",ABMI),0)),U,4))
+17 DO GRP(ABMP("PH",ABMI))
+18 QUIT
MCR ;mcr
+1 ;abm*2.6*3 HEAT12676
IF $PIECE(^AUTNINS(+ABMINS,0),U)["RAILROAD"
Begin DoDot:1
+2 ;start old abm*2.6*26 IHS/SD/SDR CR9265
+3 ;S ABMPRFX=$P($G(^AUPNRRE(ABMP("PDFN"),0)),U,3),ABMHIC=$P($G(^(0)),U,4)
+4 ;S ABMPRFX=$P($G(^AUTTRRP(+ABMPRFX,0)),U)
+5 ;S ABMP("PNUM",ABMI)=ABMPRFX_ABMHIC
+6 ;K ABMPRFX,ABMHIC
+7 ;end old start new abm*2.6*26 IHS/SD/SDR CR9265
+8 KILL ABMMBI
+9 SET ABMMBI=""
+10 SET ABMMBI=$$HISTMBI^AUPNMBI(ABMP("PDFN"),.ABMMBI)
+11 SET ABMMBI=+$ORDER(ABMMBI(999999999),-1)
+12 IF (ABMMBI'=0)
SET ABMP("PNUM",ABMI)=$PIECE(ABMMBI(ABMMBI),U)
+13 IF $GET(ABMP("PNUM",ABMI))=""
Begin DoDot:2
+14 SET ABMPRFX=$PIECE($GET(^AUPNRRE(ABMP("PDFN"),0)),U,3)
SET ABMHIC=$PIECE($GET(^(0)),U,4)
+15 SET ABMPRFX=$PIECE($GET(^AUTTRRP(+ABMPRFX,0)),U)
+16 SET ABMP("PNUM",ABMI)=ABMPRFX_ABMHIC
+17 KILL ABMPRFX,ABMHIC
End DoDot:2
+18 ;end new abm*2.6*26 IHS/SD/SDR CR9265
+19 ;start new abm*2.6*3 HEAT12676
+20 SET ABMP("SNUM",ABMI)=ABMP("PNUM",ABMI)
+21 SET ABMP("REL",ABMI)=18
+22 SET ABMP("GRP#",ABMI)=""
+23 SET ABMSBR(ABMI)=2_"-"_ABMP("PDFN")
End DoDot:1
QUIT
+24 ;end new HEAT12676
+25 ;I $P($G(^AUTNINS(+ABMINS,2)),U)="R"!($P(^AUTNINS(+ABMINS,0),U)["MEDICARE") D Q ;abm*2.6*3 HEAT12676 ;abm*2.6*10 HEAT73780
+26 ;abm*2.6*3 HEAT12676 ;abm*2.6*10 HEAT73780
IF $$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,+ABMINS,".211","I"),1,"I")="R"!($PIECE(^AUTNINS(+ABMINS,0),U)["MEDICARE")
Begin DoDot:1
+27 ;start old abm*2.6*26 IHS/SD/SDR CR9265
+28 ;S ABMHIC=$P($G(^AUPNMCR(ABMP("PDFN"),0)),U,3),ABMSUFX=$P($G(^(0)),U,4)
+29 ;S ABMSUFX=$P($G(^AUTTMCS(+ABMSUFX,0)),U)
+30 ;S ABMP("PNUM",ABMI)=ABMHIC_ABMSUFX
+31 ;K ABMHIC,ABMSUFX
+32 ;end old start new abm*2.6*26 IHS/SD/SDR CR9265
+33 KILL ABMMBI
+34 SET ABMMBI=""
+35 SET ABMMBI=$$HISTMBI^AUPNMBI(ABMP("PDFN"),.ABMMBI)
+36 SET ABMMBI=+$ORDER(ABMMBI(999999999),-1)
+37 IF (ABMMBI'=0)
SET ABMP("PNUM",ABMI)=$PIECE(ABMMBI(ABMMBI),U)
+38 IF $GET(ABMP("PNUM",ABMI))=""
Begin DoDot:2
+39 SET ABMHIC=$PIECE($GET(^AUPNMCR(ABMP("PDFN"),0)),U,3)
SET ABMSUFX=$PIECE($GET(^(0)),U,4)
+40 SET ABMSUFX=$PIECE($GET(^AUTTMCS(+ABMSUFX,0)),U)
+41 SET ABMP("PNUM",ABMI)=ABMHIC_ABMSUFX
+42 KILL ABMHIC,ABMSUFX
End DoDot:2
+43 ;end new abm*2.6*26 IHS/SD/SDR CR9265
+44 ;start new abm*2.6*3 HEAT12676
+45 SET ABMP("SNUM",ABMI)=ABMP("PNUM",ABMI)
+46 SET ABMP("REL",ABMI)=18
+47 SET ABMP("GRP#",ABMI)=""
+48 SET ABMSBR(ABMI)=2_"-"_ABMP("PDFN")
End DoDot:1
QUIT
+49 ;end new HEAT12676
+50 ;start old abm*2.6*3 HEAT12676
+51 ;S ABMP("SNUM",ABMI)=ABMP("PNUM",ABMI)
+52 ;S ABMP("REL",ABMI)=18
+53 ;S ABMP("GRP#",ABMI)=""
+54 ;S ABMSBR(ABMI)=2_"-"_ABMP("PDFN")
+55 ;end old HEAT12676
+56 QUIT
PST(X) ;EP - primary, secondary, tertiary
+1 DO SET(X)
+2 DO ISET
+3 SET ABMCNT=0
+4 SET X=""
+5 NEW I
+6 SET I=0
+7 FOR
SET I=$ORDER(ABMP("INS",I))
IF 'I
QUIT
Begin DoDot:1
+8 SET ABMCNT=ABMCNT+1
+9 IF $PIECE(ABMP("INS",I),U)=ABMP("INS")
IF $PIECE(ABMP("INS",I),U,3)="I"
SET X=ABMCNT
QUIT
End DoDot:1
+10 SET X=$SELECT(X=1:"P",X=2:"S",X=3:"T",1:"P")
+11 QUIT X
GRP(X) ;EP - group name & #
+1 ;x=policy holder ien
+2 SET ABMP("GRP#",ABMI)=""
+3 SET ABMP("GRPNM",ABMI)=""
+4 SET X=$PIECE($GET(^AUPN3PPH(+X,0)),U,6)
+5 IF $DATA(^AUTNEGRP(+X,0))
Begin DoDot:1
+6 SET ABMP("GRP#",ABMI)=$PIECE(^AUTNEGRP(X,0),U,2)
+7 SET ABMP("GRPNM",ABMI)=$PIECE(^AUTNEGRP(X,0),U)
End DoDot:1
+8 IF ABMP("GRP#",ABMI)=""
IF ABMP("GRPNM",ABMI)=""
Begin DoDot:1
+9 SET ABMP("GRPNM",ABMI)="UNKNOWN"
End DoDot:1
+10 QUIT
SNUM(X) ;EP - subscriber policy#
+1 ;x=bill ien
+2 SET ABMSBR=$$SBR(X)
+3 SET X=$GET(ABMP("SNUM"))
+4 QUIT X
PNUM(X) ;EP - patient policy#
+1 ;x=bill ien
+2 SET ABMSBR=$$SBR(X)
+3 SET X=$GET(ABMP("PNUM"))
+4 QUIT X
REL(X) ;EP - rel.
+1 ;x=bill ien
+2 SET ABMSBR=$$SBR(X)
+3 QUIT $GET(ABMP("REL"))
SOP ;EP - source of pay (claim filing indicator)
+1 ;abm*2.6*10
DO SOP^ABMUTLP2
+2 QUIT
MPP(X) ;EP - medicare primary payer
+1 ;x=bill ien
+2 IF X=""
QUIT 0
+3 NEW ABMIEN
+4 SET ABMIEN=X
+5 IF '$DATA(^ABMDBILL(DUZ(2),ABMIEN))
QUIT 0
+6 NEW ABMPINS,ABMPTYP
+7 SET ABMPINS=$PIECE(^ABMDBILL(DUZ(2),ABMIEN,0),U,8)
+8 ;S ABMPTYP=$P($G(^AUTNINS(+ABMPINS,2)),U) ;abm*2.6*10 HEAT73780
+9 ;abm*2.6*10 HEAT73780
SET ABMPTYP=$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,+ABMPINS,".211","I"),1,"I")
+10 IF $GET(ABMPTYP)'="R"
QUIT 0
+11 NEW I
+12 SET I=0
+13 NEW ABMMPP
+14 SET ABMMPP=1
+15 FOR
SET I=$ORDER(^ABMDBILL(DUZ(2),ABMIEN,13,I))
IF 'I
QUIT
Begin DoDot:1
+16 NEW ABMX0
+17 SET ABMX0=^ABMDBILL(DUZ(2),ABMIEN,13,I,0)
+18 IF $PIECE(ABMX0,U)=ABMPINS
QUIT
+19 IF $PIECE(ABMX0,U,3)'="C"
QUIT
+20 SET ABMMPP=0
End DoDot:1
+21 QUIT ABMMPP
RCID(X) ;EP - receiver id
+1 ;x=insurer
+2 KILL Y
+3 SET X=$GET(X)
+4 ;start new abm*2.6*6 5010
+5 IF $DATA(^ABMRECVR("C",X))
Begin DoDot:1
+6 ;abm*2.6*9 HEAT55022
IF $GET(ABMLOOP)="2330B"
QUIT
+7 SET ABMCHIEN=$ORDER(^ABMRECVR("C",X,0))
+8 ;S:ABMCHIEN Y=$P($G(^ABMRECVR(ABMCHIEN,0)),U,2) ;abm*2.6*8
+9 ;abm*2.6*8
IF ABMCHIEN
SET Y=$PIECE($GET(^ABMRECVR(ABMCHIEN,0)),U,3)
+10 KILL ABMCHIEN
End DoDot:1
+11 IF $GET(Y)
QUIT Y
+12 ;end new 5010
+13 ;I $P($G(^AUTNINS(+X,2)),U)="R" S Y=$P($G(^ABMDPARM(DUZ(2),1,5)),U,3) ;abm*2.6*10 HEAT73780
+14 ;abm*2.6*10 HEAT73780
IF $$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,+X,".211","I"),1,"I")="R"
SET Y=$PIECE($GET(^ABMDPARM(DUZ(2),1,5)),U,3)
+15 IF $GET(Y)=""
SET Y=$PIECE($GET(^AUTNINS(+X,2)),U,12)
+16 IF $GET(Y)=""
SET Y=$$RCID^ABMERUTL(X)
+17 QUIT Y
SNDR(X,Y) ;EP - sender id
+1 ;x=insurer
+2 ;y=visit type
+3 SET X=$GET(X)
+4 SET Y=$GET(Y)
+5 ;abm*2.6*10
NEW Z
+6 ;S Z=$P($G(^ABMNINS(DUZ(2),+X,1,+Y,0)),U,19) ;abm*2.6*6 5010
+7 ;start new abm*2.6*6 5010
+8 IF $DATA(^ABMRECVR("C",X))
Begin DoDot:1
+9 SET ABMCHIEN=$ORDER(^ABMRECVR("C",X,0))
+10 ;S:ABMCHIEN Z=$P($G(^ABMRECVR(ABMCHIEN,0)),U,2) ;abm*2.6*8 HEAT45044
+11 ;abm*2.6*8 HEAT45044
IF ABMCHIEN&($GET(ABMR("ISA",10))'="")
SET Z=$PIECE($GET(^ABMRECVR(ABMCHIEN,0)),U,2)
+12 ;abm*2.6*8 HEAT45044
IF ABMCHIEN&($GET(ABMR("GS",10))'="")
SET Z=$PIECE($GET(^ABMRECVR(ABMCHIEN,0)),U,4)
+13 KILL ABMCHIEN
End DoDot:1
+14 IF $GET(Z)=""
SET Z=$PIECE($GET(^ABMNINS(DUZ(2),+X,1,+Y,0)),U,19)
+15 ;end new 5010
+16 ;S:Z="" Z=$P($G(^ABMNINS(DUZ(2),+X,0)),U,2) ;abm*2.6*10
+17 ;abm*2.6*10
IF $GET(Z)=""
SET Z=$PIECE($GET(^ABMNINS(DUZ(2),+X,0)),U,2)
+18 IF Z=""
SET Z=$PIECE($GET(^AUTTLOC(DUZ(2),0)),U,18)
+19 QUIT Z
TRIM(%X,%F,%V) ;EP
+1 ;Trim spaces\char from front(left)/back(right) of string
+2 NEW %R,%L
SET %F=$$UP^XLFSTR($GET(%F,"LR"))
SET %L=1
SET %R=$LENGTH(%X)
SET %V=$GET(%V," ")
+3 IF %F["R"
FOR %R=$LENGTH(%X):-1:1
IF $EXTRACT(%X,%R)'=%V
QUIT
+4 IF %F["L"
FOR %L=1:1:$LENGTH(%X)
IF $EXTRACT(%X,%L)'=%V
QUIT
+5 QUIT $EXTRACT(%X,%L,%R)
OVER(ABMOLN) ;EP - get override values from 3P Ins file
+1 ;abm*2.6*10
DO OVER^ABMUTLP2
+2 QUIT
