ABMDF34A ; IHS/SD/SDR - ADA 2012 Dental Export -part 2 ;
;;2.6;IHS 3P BILLING SYSTEM;**11**;NOV 12, 2009;Build 133
;********************************************
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 $$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMP("INS"),".211","I"),1,"I")="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(7)=$P(ABM("ADD"),U,1) ;Ins Name(3)
S ABMF(8)=$P(ABM("ADD"),U,2) ;Ins Addr(3)
S ABMF(9)=$P(ABMCSZ,U) ;City(3)
S ABMSTATE=$P(ABMCSZ,U,2) ;St(3)
S ABMF(9)=ABMF(9)_", "_$P($G(^DIC(5,+ABMSTATE,0)),U,2)
S ABMF(9)=ABMF(9)_" "_$P(ABMCSZ,U,3) ;Zip(3)
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" K ABMSINS Q ;unbillable
..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 $$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMP("INS"),".211","I"),1,"I")="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(20),U)=$P(ABM("ADD"),U,1) ;2ndary Name(11)
.S $P(ABMF(21),U)=$P(ABM("ADD"),U,2) ;2ndary Addr(11)
.S $P(ABMF(22),U)=$P(ABMCSZ,U) ;2ndary City(11)
.S ABMSTATE=$P(ABMCSZ,U,2) ;2ndary ST(11)
.S $P(ABMF(22),U)=$P(ABMF(22),U)_", "_$P($G(^DIC(5,+ABMSTATE,0)),U,2) ;2ndary ST(11)
.S $P(ABMF(22),U)=$P(ABMF(22),U)_" "_$P(ABMCSZ,U,3) ;2ndary Zip(11)
.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(16),U,2)="X" ;sex(7)
..I $P($G(^AUPN3PPH(+ABMX("PH"),0)),U,8)="F" S $P(ABMF(16),U,3)="X" ;sex(7)
..S $P(ABMF(16),U,4)=$P($G(^AUPN3PPH(+ABMX("PH"),0)),U,4) ;Pol#(8)
..;rel (10)
..I $$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMP("INS2"),".211","I"),1,"I")="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")=17 S $P(ABMF(18),U,2)="X"
...I ABMP("REL")="01" S $P(ABMF(18),U,3)="X"
...I ABMP("REL")=18 S $P(ABMF(18),U,4)="X"
...I ABMP("REL")'=17&(ABMP("REL")'=18)&(ABMP("REL")'="01") S $P(ABMF(18),U,5)="X"
.I $$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMP("INS2"),".211","I"),1,"I")="D" D
..I $P($G(^DPT(+ABMP("PDFN"),0)),U,2)="M" S $P(ABMF(16),U,2)="X" ;sex(7)
..I $P($G(^DPT(+ABMP("PDFN"),0)),U,2)="F" S $P(ABMF(16),U,3)="X" ;sex(7)
..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)
..S $P(ABMF(18),U,2)="X" ;rel.(10)
.I $G(ABMX("GRP"))'="" D
..I $D(^AUTNEGRP(ABMX("GRP"),0)) D
...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))
PAT ;Pt Info
D PAT^ABMDF34B
LOC ;loc info
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)
S $P(ABMF(55),U)=$P(ABMV("X1"),U,3) ;addr(48)
I DUZ(2)=1581 S $P(ABMF(55),U)="PO BOX 4342"
S ABMCSZ=$P(ABMV("X1"),U,4)
S $P(ABMF(56),U)=$P(ABMCSZ,",",1) ;City(48)
S ABMCSZ=$P(ABMCSZ,",",2)
S $P(ABMF(56),U)=$P(ABMF(56),U)_", "_$P(ABMCSZ," ",2) ;ST(48)
S $P(ABMF(56),U)=$P(ABMF(56),U)_" "_$P(ABMCSZ," ",4) ;zip(48)
I DUZ(2)=1581 S $P(ABMF(56),U)="San Felipe Pueblo, NM 87001"
;
I $P($G(^AUTNINS(ABMP("INS"),0)),U)["DELTA DENTAL" D
.S $P(ABMF(55),U)=$P($G(^DIC(4,ABMP("LDFN"),1)),U) ;addr(48)
.S $P(ABMF(56),U)=$P($G(^DIC(4,ABMP("LDFN"),1)),U,3) ;city(48)
.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(56),U)=$P(ABMF(56),U)_", "_ABMX("STATE")_" "_$P($G(^DIC(4,ABMP("LDFN"),1)),U,4) ;zip(48)
.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)
K ABMCSZ
S $P(ABMF(59),U,3)=$P(ABMV("X1"),U,6) ;SSN/TIN(51)
I DUZ(2)=1581 S $P(ABMF(59),U,3)="850210848"
S $P(ABMF(60),U,1)=$P(ABMV("X1"),U,5) ;Phone(52)
S $P(ABMF(60),U,1)=$P(ABMV("X1"),U,5) ;Phone(52)
S ABMLOC=$P(ABMP("B0"),U,3)
S ABMV("X1")=$G(^AUTTLOC(ABMLOC,0))
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)
I $P(ABMF(58),U)="" D ;default to mailing addr if no physical addr
.S $P(ABMF(58),U)=$P(ABMV("X1"),U,12) ;addr(56)
.S $P(ABMF(59),U,4)=$P(ABMV("X1"),U,13) ;city(56)
.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)
.S $P(ABMF(59),U,4)=$P(ABMF(59),U,4)_" "_$P(ABMV("X1"),U,15) ;zip(56)
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(59),U)=$S($P($$NPI^XUSNPI("Organization_ID",ABMLNPI),U)>0:$P($$NPI^XUSNPI("Organization_ID",ABMLNPI),U),1:"") ;Location NPI (49)
I DUZ(2)=1581 S $P(ABMF(59),U)="1265511299"
I ABMP("LDFN")=5440 D ;Klamath
.S $P(ABMF(58),U)="330 Chiloquin BLVD" ;addr(56)
.S $P(ABMF(59),U,4)="Chiloquin" ;city(56)
.S ABMX("STATE")="Oregon" ;st(56)
.S $P(ABMF(59),U,4)=$P(ABMF(59),U,4)_", "_ABMX("STATE")_" 97624" ;zip(56)
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(59),U,2)=ABM("INUM") ;Dent Lic(55)
S ABMP("ITYP")=$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMP("INS"),".211","I"),1,"I") ;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^ABMDF34B
POL ;Pol. Info
D POL^ABMDF34B
EMPL ;Emp. info
I ABMP("ITYP")'="P" S $P(ABMF(12),U,4)=$P(ABMV("X3"),U) ;Employer name(17)
E D
.S ABMP("PH")=$P(ABMV("X2"),U)
.S ABMEMPL=$P($G(^AUPN3PPH(+ABMP("PH"),0)),U,16)
.S:+ABMEMPL $P(ABMF(12),U,4)=$P($G(^AUTNEMPL(ABMEMPL,0)),U)
S $P(ABMF(12),U,3)=$P(ABMV("X3"),U,7) ;Grp#(16)
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(15),U,$S(ABM=1:1,ABM=3:3,1:4))="X" ;Rel to subscbr(18)
E S $P(ABMF(15),U,$S(ABM=2:2,ABM=1:1,1:4))="X"
INS ;
D ^ABMDF34B
XIT ;
K ABM,ABMV
Q
ABMDF34A ; IHS/SD/SDR - ADA 2012 Dental Export -part 2 ;
+1 ;;2.6;IHS 3P BILLING SYSTEM;**11**;NOV 12, 2009;Build 133
+2 ;********************************************
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 $$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMP("INS"),".211","I"),1,"I")="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 ;Ins Name(3)
SET ABMF(7)=$PIECE(ABM("ADD"),U,1)
+11 ;Ins Addr(3)
SET ABMF(8)=$PIECE(ABM("ADD"),U,2)
+12 ;City(3)
SET ABMF(9)=$PIECE(ABMCSZ,U)
+13 ;St(3)
SET ABMSTATE=$PIECE(ABMCSZ,U,2)
+14 SET ABMF(9)=ABMF(9)_", "_$PIECE($GET(^DIC(5,+ABMSTATE,0)),U,2)
+15 ;Zip(3)
SET ABMF(9)=ABMF(9)_" "_$PIECE(ABMCSZ,U,3)
+16 KILL ABMCSZ,ABMSTATE
+17 ;2ndary info
+18 SET ABMPIIEN=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,"B",ABMP("INS"),0))
+19 KILL ABMSCNT,ABMSINS,ABMP("INS2")
+20 IF +$GET(ABMPIIEN)'=0
Begin DoDot:1
+21 ;get priority of active ins
SET ABMPINS=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABMPIIEN,0)),U,2)
+22 SET ABMIFLG=0
+23 SET ABMSCNT=ABMPINS
+24 FOR
SET ABMSCNT=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,"C",ABMSCNT))
IF +ABMSCNT=0
QUIT
Begin DoDot:2
+25 SET ABMSINS=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,"C",ABMSCNT,0))
+26 ;unbillable
IF $PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABMSINS,0)),U,3)="U"
KILL ABMSINS
QUIT
+27 SET ABMIFLG=1
End DoDot:2
IF ABMIFLG=1
QUIT
End DoDot:1
+28 IF $GET(ABMSINS)'=""
SET ABMP("INS2")=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABMSINS,0)),U)
+29 IF $GET(ABMP("INS2"))'=""
Begin DoDot:1
+30 SET ABMPISAV=ABMP("INS")
+31 SET ABMP("INS")=ABMP("INS2")
+32 SET ABM("J")=ABMP("BDFN")
+33 SET ABM("I")=$PIECE(^AUTNINS(ABMP("INS"),0),U)_"-"_ABMP("INS")
+34 SET ABM("INS",ABM("I"),ABM("J"))=""
+35 IF $$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMP("INS"),".211","I"),1,"I")="N"
Begin DoDot:2
+36 SET ABM("INS",ABM("I"),ABM("J"))=ABMP("PDFN")
End DoDot:2
+37 SET ABM("IDFN")=ABMP("INS")
+38 DO BADDR^ABMDLBL1
+39 IF '$DATA(ABM("ADD"))
GOTO PAT
+40 ;2ndary Name(11)
SET $PIECE(ABMF(20),U)=$PIECE(ABM("ADD"),U,1)
+41 ;2ndary Addr(11)
SET $PIECE(ABMF(21),U)=$PIECE(ABM("ADD"),U,2)
+42 ;2ndary City(11)
SET $PIECE(ABMF(22),U)=$PIECE(ABMCSZ,U)
+43 ;2ndary ST(11)
SET ABMSTATE=$PIECE(ABMCSZ,U,2)
+44 ;2ndary ST(11)
SET $PIECE(ABMF(22),U)=$PIECE(ABMF(22),U)_", "_$PIECE($GET(^DIC(5,+ABMSTATE,0)),U,2)
+45 ;2ndary Zip(11)
SET $PIECE(ABMF(22),U)=$PIECE(ABMF(22),U)_" "_$PIECE(ABMCSZ,U,3)
+46 KILL ABMCSZ,ABMSTATE
+47 SET ABMP("INS")=ABMPISAV
+48 ;2ndary grp#(9)
+49 IF $PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABMSINS,0)),U,4)
SET ABMX("PH")=ABMP("PDFN")
+50 IF $PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABMSINS,0)),U,5)
SET ABMX("PH")=ABMP("PDFN")
+51 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)
+52 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
+53 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
+54 IF +$GET(ABMX("PH"))'=0
Begin DoDot:2
+55 SET ABMX("GRP")=$PIECE($GET(^AUPN3PPH(+ABMX("PH"),0)),U,6)
+56 ;sex(7)
IF $PIECE($GET(^AUPN3PPH(+ABMX("PH"),0)),U,8)="M"
SET $PIECE(ABMF(16),U,2)="X"
+57 ;sex(7)
IF $PIECE($GET(^AUPN3PPH(+ABMX("PH"),0)),U,8)="F"
SET $PIECE(ABMF(16),U,3)="X"
+58 ;Pol#(8)
SET $PIECE(ABMF(16),U,4)=$PIECE($GET(^AUPN3PPH(+ABMX("PH"),0)),U,4)
+59 ;rel (10)
+60 IF $$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMP("INS2"),".211","I"),1,"I")="P"
Begin DoDot:3
+61 SET ABMSINS=$ORDER(^AUPNPRVT(ABMP("PDFN"),11,"B",ABMP("INS2"),0))
+62 SET ABMP("REL")=$PIECE($GET(^AUTTRLSH($PIECE($GET(^AUPNPRVT(ABMP("PDFN"),11,ABMSINS,0)),U,5),0)),U,5)
+63 IF ABMP("REL")=17
SET $PIECE(ABMF(18),U,2)="X"
+64 IF ABMP("REL")="01"
SET $PIECE(ABMF(18),U,3)="X"
+65 IF ABMP("REL")=18
SET $PIECE(ABMF(18),U,4)="X"
+66 IF ABMP("REL")'=17&(ABMP("REL")'=18)&(ABMP("REL")'="01")
SET $PIECE(ABMF(18),U,5)="X"
End DoDot:3
End DoDot:2
+67 IF $$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMP("INS2"),".211","I"),1,"I")="D"
Begin DoDot:2
+68 ;sex(7)
IF $PIECE($GET(^DPT(+ABMP("PDFN"),0)),U,2)="M"
SET $PIECE(ABMF(16),U,2)="X"
+69 ;sex(7)
IF $PIECE($GET(^DPT(+ABMP("PDFN"),0)),U,2)="F"
SET $PIECE(ABMF(16),U,3)="X"
+70 ;Policy#(8)
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)
+71 ;rel.(10)
SET $PIECE(ABMF(18),U,2)="X"
End DoDot:2
+72 IF $GET(ABMX("GRP"))'=""
Begin DoDot:2
+73 IF $DATA(^AUTNEGRP(ABMX("GRP"),0))
Begin DoDot:3
+74 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^ABMDF34B
LOC ;loc info
+1 ;billing entity name(48)
SET $PIECE(ABMF(54),U)=$SELECT($PIECE(ABMV("X1"),U,2)]"":$PIECE(ABMV("X1"),U,2),1:$PIECE($PIECE(ABMV("X1"),U),";",2))
+2 ;addr(48)
SET $PIECE(ABMF(55),U)=$PIECE(ABMV("X1"),U,3)
+3 IF DUZ(2)=1581
SET $PIECE(ABMF(55),U)="PO BOX 4342"
+4 SET ABMCSZ=$PIECE(ABMV("X1"),U,4)
+5 ;City(48)
SET $PIECE(ABMF(56),U)=$PIECE(ABMCSZ,",",1)
+6 SET ABMCSZ=$PIECE(ABMCSZ,",",2)
+7 ;ST(48)
SET $PIECE(ABMF(56),U)=$PIECE(ABMF(56),U)_", "_$PIECE(ABMCSZ," ",2)
+8 ;zip(48)
SET $PIECE(ABMF(56),U)=$PIECE(ABMF(56),U)_" "_$PIECE(ABMCSZ," ",4)
+9 IF DUZ(2)=1581
SET $PIECE(ABMF(56),U)="San Felipe Pueblo, NM 87001"
+10 ;
+11 IF $PIECE($GET(^AUTNINS(ABMP("INS"),0)),U)["DELTA DENTAL"
Begin DoDot:1
+12 ;addr(48)
SET $PIECE(ABMF(55),U)=$PIECE($GET(^DIC(4,ABMP("LDFN"),1)),U)
+13 ;city(48)
SET $PIECE(ABMF(56),U)=$PIECE($GET(^DIC(4,ABMP("LDFN"),1)),U,3)
+14 ;st(48)
SET ABMX("STATE")=$PIECE($GET(^DIC(4,ABMP("LDFN"),0)),U,2)
+15 SET ABMX("STATE")=$PIECE($GET(^DIC(5,+ABMX("STATE"),0)),U,2)
+16 IF ABMX("STATE")'=""
Begin DoDot:2
+17 ;zip(48)
SET $PIECE(ABMF(56),U)=$PIECE(ABMF(56),U)_", "_ABMX("STATE")_" "_$PIECE($GET(^DIC(4,ABMP("LDFN"),1)),U,4)
End DoDot:2
+18 IF $PIECE($GET(^AUTTLOC(ABMP("LDFN"),0)),U,2)="AIDC"
Begin DoDot:2
+19 ;addr(48)
SET $PIECE(ABMF(55),U)="P.O. Box 31001-0674"
+20 ;city(48)
SET $PIECE(ABMF(56),U)="Pasadena, CA 91110-0674"
End DoDot:2
End DoDot:1
+21 KILL ABMCSZ
+22 ;SSN/TIN(51)
SET $PIECE(ABMF(59),U,3)=$PIECE(ABMV("X1"),U,6)
+23 IF DUZ(2)=1581
SET $PIECE(ABMF(59),U,3)="850210848"
+24 ;Phone(52)
SET $PIECE(ABMF(60),U,1)=$PIECE(ABMV("X1"),U,5)
+25 ;Phone(52)
SET $PIECE(ABMF(60),U,1)=$PIECE(ABMV("X1"),U,5)
+26 SET ABMLOC=$PIECE(ABMP("B0"),U,3)
+27 SET ABMV("X1")=$GET(^AUTTLOC(ABMLOC,0))
+28 ;addr(56)
SET $PIECE(ABMF(58),U)=$PIECE($GET(^DIC(4,ABMP("LDFN"),1)),U)
+29 ;city(56)
SET $PIECE(ABMF(59),U,4)=$PIECE($GET(^DIC(4,ABMP("LDFN"),1)),U,3)
+30 ;st(56)
SET ABMX("STATE")=$PIECE($GET(^DIC(4,ABMP("LDFN"),0)),U,2)
+31 SET ABMX("STATE")=$PIECE($GET(^DIC(5,+ABMX("STATE"),0)),U,2)
+32 IF ABMX("STATE")'=""
Begin DoDot:1
+33 ;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
+34 ;default to mailing addr if no physical addr
IF $PIECE(ABMF(58),U)=""
Begin DoDot:1
+35 ;addr(56)
SET $PIECE(ABMF(58),U)=$PIECE(ABMV("X1"),U,12)
+36 ;city(56)
SET $PIECE(ABMF(59),U,4)=$PIECE(ABMV("X1"),U,13)
+37 SET ABML=$PIECE(ABMV("X1"),U,14)
+38 ;st(56)
SET $PIECE(ABMF(59),U,4)=$PIECE(ABMF(59),U,4)_", "_$PIECE(^DIC(5,ABML,0),U,2)
+39 ;zip(56)
SET $PIECE(ABMF(59),U,4)=$PIECE(ABMF(59),U,4)_" "_$PIECE(ABMV("X1"),U,15)
End DoDot:1
+40 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"))
+41 ;Location NPI (49)
SET $PIECE(ABMF(59),U)=$SELECT($PIECE($$NPI^XUSNPI("Organization_ID",ABMLNPI),U)>0:$PIECE($$NPI^XUSNPI("Organization_ID",ABMLNPI),U),1:"")
+42 IF DUZ(2)=1581
SET $PIECE(ABMF(59),U)="1265511299"
+43 ;Klamath
IF ABMP("LDFN")=5440
Begin DoDot:1
+44 ;addr(56)
SET $PIECE(ABMF(58),U)="330 Chiloquin BLVD"
+45 ;city(56)
SET $PIECE(ABMF(59),U,4)="Chiloquin"
+46 ;st(56)
SET ABMX("STATE")="Oregon"
+47 ;zip(56)
SET $PIECE(ABMF(59),U,4)=$PIECE(ABMF(59),U,4)_", "_ABMX("STATE")_" 97624"
End DoDot:1
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 ;Dent Lic(55)
SET $PIECE(ABMF(59),U,2)=ABM("INUM")
+8 ;Ins.type
SET ABMP("ITYP")=$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABMP("INS"),".211","I"),1,"I")
+9 IF ABMP("ITYP")="D"
Begin DoDot:1
+10 SET ABMMCD=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABMP("INS"),0)),U,6)
End DoDot:1
PRV ;Prov?
+1 DO PRV^ABMDF34B
POL ;Pol. Info
+1 DO POL^ABMDF34B
EMPL ;Emp. info
+1 ;Employer name(17)
IF ABMP("ITYP")'="P"
SET $PIECE(ABMF(12),U,4)=$PIECE(ABMV("X3"),U)
+2 IF '$TEST
Begin DoDot:1
+3 SET ABMP("PH")=$PIECE(ABMV("X2"),U)
+4 SET ABMEMPL=$PIECE($GET(^AUPN3PPH(+ABMP("PH"),0)),U,16)
+5 IF +ABMEMPL
SET $PIECE(ABMF(12),U,4)=$PIECE($GET(^AUTNEMPL(ABMEMPL,0)),U)
End DoDot:1
+6 ;Grp#(16)
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 ;Rel to subscbr(18)
IF ABM
IF ABM<8
IF ABM'=2
SET $PIECE(ABMF(15),U,$SELECT(ABM=1:1,ABM=3:3,1:4))="X"
+4 IF '$TEST
SET $PIECE(ABMF(15),U,$SELECT(ABM=2:2,ABM=1:1,1:4))="X"
INS ;
+1 DO ^ABMDF34B
XIT ;
+1 KILL ABM,ABMV
+2 QUIT
