- 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