ABMDF29A ; IHS/ASDST/DMJ - ADA 2006 Dental Export -part 2 ;
;;2.6;IHS 3P BILLING SYSTEM;**3,6,8**;NOV 12, 2009
; IHS/SD/SDR-v2.5 p12 - IM25183/IM25226
; Fix for <UNDEFINED>INS+13^ABMDF29A when no 2ndary insurer
; IHS/SD/SDR-v2.5 p12 - NO IM
; check box for EPSDT when Medicaid & vtyp desc contains EPSDT
; IHS/SD/SDR-v2.5 p12 - IM25568 - Correction to FL 52a
; Also removed old code due to space issue
; IHS/SD/SDR,AML-v2.5 p13 - IM26018 - Programming error at Santa Fe
; IHS/SD/SDR-abm*2.6*1 HEAT2948 - secondary info not printing correctly
; IHS/SD/SDR-abm*2.6*1 HEAT5760 - use ROI/AOB dates, not today, for 36 & 37
; IHS/SD/SDR-abm*2.6*1 HEAT6673 - Fixed prior auth to use N5,P12
; IHS/SD/PMT-abm*2.6*3 HEAT8604 - moved whole form up one line
; IHS/SD/SDR - abm*2.6*6 - HEAT26023 - Added coding for San Felipe clinic
; IHS/SD/SDR - abm*2.6*6 - NOHEAT - AIDC local mods
;********************************************
ENT ; EP for getting data
S ABMP("B0")=^ABMDBILL(DUZ(2),ABMP("BDFN"),0) ;3P Bill 0 node
S ABMP("INS")=$P(ABMP("B0"),U,8) ;Active ins
S ABMP("PDFN")=$P(ABMP("B0"),U,5) ;Pt IEN
S ABMP("LDFN")=$P(ABMP("B0"),U,3) ;Loc IEN
S ABMP("VTYP")=$P(ABMP("B0"),U,7) ;VTyp
S ABMP("BTYP")=$P(ABMP("B0"),U,2) ;BTyp
Q:'ABMP("PDFN")!'ABMP("LDFN")!'ABMP("INS")
S ABMP("VDT")=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),7),U) ;Vst Dt
BADDR ;
; Billing Addr
S ABM("J")=ABMP("BDFN")
S ABM("I")=$P(^AUTNINS(ABMP("INS"),0),U)_"-"_ABMP("INS")
S ABM("INS",ABM("I"),ABM("J"))=""
I $P($G(^AUTNINS(ABMP("INS"),2)),U)="N" D
.S ABM("INS",ABM("I"),ABM("J"))=ABMP("PDFN")
S ABM("IDFN")=ABMP("INS")
D BADDR^ABMDLBL1
G PAT:'$D(ABM("ADD"))
;S ABMF(8)=$P(ABM("ADD"),U,1) ;Ins Name(3) ;HEAT8604
S ABMF(7)=$P(ABM("ADD"),U,1) ;Ins Name(3) ;HEAT8604
;S ABMF(9)=$P(ABM("ADD"),U,2) ;Ins Addr(3) ;HEAT8604
S ABMF(8)=$P(ABM("ADD"),U,2) ;Ins Addr(3) ;HEAT8604
;S ABMF(10)=$P(ABMCSZ,U) ;City(3) ;HEAT8604
S ABMF(9)=$P(ABMCSZ,U) ;City(3) ;HEAT8604
S ABMSTATE=$P(ABMCSZ,U,2) ;St(3)
;S ABMF(10)=ABMF(10)_", "_$P($G(^DIC(5,+ABMSTATE,0)),U,2) ;HEAT8604
S ABMF(9)=ABMF(9)_", "_$P($G(^DIC(5,+ABMSTATE,0)),U,2) ;HEAT8604
;S ABMF(10)=ABMF(10)_" "_$P(ABMCSZ,U,3) ;Zip(3) ;HEAT8604
S ABMF(9)=ABMF(9)_" "_$P(ABMCSZ,U,3) ;Zip(3) ;HEAT8604
K ABMCSZ,ABMSTATE
;2ndary info
S ABMPIIEN=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,"B",ABMP("INS"),0))
K ABMSCNT,ABMSINS,ABMP("INS2")
I +$G(ABMPIIEN)'=0 D
.S ABMPINS=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABMPIIEN,0)),U,2) ;get priority of active ins
.S ABMIFLG=0
.S ABMSCNT=ABMPINS
.F S ABMSCNT=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,"C",ABMSCNT)) Q:+ABMSCNT=0 D Q:ABMIFLG=1
..S ABMSINS=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,"C",ABMSCNT,0))
..;I $P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABMSINS,0)),U,3)="U" Q ;unbillable ;abm*2.6*8
..I $P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABMSINS,0)),U,3)="U" K ABMSINS Q ;unbillable ;abm*2.6*8
..S ABMIFLG=1
I $G(ABMSINS)'="" S ABMP("INS2")=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABMSINS,0)),U)
I $G(ABMP("INS2"))'="" D
.S ABMPISAV=ABMP("INS")
.S ABMP("INS")=ABMP("INS2")
.S ABM("J")=ABMP("BDFN")
.S ABM("I")=$P(^AUTNINS(ABMP("INS"),0),U)_"-"_ABMP("INS")
.S ABM("INS",ABM("I"),ABM("J"))=""
.I $P($G(^AUTNINS(ABMP("INS"),2)),U)="N" D
..S ABM("INS",ABM("I"),ABM("J"))=ABMP("PDFN")
.S ABM("IDFN")=ABMP("INS")
.D BADDR^ABMDLBL1
.G PAT:'$D(ABM("ADD"))
.;S $P(ABMF(21),U)=$P(ABM("ADD"),U,1) ;2ndary Name(11) ;HEAT8604
.S $P(ABMF(20),U)=$P(ABM("ADD"),U,1) ;2ndary Name(11) ;HEAT8604
.;S $P(ABMF(22),U)=$P(ABM("ADD"),U,2) ;2ndary Addr(11) ;HEAT8604
.S $P(ABMF(21),U)=$P(ABM("ADD"),U,2) ;2ndary Addr(11) ;HEAT8604
.;S $P(ABMF(23),U)=$P(ABMCSZ,U) ;2ndary City(11) ;HEAT8604
.S $P(ABMF(22),U)=$P(ABMCSZ,U) ;2ndary City(11) ;HEAT8604
.S ABMSTATE=$P(ABMCSZ,U,2) ;2ndary ST(11)
.;S $P(ABMF(23),U)=$P(ABMF(23),U)_", "_$P($G(^DIC(5,+ABMSTATE,0)),U,2) ;2ndary ST(11) ;HEAT8604
.S $P(ABMF(22),U)=$P(ABMF(22),U)_", "_$P($G(^DIC(5,+ABMSTATE,0)),U,2) ;2ndary ST(11) ;HEAT8604
.;S $P(ABMF(23),U)=$P(ABMF(23),U)_" "_$P(ABMCSZ,U,3) ;2ndary Zip(11) ;HEAT8604
.S $P(ABMF(22),U)=$P(ABMF(22),U)_" "_$P(ABMCSZ,U,3) ;2ndary Zip(11) ;HEAT8604
.K ABMCSZ,ABMSTATE
.S ABMP("INS")=ABMPISAV
.;2ndary grp#(9)
.I $P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABMSINS,0)),U,4) S ABMX("PH")=ABMP("PDFN")
.I $P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABMSINS,0)),U,5) S ABMX("PH")=ABMP("PDFN")
.I $P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABMSINS,0)),U,6) S ABMX("PH")=$P($G(^AUPNMCD($P(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABMSINS,0),U,6),0)),U,9)
.I $P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABMSINS,0)),U,8),($P($G(^AUPNPRVT(ABMP("PDFN"),11,$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABMSINS,0),U,8),0)),U,8)'="") D
..S ABMX("PH")=$P(^AUPNPRVT(ABMP("PDFN"),11,$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABMSINS,0),U,8),0),U,8)
.I +$G(ABMX("PH"))'=0 D
..S ABMX("GRP")=$P($G(^AUPN3PPH(+ABMX("PH"),0)),U,6)
..;I $P($G(^AUPN3PPH(+ABMX("PH"),0)),U,8)="M" S $P(ABMF(17),U,2)="X" ;sex(7) ;HEAT8604
..I $P($G(^AUPN3PPH(+ABMX("PH"),0)),U,8)="M" S $P(ABMF(16),U,2)="X" ;sex(7) ;HEAT8604
..;I $P($G(^AUPN3PPH(+ABMX("PH"),0)),U,8)="F" S $P(ABMF(17),U,3)="X" ;sex(7) ;HEAT8604
..I $P($G(^AUPN3PPH(+ABMX("PH"),0)),U,8)="F" S $P(ABMF(16),U,3)="X" ;sex(7) ;HEAT8604
..;S $P(ABMF(17),U,4)=$P($G(^AUPN3PPH(+ABMX("PH"),0)),U,4) ;Pol#(8) ;HEAT8604
..S $P(ABMF(16),U,4)=$P($G(^AUPN3PPH(+ABMX("PH"),0)),U,4) ;Pol#(8) ;HEAT8604
..;start new code abm*2.6*1 HEAT2948
..;rel (10)
..I $P($G(^AUTNINS(ABMP("INS2"),2)),U)="P" D
...S ABMSINS=$O(^AUPNPRVT(ABMP("PDFN"),11,"B",ABMP("INS2"),0))
...S ABMP("REL")=$P($G(^AUTTRLSH($P($G(^AUPNPRVT(ABMP("PDFN"),11,ABMSINS,0)),U,5),0)),U,5)
...;I ABMP("REL")=18 S $P(ABMF(19),U,2)="X" ;HEAT8604
...I ABMP("REL")=17 S $P(ABMF(18),U,2)="X" ;HEAT8604
...;I ABMP("REL")="01" S $P(ABMF(19),U,3)="X" ;HEAT8604
...I ABMP("REL")="01" S $P(ABMF(18),U,3)="X" ;HEAT8604
...;I ABMP("REL")=19 S $P(ABMF(19),U,4)="X" ;HEAT8604
...I ABMP("REL")=18 S $P(ABMF(18),U,4)="X" ;HEAT8604
...;I ABMP("REL")'=18&(ABMP("REL")'=19)&(ABMP("REL")'="01") S $P(ABMF(19),U,5)="X" ;HEAT8604
...I ABMP("REL")'=17&(ABMP("REL")'=18)&(ABMP("REL")'="01") S $P(ABMF(18),U,5)="X" ;HEAT8604
..;end new code HEAT2948
.I $P($G(^AUTNINS(ABMP("INS2"),2)),U)="D" D
..;I $P($G(^DPT(+ABMP("PDFN"),0)),U,2)="M" S $P(ABMF(16),U,2)="X" ;sex(7) ;HEAT8604
..I $P($G(^DPT(+ABMP("PDFN"),0)),U,2)="M" S $P(ABMF(16),U,2)="X" ;sex(7) ;HEAT8604
..;I $P($G(^DPT(+ABMP("PDFN"),0)),U,2)="F" S $P(ABMF(17),U,3)="X" ;sex(7) ;HEAT8604
..I $P($G(^DPT(+ABMP("PDFN"),0)),U,2)="F" S $P(ABMF(16),U,3)="X" ;sex(7) ;HEAT8604
..;S:(+$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABMSINS,0)),U,6)'=0) $P(ABMF(17),U,4)=$P($G(^AUPNMCD($P(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABMSINS,0),U,6),0)),U,3) ;Policy#(8) ;HEAT8604
..S:(+$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABMSINS,0)),U,6)'=0) $P(ABMF(16),U,4)=$P($G(^AUPNMCD($P(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABMSINS,0),U,6),0)),U,3) ;Policy#(8) ;HEAT8604
..;S $P(ABMF(19),U,2)="X" ;rel.(10) ;HEAT8604
..S $P(ABMF(18),U,2)="X" ;rel.(10) ;HEAT8604
.I $G(ABMX("GRP"))'="" D
..I $D(^AUTNEGRP(ABMX("GRP"),0)) D
...;S $P(ABMF(19),U)=$S($D(^AUTNEGRP(ABMX("GRP"),11,ABMP("VTYP"),0)):$P(^(0),U,2),1:$P(^AUTNEGRP(ABMX("GRP"),0),U,2)) ;HEAT8604
...S $P(ABMF(18),U)=$S($D(^AUTNEGRP(ABMX("GRP"),11,ABMP("VTYP"),0)):$P(^(0),U,2),1:$P(^AUTNEGRP(ABMX("GRP"),0),U,2)) ;HEAT8604
PAT ;Pt Info
D PAT^ABMDF29B
LOC ;loc info
;S $P(ABMF(55),U)=$S($P(ABMV("X1"),U,2)]"":$P(ABMV("X1"),U,2),1:$P($P(ABMV("X1"),U),";",2)) ;billing entity name(48) ;HEAT8604
S $P(ABMF(54),U)=$S($P(ABMV("X1"),U,2)]"":$P(ABMV("X1"),U,2),1:$P($P(ABMV("X1"),U),";",2)) ;billing entity name(48) ;HEAT8604
;S $P(ABMF(56),U)=$P(ABMV("X1"),U,3) ;addr(48) ;HEAT8604
S $P(ABMF(55),U)=$P(ABMV("X1"),U,3) ;addr(48) ;HEAT8604
I DUZ(2)=1581 S $P(ABMF(55),U)="PO BOX 4342" ;abm*2.6*6 HEAT26023
S ABMCSZ=$P(ABMV("X1"),U,4)
;S $P(ABMF(57),U)=$P(ABMCSZ,",",1) ;City(48) ;HEAT8604
S $P(ABMF(56),U)=$P(ABMCSZ,",",1) ;City(48) ;HEAT8604
S ABMCSZ=$P(ABMCSZ,",",2)
;S $P(ABMF(57),U)=$P(ABMF(57),U)_", "_$P(ABMCSZ," ",2) ;ST(48) ;HEAT8604
S $P(ABMF(56),U)=$P(ABMF(56),U)_", "_$P(ABMCSZ," ",2) ;ST(48) ;HEAT8604
;S $P(ABMF(57),U)=$P(ABMF(57),U)_" "_$P(ABMCSZ," ",4) ;zip(48) ;HEAT8604
S $P(ABMF(56),U)=$P(ABMF(56),U)_" "_$P(ABMCSZ," ",4) ;zip(48) ;HEAT8604
I DUZ(2)=1581 S $P(ABMF(56),U)="San Felipe Pueblo, NM 87001" ;abm*2.6*6 HEAT26023
;
I $P($G(^AUTNINS(ABMP("INS"),0)),U)["DELTA DENTAL" D
.;S $P(ABMF(56),U)=$P($G(^DIC(4,ABMP("LDFN"),1)),U) ;addr(48) ;HEAT8604
.S $P(ABMF(55),U)=$P($G(^DIC(4,ABMP("LDFN"),1)),U) ;addr(48) ;HEAT8604
.;S $P(ABMF(57),U)=$P($G(^DIC(4,ABMP("LDFN"),1)),U,3) ;city(48) ;HEAT8604
.S $P(ABMF(56),U)=$P($G(^DIC(4,ABMP("LDFN"),1)),U,3) ;city(48) ;HEAT8604
.S ABMX("STATE")=$P($G(^DIC(4,ABMP("LDFN"),0)),U,2) ;st(48)
.S ABMX("STATE")=$P($G(^DIC(5,+ABMX("STATE"),0)),U,2)
.I ABMX("STATE")'="" D
..;S $P(ABMF(57),U)=$P(ABMF(57),U)_", "_ABMX("STATE")_" "_$P($G(^DIC(4,ABMP("LDFN"),1)),U,4) ;zip(48) ;HEAT8604
..S $P(ABMF(56),U)=$P(ABMF(56),U)_", "_ABMX("STATE")_" "_$P($G(^DIC(4,ABMP("LDFN"),1)),U,4) ;zip(48) ;HEAT8604
.;start new code abm*2.6*6 NOHEAT
.I $P($G(^AUTTLOC(ABMP("LDFN"),0)),U,2)="AIDC" D
..S $P(ABMF(55),U)="P.O. Box 31001-0674" ;addr(48)
..S $P(ABMF(56),U)="Pasadena, CA 91110-0674" ;city(48)
.;end new code NOHEAT
K ABMCSZ
;S $P(ABMF(60),U,3)=$P(ABMV("X1"),U,6) ;SSN/TIN(51) ;HEAT8604
S $P(ABMF(59),U,3)=$P(ABMV("X1"),U,6) ;SSN/TIN(51) ;HEAT8604
I DUZ(2)=1581 S $P(ABMF(59),U,3)="850210848" ;abm*2.6*6 HEAT26023
;S $P(ABMF(61),U,1)=$P(ABMV("X1"),U,5) ;Phone(52) ;HEAT8604
S $P(ABMF(60),U,1)=$P(ABMV("X1"),U,5) ;Phone(52) ;HEAT8604
;S $P(ABMF(61),U,1)=$P(ABMV("X1"),U,5) ;Phone(52) ;HEAT8604
S $P(ABMF(60),U,1)=$P(ABMV("X1"),U,5) ;Phone(52) ;HEAT8604
S ABMLOC=$P(ABMP("B0"),U,3)
S ABMV("X1")=$G(^AUTTLOC(ABMLOC,0))
;start new abm*2.6*3 HEAT13493
S $P(ABMF(58),U)=$P($G(^DIC(4,ABMP("LDFN"),1)),U) ;addr(56)
S $P(ABMF(59),U,4)=$P($G(^DIC(4,ABMP("LDFN"),1)),U,3) ;city(56)
S ABMX("STATE")=$P($G(^DIC(4,ABMP("LDFN"),0)),U,2) ;st(56)
S ABMX("STATE")=$P($G(^DIC(5,+ABMX("STATE"),0)),U,2)
I ABMX("STATE")'="" D
.S $P(ABMF(59),U,4)=$P(ABMF(59),U,4)_", "_ABMX("STATE")_" "_$P($G(^DIC(4,ABMP("LDFN"),1)),U,4) ;zip(56)
;end new HEAT13493
;S $P(ABMF(59),U)=$P(ABMV("X1"),U,12) ;addr(56) ;HEAT8604
;S $P(ABMF(60),U,4)=$P(ABMV("X1"),U,13) ;city(56) ;HEAT8604
;S $P(ABMF(60),U,4)=$P(ABMF(60),U,4)_", "_$P(^DIC(5,ABML,0),U,2) ;st(56) ;HEAT8604
;S $P(ABMF(60),U,4)=$P(ABMF(60),U,4)_" "_$P(ABMV("X1"),U,15) ;zip(56) ;HEAT8604
I $P(ABMF(58),U)="" D ;default to mailing address if no physical address ;abm*2.6*3 HEAT13493
.S $P(ABMF(58),U)=$P(ABMV("X1"),U,12) ;addr(56) ;HEAT8604 & HEAT13493
.S $P(ABMF(59),U,4)=$P(ABMV("X1"),U,13) ;city(56) ;HEAT8604 * HEAT13493
.S ABML=$P(ABMV("X1"),U,14)
.S $P(ABMF(59),U,4)=$P(ABMF(59),U,4)_", "_$P(^DIC(5,ABML,0),U,2) ;st(56) ;HEAT8604 & HEAT13493
.S $P(ABMF(59),U,4)=$P(ABMF(59),U,4)_" "_$P(ABMV("X1"),U,15) ;zip(56) ;HEAT8604 & HEAT13493
S ABMLNPI=$S($P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,8)'="":$P(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1),U,8),$P($G(^ABMDPARM(ABMP("LDFN"),1,2)),U,12)'="":$P(^ABMDPARM(ABMP("LDFN"),1,2),U,12),1:ABMP("LDFN"))
;S $P(ABMF(60),U)=$S($P($$NPI^XUSNPI("Organization_ID",ABMLNPI),U)>0:$P($$NPI^XUSNPI("Organization_ID",ABMLNPI),U),1:"") ;Location NPI (49) ;HEAT8604
S $P(ABMF(59),U)=$S($P($$NPI^XUSNPI("Organization_ID",ABMLNPI),U)>0:$P($$NPI^XUSNPI("Organization_ID",ABMLNPI),U),1:"") ;Location NPI (49) ;HEAT8604
I DUZ(2)=1581 S $P(ABMF(59),U)="1265511299" ;abm*2.6*6 HEAT26023
I ABMP("LDFN")=5440 D ;Klamath
.;S $P(ABMF(59),U)="330 Chiloquin BLVD" ;addr(56) ;HEAT8604
.S $P(ABMF(58),U)="330 Chiloquin BLVD" ;addr(56) ;HEAT8604
.;S $P(ABMF(60),U,4)="Chiloquin" ;city(56) ;HEAT8604
.S $P(ABMF(59),U,4)="Chiloquin" ;city(56) ;HEAT8604
.S ABMX("STATE")="Oregon" ;st(56)
.;S $P(ABMF(60),U,4)=$P(ABMF(60),U,4)_", "_ABMX("STATE")_" 97624" ;zip(56) ;HEAT8604
.S $P(ABMF(59),U,4)=$P(ABMF(59),U,4)_", "_ABMX("STATE")_" 97624" ;zip(56) ;HEAT8604
;start old abm*2.6*3 HEAT13493
;I $P($G(^AUTNINS(ABMP("INS"),0)),U)["DELTA DENTAL" D
;.;S $P(ABMF(59),U)=$P($G(^DIC(4,ABMP("LDFN"),1)),U) ;addr(56) ;HEAT8604
;.S $P(ABMF(58),U)=$P($G(^DIC(4,ABMP("LDFN"),1)),U) ;addr(56) ;HEAT8604
;.;S $P(ABMF(60),U,4)=$P($G(^DIC(4,ABMP("LDFN"),1)),U,3) ;city(56) ;HEAT8604
;.S $P(ABMF(59),U,4)=$P($G(^DIC(4,ABMP("LDFN"),1)),U,3) ;city(56) ;HEAT8604
;.S ABMX("STATE")=$P($G(^DIC(4,ABMP("LDFN"),0)),U,2) ;st(56)
;.S ABMX("STATE")=$P($G(^DIC(5,+ABMX("STATE"),0)),U,2)
;.I ABMX("STATE")'="" D
;..;S $P(ABMF(60),U,4)=$P(ABMF(60),U,4)_", "_ABMX("STATE")_" "_$P($G(^DIC(4,ABMP("LDFN"),1)),U,4) ;zip(56) ;HEAT8604
;..S $P(ABMF(59),U,4)=$P(ABMF(59),U,4)_", "_ABMX("STATE")_" "_$P($G(^DIC(4,ABMP("LDFN"),1)),U,4) ;zip(56) ;HEAT8604
;end old HEAT13493
INSNUM ;Ins Info
S ABM("INUM")=$P($G(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,$P(ABMP("B0"),U,7),0)),U,8)
S:ABM("INUM")="" ABM("INUM")=$P($G(^AUTNINS(ABMP("INS"),15,ABMP("LDFN"),0)),U,2)
I ABM("INUM")="" D
.S ABMPRV=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,"C","A",0))
.S:ABMPRV ABMPRV=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,ABMPRV,0)),U)
.S:ABMPRV ABM("INUM")=$P($G(^VA(200,ABMPRV,9999999.18,ABMP("INS"),0)),U,2)
;S $P(ABMF(60),U,2)=ABM("INUM") ;Dent Lic(55) ;HEAT8604
S $P(ABMF(59),U,2)=ABM("INUM") ;Dent Lic(55) ;HEAT8604
S ABMP("ITYP")=$P($G(^AUTNINS(ABMP("INS"),2)),U) ;Ins.type
I ABMP("ITYP")="D" D
.S ABMMCD=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABMP("INS"),0)),U,6)
PRV ;Prov?
D PRV^ABMDF29B
POL ;Pol. Info
D POL^ABMDF29B
EMPL ;Emp. info
;I ABMP("ITYP")'="P" S $P(ABMF(13),U,4)=$P(ABMV("X3"),U) ;Employer name(17) ;HEAT8604
I ABMP("ITYP")'="P" S $P(ABMF(12),U,4)=$P(ABMV("X3"),U) ;Employer name(17) ;HEAT8604
E D
.S ABMP("PH")=$P(ABMV("X2"),U)
.S ABMEMPL=$P($G(^AUPN3PPH(+ABMP("PH"),0)),U,16)
.;S:+ABMEMPL $P(ABMF(13),U,4)=$P($G(^AUTNEMPL(ABMEMPL,0)),U) ;HEAT8604
.S:+ABMEMPL $P(ABMF(12),U,4)=$P($G(^AUTNEMPL(ABMEMPL,0)),U) ;HEAT8604
;S $P(ABMF(13),U,3)=$P(ABMV("X3"),U,7) ;Grp#(16) ;HEAT8604
S $P(ABMF(12),U,3)=$P(ABMV("X3"),U,7) ;Grp#(16) ;HEAT8604
REL ;Rel
G INS:'$P(ABMV("X2"),U,2)
S ABM=+$P($G(^AUTTRLSH(+$P(ABMV("X2"),U,2),0)),U,2)
;I ABM,ABM<8,ABM'=2 S $P(ABMF(16),U,$S(ABM=1:1,ABM=3:3,1:4))="X" ;Rel to subscbr(18) ;HEAT8604
I ABM,ABM<8,ABM'=2 S $P(ABMF(15),U,$S(ABM=1:1,ABM=3:3,1:4))="X" ;Rel to subscbr(18) ;HEAT8604
;E S $P(ABMF(16),U,$S(ABM=2:2,ABM=1:1,1:4))="X" ;HEAT8604
E S $P(ABMF(15),U,$S(ABM=2:2,ABM=1:1,1:4))="X" ;HEAT8604
INS ;
D ^ABMDF29B ;abm*2.6*1-split rtn due to size
XIT ;
K ABM,ABMV
Q
ABMDF29A ; IHS/ASDST/DMJ - ADA 2006 Dental Export -part 2 ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;**3,6,8**;NOV 12, 2009
+2 ; IHS/SD/SDR-v2.5 p12 - IM25183/IM25226
+3 ; Fix for <UNDEFINED>INS+13^ABMDF29A when no 2ndary insurer
+4 ; IHS/SD/SDR-v2.5 p12 - NO IM
+5 ; check box for EPSDT when Medicaid & vtyp desc contains EPSDT
+6 ; IHS/SD/SDR-v2.5 p12 - IM25568 - Correction to FL 52a
+7 ; Also removed old code due to space issue
+8 ; IHS/SD/SDR,AML-v2.5 p13 - IM26018 - Programming error at Santa Fe
+9 ; IHS/SD/SDR-abm*2.6*1 HEAT2948 - secondary info not printing correctly
+10 ; IHS/SD/SDR-abm*2.6*1 HEAT5760 - use ROI/AOB dates, not today, for 36 & 37
+11 ; IHS/SD/SDR-abm*2.6*1 HEAT6673 - Fixed prior auth to use N5,P12
+12 ; IHS/SD/PMT-abm*2.6*3 HEAT8604 - moved whole form up one line
+13 ; IHS/SD/SDR - abm*2.6*6 - HEAT26023 - Added coding for San Felipe clinic
+14 ; IHS/SD/SDR - abm*2.6*6 - NOHEAT - AIDC local mods
+15 ;********************************************
ENT ; EP for getting data
+1 ;3P Bill 0 node
SET ABMP("B0")=^ABMDBILL(DUZ(2),ABMP("BDFN"),0)
+2 ;Active ins
SET ABMP("INS")=$PIECE(ABMP("B0"),U,8)
+3 ;Pt IEN
SET ABMP("PDFN")=$PIECE(ABMP("B0"),U,5)
+4 ;Loc IEN
SET ABMP("LDFN")=$PIECE(ABMP("B0"),U,3)
+5 ;VTyp
SET ABMP("VTYP")=$PIECE(ABMP("B0"),U,7)
+6 ;BTyp
SET ABMP("BTYP")=$PIECE(ABMP("B0"),U,2)
+7 IF 'ABMP("PDFN")!'ABMP("LDFN")!'ABMP("INS")
QUIT
+8 ;Vst Dt
SET ABMP("VDT")=$PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),7),U)
BADDR ;
+1 ; Billing Addr
+2 SET ABM("J")=ABMP("BDFN")
+3 SET ABM("I")=$PIECE(^AUTNINS(ABMP("INS"),0),U)_"-"_ABMP("INS")
+4 SET ABM("INS",ABM("I"),ABM("J"))=""
+5 IF $PIECE($GET(^AUTNINS(ABMP("INS"),2)),U)="N"
Begin DoDot:1
+6 SET ABM("INS",ABM("I"),ABM("J"))=ABMP("PDFN")
End DoDot:1
+7 SET ABM("IDFN")=ABMP("INS")
+8 DO BADDR^ABMDLBL1
+9 IF '$DATA(ABM("ADD"))
GOTO PAT
+10 ;S ABMF(8)=$P(ABM("ADD"),U,1) ;Ins Name(3) ;HEAT8604
+11 ;Ins Name(3) ;HEAT8604
SET ABMF(7)=$PIECE(ABM("ADD"),U,1)
+12 ;S ABMF(9)=$P(ABM("ADD"),U,2) ;Ins Addr(3) ;HEAT8604
+13 ;Ins Addr(3) ;HEAT8604
SET ABMF(8)=$PIECE(ABM("ADD"),U,2)
+14 ;S ABMF(10)=$P(ABMCSZ,U) ;City(3) ;HEAT8604
+15 ;City(3) ;HEAT8604
SET ABMF(9)=$PIECE(ABMCSZ,U)
+16 ;St(3)
SET ABMSTATE=$PIECE(ABMCSZ,U,2)
+17 ;S ABMF(10)=ABMF(10)_", "_$P($G(^DIC(5,+ABMSTATE,0)),U,2) ;HEAT8604
+18 ;HEAT8604
SET ABMF(9)=ABMF(9)_", "_$PIECE($GET(^DIC(5,+ABMSTATE,0)),U,2)
+19 ;S ABMF(10)=ABMF(10)_" "_$P(ABMCSZ,U,3) ;Zip(3) ;HEAT8604
+20 ;Zip(3) ;HEAT8604
SET ABMF(9)=ABMF(9)_" "_$PIECE(ABMCSZ,U,3)
+21 KILL ABMCSZ,ABMSTATE
+22 ;2ndary info
+23 SET ABMPIIEN=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,"B",ABMP("INS"),0))
+24 KILL ABMSCNT,ABMSINS,ABMP("INS2")
+25 IF +$GET(ABMPIIEN)'=0
Begin DoDot:1
+26 ;get priority of active ins
SET ABMPINS=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABMPIIEN,0)),U,2)
+27 SET ABMIFLG=0
+28 SET ABMSCNT=ABMPINS
+29 FOR
SET ABMSCNT=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,"C",ABMSCNT))
IF +ABMSCNT=0
QUIT
Begin DoDot:2
+30 SET ABMSINS=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,"C",ABMSCNT,0))
+31 ;I $P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABMSINS,0)),U,3)="U" Q ;unbillable ;abm*2.6*8
+32 ;unbillable ;abm*2.6*8
IF $PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABMSINS,0)),U,3)="U"
KILL ABMSINS
QUIT
+33 SET ABMIFLG=1
End DoDot:2
IF ABMIFLG=1
QUIT
End DoDot:1
+34 IF $GET(ABMSINS)'=""
SET ABMP("INS2")=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABMSINS,0)),U)
+35 IF $GET(ABMP("INS2"))'=""
Begin DoDot:1
+36 SET ABMPISAV=ABMP("INS")
+37 SET ABMP("INS")=ABMP("INS2")
+38 SET ABM("J")=ABMP("BDFN")
+39 SET ABM("I")=$PIECE(^AUTNINS(ABMP("INS"),0),U)_"-"_ABMP("INS")
+40 SET ABM("INS",ABM("I"),ABM("J"))=""
+41 IF $PIECE($GET(^AUTNINS(ABMP("INS"),2)),U)="N"
Begin DoDot:2
+42 SET ABM("INS",ABM("I"),ABM("J"))=ABMP("PDFN")
End DoDot:2
+43 SET ABM("IDFN")=ABMP("INS")
+44 DO BADDR^ABMDLBL1
+45 IF '$DATA(ABM("ADD"))
GOTO PAT
+46 ;S $P(ABMF(21),U)=$P(ABM("ADD"),U,1) ;2ndary Name(11) ;HEAT8604
+47 ;2ndary Name(11) ;HEAT8604
SET $PIECE(ABMF(20),U)=$PIECE(ABM("ADD"),U,1)
+48 ;S $P(ABMF(22),U)=$P(ABM("ADD"),U,2) ;2ndary Addr(11) ;HEAT8604
+49 ;2ndary Addr(11) ;HEAT8604
SET $PIECE(ABMF(21),U)=$PIECE(ABM("ADD"),U,2)
+50 ;S $P(ABMF(23),U)=$P(ABMCSZ,U) ;2ndary City(11) ;HEAT8604
+51 ;2ndary City(11) ;HEAT8604
SET $PIECE(ABMF(22),U)=$PIECE(ABMCSZ,U)
+52 ;2ndary ST(11)
SET ABMSTATE=$PIECE(ABMCSZ,U,2)
+53 ;S $P(ABMF(23),U)=$P(ABMF(23),U)_", "_$P($G(^DIC(5,+ABMSTATE,0)),U,2) ;2ndary ST(11) ;HEAT8604
+54 ;2ndary ST(11) ;HEAT8604
SET $PIECE(ABMF(22),U)=$PIECE(ABMF(22),U)_", "_$PIECE($GET(^DIC(5,+ABMSTATE,0)),U,2)
+55 ;S $P(ABMF(23),U)=$P(ABMF(23),U)_" "_$P(ABMCSZ,U,3) ;2ndary Zip(11) ;HEAT8604
+56 ;2ndary Zip(11) ;HEAT8604
SET $PIECE(ABMF(22),U)=$PIECE(ABMF(22),U)_" "_$PIECE(ABMCSZ,U,3)
+57 KILL ABMCSZ,ABMSTATE
+58 SET ABMP("INS")=ABMPISAV
+59 ;2ndary grp#(9)
+60 IF $PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABMSINS,0)),U,4)
SET ABMX("PH")=ABMP("PDFN")
+61 IF $PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABMSINS,0)),U,5)
SET ABMX("PH")=ABMP("PDFN")
+62 IF $PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABMSINS,0)),U,6)
SET ABMX("PH")=$PIECE($GET(^AUPNMCD($PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABMSINS,0),U,6),0)),U,9)
+63 IF $PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABMSINS,0)),U,8)
IF ($PIECE($GET(^AUPNPRVT(ABMP("PDFN"),11,$PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABMSINS,0),U,8),0)),U,8)'="")
Begin DoDot:2
+64 SET ABMX("PH")=$PIECE(^AUPNPRVT(ABMP("PDFN"),11,$PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABMSINS,0),U,8),0),U,8)
End DoDot:2
+65 IF +$GET(ABMX("PH"))'=0
Begin DoDot:2
+66 SET ABMX("GRP")=$PIECE($GET(^AUPN3PPH(+ABMX("PH"),0)),U,6)
+67 ;I $P($G(^AUPN3PPH(+ABMX("PH"),0)),U,8)="M" S $P(ABMF(17),U,2)="X" ;sex(7) ;HEAT8604
+68 ;sex(7) ;HEAT8604
IF $PIECE($GET(^AUPN3PPH(+ABMX("PH"),0)),U,8)="M"
SET $PIECE(ABMF(16),U,2)="X"
+69 ;I $P($G(^AUPN3PPH(+ABMX("PH"),0)),U,8)="F" S $P(ABMF(17),U,3)="X" ;sex(7) ;HEAT8604
+70 ;sex(7) ;HEAT8604
IF $PIECE($GET(^AUPN3PPH(+ABMX("PH"),0)),U,8)="F"
SET $PIECE(ABMF(16),U,3)="X"
+71 ;S $P(ABMF(17),U,4)=$P($G(^AUPN3PPH(+ABMX("PH"),0)),U,4) ;Pol#(8) ;HEAT8604
+72 ;Pol#(8) ;HEAT8604
SET $PIECE(ABMF(16),U,4)=$PIECE($GET(^AUPN3PPH(+ABMX("PH"),0)),U,4)
+73 ;start new code abm*2.6*1 HEAT2948
+74 ;rel (10)
+75 IF $PIECE($GET(^AUTNINS(ABMP("INS2"),2)),U)="P"
Begin DoDot:3
+76 SET ABMSINS=$ORDER(^AUPNPRVT(ABMP("PDFN"),11,"B",ABMP("INS2"),0))
+77 SET ABMP("REL")=$PIECE($GET(^AUTTRLSH($PIECE($GET(^AUPNPRVT(ABMP("PDFN"),11,ABMSINS,0)),U,5),0)),U,5)
+78 ;I ABMP("REL")=18 S $P(ABMF(19),U,2)="X" ;HEAT8604
+79 ;HEAT8604
IF ABMP("REL")=17
SET $PIECE(ABMF(18),U,2)="X"
+80 ;I ABMP("REL")="01" S $P(ABMF(19),U,3)="X" ;HEAT8604
+81 ;HEAT8604
IF ABMP("REL")="01"
SET $PIECE(ABMF(18),U,3)="X"
+82 ;I ABMP("REL")=19 S $P(ABMF(19),U,4)="X" ;HEAT8604
+83 ;HEAT8604
IF ABMP("REL")=18
SET $PIECE(ABMF(18),U,4)="X"
+84 ;I ABMP("REL")'=18&(ABMP("REL")'=19)&(ABMP("REL")'="01") S $P(ABMF(19),U,5)="X" ;HEAT8604
+85 ;HEAT8604
IF ABMP("REL")'=17&(ABMP("REL")'=18)&(ABMP("REL")'="01")
SET $PIECE(ABMF(18),U,5)="X"
End DoDot:3
+86 ;end new code HEAT2948
End DoDot:2
+87 IF $PIECE($GET(^AUTNINS(ABMP("INS2"),2)),U)="D"
Begin DoDot:2
+88 ;I $P($G(^DPT(+ABMP("PDFN"),0)),U,2)="M" S $P(ABMF(16),U,2)="X" ;sex(7) ;HEAT8604
+89 ;sex(7) ;HEAT8604
IF $PIECE($GET(^DPT(+ABMP("PDFN"),0)),U,2)="M"
SET $PIECE(ABMF(16),U,2)="X"
+90 ;I $P($G(^DPT(+ABMP("PDFN"),0)),U,2)="F" S $P(ABMF(17),U,3)="X" ;sex(7) ;HEAT8604
+91 ;sex(7) ;HEAT8604
IF $PIECE($GET(^DPT(+ABMP("PDFN"),0)),U,2)="F"
SET $PIECE(ABMF(16),U,3)="X"
+92 ;S:(+$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABMSINS,0)),U,6)'=0) $P(ABMF(17),U,4)=$P($G(^AUPNMCD($P(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABMSINS,0),U,6),0)),U,3) ;Policy#(8) ;HEAT8604
+93 ;Policy#(8) ;HEAT8604
IF (+$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABMSINS,0)),U,6)'=0)
SET $PIECE(ABMF(16),U,4)=$PIECE($GET(^AUPNMCD($PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABMSINS,0),U,6),0)),U,3)
+94 ;S $P(ABMF(19),U,2)="X" ;rel.(10) ;HEAT8604
+95 ;rel.(10) ;HEAT8604
SET $PIECE(ABMF(18),U,2)="X"
End DoDot:2
+96 IF $GET(ABMX("GRP"))'=""
Begin DoDot:2
+97 IF $DATA(^AUTNEGRP(ABMX("GRP"),0))
Begin DoDot:3
+98 ;S $P(ABMF(19),U)=$S($D(^AUTNEGRP(ABMX("GRP"),11,ABMP("VTYP"),0)):$P(^(0),U,2),1:$P(^AUTNEGRP(ABMX("GRP"),0),U,2)) ;HEAT8604
+99 ;HEAT8604
SET $PIECE(ABMF(18),U)=$SELECT($DATA(^AUTNEGRP(ABMX("GRP"),11,ABMP("VTYP"),0)):$PIECE(^(0),U,2),1:$PIECE(^AUTNEGRP(ABMX("GRP"),0),U,2))
End DoDot:3
End DoDot:2
End DoDot:1
PAT ;Pt Info
+1 DO PAT^ABMDF29B
LOC ;loc info
+1 ;S $P(ABMF(55),U)=$S($P(ABMV("X1"),U,2)]"":$P(ABMV("X1"),U,2),1:$P($P(ABMV("X1"),U),";",2)) ;billing entity name(48) ;HEAT8604
+2 ;billing entity name(48) ;HEAT8604
SET $PIECE(ABMF(54),U)=$SELECT($PIECE(ABMV("X1"),U,2)]"":$PIECE(ABMV("X1"),U,2),1:$PIECE($PIECE(ABMV("X1"),U),";",2))
+3 ;S $P(ABMF(56),U)=$P(ABMV("X1"),U,3) ;addr(48) ;HEAT8604
+4 ;addr(48) ;HEAT8604
SET $PIECE(ABMF(55),U)=$PIECE(ABMV("X1"),U,3)
+5 ;abm*2.6*6 HEAT26023
IF DUZ(2)=1581
SET $PIECE(ABMF(55),U)="PO BOX 4342"
+6 SET ABMCSZ=$PIECE(ABMV("X1"),U,4)
+7 ;S $P(ABMF(57),U)=$P(ABMCSZ,",",1) ;City(48) ;HEAT8604
+8 ;City(48) ;HEAT8604
SET $PIECE(ABMF(56),U)=$PIECE(ABMCSZ,",",1)
+9 SET ABMCSZ=$PIECE(ABMCSZ,",",2)
+10 ;S $P(ABMF(57),U)=$P(ABMF(57),U)_", "_$P(ABMCSZ," ",2) ;ST(48) ;HEAT8604
+11 ;ST(48) ;HEAT8604
SET $PIECE(ABMF(56),U)=$PIECE(ABMF(56),U)_", "_$PIECE(ABMCSZ," ",2)
+12 ;S $P(ABMF(57),U)=$P(ABMF(57),U)_" "_$P(ABMCSZ," ",4) ;zip(48) ;HEAT8604
+13 ;zip(48) ;HEAT8604
SET $PIECE(ABMF(56),U)=$PIECE(ABMF(56),U)_" "_$PIECE(ABMCSZ," ",4)
+14 ;abm*2.6*6 HEAT26023
IF DUZ(2)=1581
SET $PIECE(ABMF(56),U)="San Felipe Pueblo, NM 87001"
+15 ;
+16 IF $PIECE($GET(^AUTNINS(ABMP("INS"),0)),U)["DELTA DENTAL"
Begin DoDot:1
+17 ;S $P(ABMF(56),U)=$P($G(^DIC(4,ABMP("LDFN"),1)),U) ;addr(48) ;HEAT8604
+18 ;addr(48) ;HEAT8604
SET $PIECE(ABMF(55),U)=$PIECE($GET(^DIC(4,ABMP("LDFN"),1)),U)
+19 ;S $P(ABMF(57),U)=$P($G(^DIC(4,ABMP("LDFN"),1)),U,3) ;city(48) ;HEAT8604
+20 ;city(48) ;HEAT8604
SET $PIECE(ABMF(56),U)=$PIECE($GET(^DIC(4,ABMP("LDFN"),1)),U,3)
+21 ;st(48)
SET ABMX("STATE")=$PIECE($GET(^DIC(4,ABMP("LDFN"),0)),U,2)
+22 SET ABMX("STATE")=$PIECE($GET(^DIC(5,+ABMX("STATE"),0)),U,2)
+23 IF ABMX("STATE")'=""
Begin DoDot:2
+24 ;S $P(ABMF(57),U)=$P(ABMF(57),U)_", "_ABMX("STATE")_" "_$P($G(^DIC(4,ABMP("LDFN"),1)),U,4) ;zip(48) ;HEAT8604
+25 ;zip(48) ;HEAT8604
SET $PIECE(ABMF(56),U)=$PIECE(ABMF(56),U)_", "_ABMX("STATE")_" "_$PIECE($GET(^DIC(4,ABMP("LDFN"),1)),U,4)
End DoDot:2
+26 ;start new code abm*2.6*6 NOHEAT
+27 IF $PIECE($GET(^AUTTLOC(ABMP("LDFN"),0)),U,2)="AIDC"
Begin DoDot:2
+28 ;addr(48)
SET $PIECE(ABMF(55),U)="P.O. Box 31001-0674"
+29 ;city(48)
SET $PIECE(ABMF(56),U)="Pasadena, CA 91110-0674"
End DoDot:2
+30 ;end new code NOHEAT
End DoDot:1
+31 KILL ABMCSZ
+32 ;S $P(ABMF(60),U,3)=$P(ABMV("X1"),U,6) ;SSN/TIN(51) ;HEAT8604
+33 ;SSN/TIN(51) ;HEAT8604
SET $PIECE(ABMF(59),U,3)=$PIECE(ABMV("X1"),U,6)
+34 ;abm*2.6*6 HEAT26023
IF DUZ(2)=1581
SET $PIECE(ABMF(59),U,3)="850210848"
+35 ;S $P(ABMF(61),U,1)=$P(ABMV("X1"),U,5) ;Phone(52) ;HEAT8604
+36 ;Phone(52) ;HEAT8604
SET $PIECE(ABMF(60),U,1)=$PIECE(ABMV("X1"),U,5)
+37 ;S $P(ABMF(61),U,1)=$P(ABMV("X1"),U,5) ;Phone(52) ;HEAT8604
+38 ;Phone(52) ;HEAT8604
SET $PIECE(ABMF(60),U,1)=$PIECE(ABMV("X1"),U,5)
+39 SET ABMLOC=$PIECE(ABMP("B0"),U,3)
+40 SET ABMV("X1")=$GET(^AUTTLOC(ABMLOC,0))
+41 ;start new abm*2.6*3 HEAT13493
+42 ;addr(56)
SET $PIECE(ABMF(58),U)=$PIECE($GET(^DIC(4,ABMP("LDFN"),1)),U)
+43 ;city(56)
SET $PIECE(ABMF(59),U,4)=$PIECE($GET(^DIC(4,ABMP("LDFN"),1)),U,3)
+44 ;st(56)
SET ABMX("STATE")=$PIECE($GET(^DIC(4,ABMP("LDFN"),0)),U,2)
+45 SET ABMX("STATE")=$PIECE($GET(^DIC(5,+ABMX("STATE"),0)),U,2)
+46 IF ABMX("STATE")'=""
Begin DoDot:1
+47 ;zip(56)
SET $PIECE(ABMF(59),U,4)=$PIECE(ABMF(59),U,4)_", "_ABMX("STATE")_" "_$PIECE($GET(^DIC(4,ABMP("LDFN"),1)),U,4)
End DoDot:1
+48 ;end new HEAT13493
+49 ;S $P(ABMF(59),U)=$P(ABMV("X1"),U,12) ;addr(56) ;HEAT8604
+50 ;S $P(ABMF(60),U,4)=$P(ABMV("X1"),U,13) ;city(56) ;HEAT8604
+51 ;S $P(ABMF(60),U,4)=$P(ABMF(60),U,4)_", "_$P(^DIC(5,ABML,0),U,2) ;st(56) ;HEAT8604
+52 ;S $P(ABMF(60),U,4)=$P(ABMF(60),U,4)_" "_$P(ABMV("X1"),U,15) ;zip(56) ;HEAT8604
+53 ;default to mailing address if no physical address ;abm*2.6*3 HEAT13493
IF $PIECE(ABMF(58),U)=""
Begin DoDot:1
+54 ;addr(56) ;HEAT8604 & HEAT13493
SET $PIECE(ABMF(58),U)=$PIECE(ABMV("X1"),U,12)
+55 ;city(56) ;HEAT8604 * HEAT13493
SET $PIECE(ABMF(59),U,4)=$PIECE(ABMV("X1"),U,13)
+56 SET ABML=$PIECE(ABMV("X1"),U,14)
+57 ;st(56) ;HEAT8604 & HEAT13493
SET $PIECE(ABMF(59),U,4)=$PIECE(ABMF(59),U,4)_", "_$PIECE(^DIC(5,ABML,0),U,2)
+58 ;zip(56) ;HEAT8604 & HEAT13493
SET $PIECE(ABMF(59),U,4)=$PIECE(ABMF(59),U,4)_" "_$PIECE(ABMV("X1"),U,15)
End DoDot:1
+59 SET ABMLNPI=$SELECT($PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1)),U,8)'="":...
... $PIECE(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,ABMP("VTYP"),1),U,8),$PIECE($GET(^ABMDPARM(ABMP("LDFN"),1,2)),U,12)'="":$PIECE(^ABMDPARM(ABMP("LDFN"),1,2),U,12),1:ABMP("LDFN"))
+60 ;S $P(ABMF(60),U)=$S($P($$NPI^XUSNPI("Organization_ID",ABMLNPI),U)>0:$P($$NPI^XUSNPI("Organization_ID",ABMLNPI),U),1:"") ;Location NPI (49) ;HEAT8604
+61 ;Location NPI (49) ;HEAT8604
SET $PIECE(ABMF(59),U)=$SELECT($PIECE($$NPI^XUSNPI("Organization_ID",ABMLNPI),U)>0:$PIECE($$NPI^XUSNPI("Organization_ID",ABMLNPI),U),1:"")
+62 ;abm*2.6*6 HEAT26023
IF DUZ(2)=1581
SET $PIECE(ABMF(59),U)="1265511299"
+63 ;Klamath
IF ABMP("LDFN")=5440
Begin DoDot:1
+64 ;S $P(ABMF(59),U)="330 Chiloquin BLVD" ;addr(56) ;HEAT8604
+65 ;addr(56) ;HEAT8604
SET $PIECE(ABMF(58),U)="330 Chiloquin BLVD"
+66 ;S $P(ABMF(60),U,4)="Chiloquin" ;city(56) ;HEAT8604
+67 ;city(56) ;HEAT8604
SET $PIECE(ABMF(59),U,4)="Chiloquin"
+68 ;st(56)
SET ABMX("STATE")="Oregon"
+69 ;S $P(ABMF(60),U,4)=$P(ABMF(60),U,4)_", "_ABMX("STATE")_" 97624" ;zip(56) ;HEAT8604
+70 ;zip(56) ;HEAT8604
SET $PIECE(ABMF(59),U,4)=$PIECE(ABMF(59),U,4)_", "_ABMX("STATE")_" 97624"
End DoDot:1
+71 ;start old abm*2.6*3 HEAT13493
+72 ;I $P($G(^AUTNINS(ABMP("INS"),0)),U)["DELTA DENTAL" D
+73 ;.;S $P(ABMF(59),U)=$P($G(^DIC(4,ABMP("LDFN"),1)),U) ;addr(56) ;HEAT8604
+74 ;.S $P(ABMF(58),U)=$P($G(^DIC(4,ABMP("LDFN"),1)),U) ;addr(56) ;HEAT8604
+75 ;.;S $P(ABMF(60),U,4)=$P($G(^DIC(4,ABMP("LDFN"),1)),U,3) ;city(56) ;HEAT8604
+76 ;.S $P(ABMF(59),U,4)=$P($G(^DIC(4,ABMP("LDFN"),1)),U,3) ;city(56) ;HEAT8604
+77 ;.S ABMX("STATE")=$P($G(^DIC(4,ABMP("LDFN"),0)),U,2) ;st(56)
+78 ;.S ABMX("STATE")=$P($G(^DIC(5,+ABMX("STATE"),0)),U,2)
+79 ;.I ABMX("STATE")'="" D
+80 ;..;S $P(ABMF(60),U,4)=$P(ABMF(60),U,4)_", "_ABMX("STATE")_" "_$P($G(^DIC(4,ABMP("LDFN"),1)),U,4) ;zip(56) ;HEAT8604
+81 ;..S $P(ABMF(59),U,4)=$P(ABMF(59),U,4)_", "_ABMX("STATE")_" "_$P($G(^DIC(4,ABMP("LDFN"),1)),U,4) ;zip(56) ;HEAT8604
+82 ;end old HEAT13493
INSNUM ;Ins Info
+1 SET ABM("INUM")=$PIECE($GET(^ABMNINS(ABMP("LDFN"),ABMP("INS"),1,$PIECE(ABMP("B0"),U,7),0)),U,8)
+2 IF ABM("INUM")=""
SET ABM("INUM")=$PIECE($GET(^AUTNINS(ABMP("INS"),15,ABMP("LDFN"),0)),U,2)
+3 IF ABM("INUM")=""
Begin DoDot:1
+4 SET ABMPRV=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,"C","A",0))
+5 IF ABMPRV
SET ABMPRV=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,ABMPRV,0)),U)
+6 IF ABMPRV
SET ABM("INUM")=$PIECE($GET(^VA(200,ABMPRV,9999999.18,ABMP("INS"),0)),U,2)
End DoDot:1
+7 ;S $P(ABMF(60),U,2)=ABM("INUM") ;Dent Lic(55) ;HEAT8604
+8 ;Dent Lic(55) ;HEAT8604
SET $PIECE(ABMF(59),U,2)=ABM("INUM")
+9 ;Ins.type
SET ABMP("ITYP")=$PIECE($GET(^AUTNINS(ABMP("INS"),2)),U)
+10 IF ABMP("ITYP")="D"
Begin DoDot:1
+11 SET ABMMCD=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABMP("INS"),0)),U,6)
End DoDot:1
PRV ;Prov?
+1 DO PRV^ABMDF29B
POL ;Pol. Info
+1 DO POL^ABMDF29B
EMPL ;Emp. info
+1 ;I ABMP("ITYP")'="P" S $P(ABMF(13),U,4)=$P(ABMV("X3"),U) ;Employer name(17) ;HEAT8604
+2 ;Employer name(17) ;HEAT8604
IF ABMP("ITYP")'="P"
SET $PIECE(ABMF(12),U,4)=$PIECE(ABMV("X3"),U)
+3 IF '$TEST
Begin DoDot:1
+4 SET ABMP("PH")=$PIECE(ABMV("X2"),U)
+5 SET ABMEMPL=$PIECE($GET(^AUPN3PPH(+ABMP("PH"),0)),U,16)
+6 ;S:+ABMEMPL $P(ABMF(13),U,4)=$P($G(^AUTNEMPL(ABMEMPL,0)),U) ;HEAT8604
+7 ;HEAT8604
IF +ABMEMPL
SET $PIECE(ABMF(12),U,4)=$PIECE($GET(^AUTNEMPL(ABMEMPL,0)),U)
End DoDot:1
+8 ;S $P(ABMF(13),U,3)=$P(ABMV("X3"),U,7) ;Grp#(16) ;HEAT8604
+9 ;Grp#(16) ;HEAT8604
SET $PIECE(ABMF(12),U,3)=$PIECE(ABMV("X3"),U,7)
REL ;Rel
+1 IF '$PIECE(ABMV("X2"),U,2)
GOTO INS
+2 SET ABM=+$PIECE($GET(^AUTTRLSH(+$PIECE(ABMV("X2"),U,2),0)),U,2)
+3 ;I ABM,ABM<8,ABM'=2 S $P(ABMF(16),U,$S(ABM=1:1,ABM=3:3,1:4))="X" ;Rel to subscbr(18) ;HEAT8604
+4 ;Rel to subscbr(18) ;HEAT8604
IF ABM
IF ABM<8
IF ABM'=2
SET $PIECE(ABMF(15),U,$SELECT(ABM=1:1,ABM=3:3,1:4))="X"
+5 ;E S $P(ABMF(16),U,$S(ABM=2:2,ABM=1:1,1:4))="X" ;HEAT8604
+6 ;HEAT8604
IF '$TEST
SET $PIECE(ABMF(15),U,$SELECT(ABM=2:2,ABM=1:1,1:4))="X"
INS ;
+1 ;abm*2.6*1-split rtn due to size
DO ^ABMDF29B
XIT ;
+1 KILL ABM,ABMV
+2 QUIT
