ABMDF34B ; IHS/SD/SDR - ADA 2012 Dental Export -part 3 ;
;;2.6;IHS Third Party Billing;**11,13,21**;NOV 12, 2009;Build 379
;IHS/SD/SDR - 2.6*13 - VMBP RQMT_95 - Updated to put VA STATION NUMBER in box 2.
;
INS ;Ins Info
S ABM("I")=0
F S ABM("I")=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,"C",ABM("I"))) Q:'ABM("I") D
.S ABM=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,"C",ABM("I"),0))
.S ABM=$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABM,0),U)
.I ABM'=ABMP("INS") D Q
..I $P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABM,0)),U,3)="U" Q
..S ABMITYP=$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABM,".211","I"),1,"I")
..I ABMITYP="N"!(ABMITYP="I") Q ;ben/non-ben don't count
..S Y=ABM
..S ABMP("GL")="^ABMDBILL(DUZ(2),"_ABMP("BDFN")_","
..D SEL^ABMDE2X
..Q:$G(ABMP("INS2"))=""
..S $P(ABMF(14),U)=$P($P(ABMV("X2"),U),";",2) ;(5)
..S $P(ABMF(16),U)=$P(ABMV("X2"),U,7) ;(6)
..I ABMITYP="P" D
...S ABMPIEN=$O(^AUPNPRVT(ABMP("PDFN"),11,"B",ABMP("INS2"),0))
...Q:+ABMPIEN=0
...S $P(ABMF(14),U)=$P($G(^AUPN3PPH($P($G(^AUPNPRVT(ABMP("PDFN"),11,ABMPIEN,0)),U,8),0)),U) ;(5)
...S $P(ABMF(16),U)=$P($G(^AUPN3PPH($P($G(^AUPNPRVT(ABMP("PDFN"),11,ABMPIEN,0)),U,8),0)),U,19) ;(6)
..I ABMITYP="D" D
...S $P(ABMF(14),U)=$P($G(^DPT(ABMP("PDFN"),0)),U) ;(5)
...S $P(ABMF(16),U)=$P($G(^DPT(ABMP("PDFN"),0)),U,3) ;(6)
..I $$GET1^DIQ(9999999.18,ABMP("INS2"),".25","I")="" S $P(ABMF(12),U,2)="X" ;Other Coverage (Medical) (4)
..I $$GET1^DIQ(9999999.18,ABMP("INS2"),".25","I")="O" S $P(ABMF(12),U)="X" ;Other Coverage (Dental) (4)
S $P(ABMF(1),U)="X" ;stmt/actual svcs (1)
I $P($G(^AUTNINS(ABMP("INS"),2)),"^")="D"&($P($G(^ABMDVTYP(ABMP("VTYP"),0)),U)["EPSDT") S $P(ABMF(2),U)="X" ;EPSDT/Title 19(1)
BNODES ; Bill nodes
I $D(^ABMDBILL(DUZ(2),ABMP("BDFN"),0)) D
.S ABM("B4")=$G(^ABMDBILL(DUZ(2),ABMP("BDFN"),4))
.S ABM("B5")=$G(^ABMDBILL(DUZ(2),ABMP("BDFN"),5))
.S ABM("B7")=$G(^ABMDBILL(DUZ(2),ABMP("BDFN"),7))
.S ABM("B8")=$G(^ABMDBILL(DUZ(2),ABMP("BDFN"),8))
.S ABM("B9")=$G(^ABMDBILL(DUZ(2),ABMP("BDFN"),9))
S $P(ABMF(4),U)=$P(ABM("B5"),U,12) ;Prior Auth(2)
;start new code abm*2.6*13 VMBP RQMT_95
I ((ABMP("ITYP")="V")!($P($G(^AUTNINS(ABMP("INS"),0)),U)["VMBP"))&($P($G(^ABMDPARM(ABMP("LDFN"),1,3)),U,12)'="") D
.S $P(ABMF(4),U)=$P($G(^ABMDPARM(ABMP("LDFN"),1,3)),U,12) ;VA station# (2)
.S ABMF(41)=$P($G(^ABMDPARM(ABMP("LDFN"),1,3)),U,13) ;VA contract# (35)
;end new code VMBP RQMT_95
I $P(ABM("B9"),U)]"" S $P(ABMF(49),U,3)="X" ;Occup. illness(45)
ACCD ;Accident?
I $P(ABM("B8"),U,3)'="" D
.I "12"[$P(ABM("B8"),U,3) D Q
..S $P(ABMF(49),U,4)="X" ;auto accident(45)
..S $P(ABMF(50),U)=$P(ABM("B8"),U,2) ;acc. dt(46)
..S $P(ABMF(50),U,2)=$P($G(^DIC(5,$P(ABM("B8"),U,16),0)),"^",2) ;acc. st(47)
.I "5"[$P(ABM("B8"),U,3) D Q
..S $P(ABMF(49),U,5)="X" ;other accident(45)
.S $P(ABMF(50),U)=$P(ABM("B8"),U,2) ;acc. dt(46)
.S $P(ABMF(50),U,2)=$P($G(^DIC(5,$P(ABM("B8"),U,16),0)),"^",2) ;acc. st(47)
FSYM I $P(ABM("B7"),U,4)="Y" D ;ROI
.S $P(ABMF(45),U)="SIGNATURE ON FILE" ;(36)
.S $P(ABMF(45),U,2)=$P(ABM("B7"),U,11) ;(36)
I $P(ABM("B7"),U,5)="Y" D ;AOB
.S $P(ABMF(49),U)="SIGNATURE ON FILE" ;(37)
.S $P(ABMF(49),U,2)=$S($G(ABMP("PRINTDT"))="O":$P($G(^ABMDTXST(DUZ(2),$P(^ABMDBILL(DUZ(2),ABMP("BDFN"),1),U,7),0)),U),$G(ABMP("PRINTDT"))="A":$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),1)),U,5),1:DT) ;(37)
I $P($G(^AUTTLOC(ABMP("LDFN"),0)),U,2)="AIDC" S $P(ABMF(49),U,2)=$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),7)),U,12)
S $P(ABMF(42),U)=$$POS^ABMERUTL ;Place of Treatment (38)
I (+$P($G(ABM("B4")),U,3)+$P($G(ABM("B9")),U,18)+$P($G(ABM("B9")),U,19))'=0 S $P(ABMF(43),U)="Y" ;Enclosures (39)
I (+$P($G(ABM("B4")),U,3)+$P($G(ABM("B9")),U,18)+$P($G(ABM("B9")),U,19))=0 S $P(ABMF(43),U)="N" ;Enclosures (39)
XRAY ;#/X-rays included
ORTHO ;Ortho. Related?
S $P(ABMF(45),U,$S($P(ABM("B4"),U,4):4,1:3))="X" ;(40)
; Ortho. Placement Dt
I $P(ABM("B4"),U,4) S $P(ABMF(45),U,5)=$P(ABM("B4"),U,5) ;(41)
I $P(ABM("B4"),U,13) S $P(ABMF(47),U)=$P(ABM("B4"),U,13) ;(42)
PROTH ;Proth. Included?
S $P(ABMF(47),U,$S($P(ABM("B4"),U,6):3,1:2))="X" ;(43)
; Prior Placement Dt
I $P(ABM("B4"),U,6) S $P(ABMF(47),U,4)=$P(ABM("B4"),U,7) ;(44)
;
S ABMBIL=$P(ABMP("B0"),U) ;Bill#
S ABMSFX=$P($G(^ABMDPARM(DUZ(2),1,2)),U,4) ;Bill# suffix
S ABMAHRN=$P($G(^ABMDPARM(DUZ(2),1,1,3)),U,3) ;Append HRN?
S ABMHRN=$P($G(^AUPNPAT(ABMP("PDFN"),41,ABMP("LDFN"),0)),U,2) ;HRN
S $P(ABMF(22),U,5)=ABMBIL_"-"_ABMSFX_" "_ABMHRN ;Pt ID(23)
I $D(^ABMDBILL(DUZ(2),ABMP("BDFN"),61,0)) D
.S ABMIEN=0
.S ABMLINE=39
.F S ABMIEN=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),61,ABMIEN)) Q:+ABMIEN=0!(ABMLINE>41) D
..S ABMF(ABMLINE)=$G(^ABMDBILL(DUZ(2),ABMP("BDFN"),61,ABMIEN,0))
..S ABMLINE=ABMLINE+1
Q
PAT ;
S ABM("P0")=^DPT(ABMP("PDFN"),0) ;0 node pt file
S ABMF(17)=$P(ABM("P0"),U) ;Name(20)
S ABM("P11")=$G(^DPT(ABMP("PDFN"),.11))
S $P(ABMF(18),U,6)=$P(ABM("P11"),U) ;Mailing addr(20)
S $P(ABMF(19),U)=$P(ABM("P11"),U,4) ;Mailing-city(20)
S $P(ABMF(19),U)=$P(ABMF(19),U)_", "_$P(^DIC(5,$P(ABM("P11"),U,5),0),U,2) ;Mailing-St(20)
S $P(ABMF(19),U)=$P(ABMF(19),U)_" "_$P(ABM("P11"),U,6) ;Mailing-Zip(20)
S $P(ABMF(22),U,2)=$P(ABM("P0"),U,3) ;dob(21)
I $P(ABM("P0"),U,2)="M" S $P(ABMF(22),U,3)="X" ;sex-male(22)
E S $P(ABMF(22),U,4)="X" ;sex-female(22)
K ABM("P0"),ABM("P11")
S (ABMV("X1"),ABMV("X2"),ABMV("X3"))=""
D PAT^ABMDE1X
D REMPL^ABMDE1X1
D LOC^ABMDE1X1
K ABME
Q
PRV ;
S ABM("X")=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,"C","A",0))
I ABM("X") D
.D SELBILL^ABMDE4X
.D PAYED^ABMERUTL
.S $P(ABMF(54),U,2)=$P(ABM("A"),U) ;(53)
.I $P($G(^AUTTLOC(ABMP("LDFN"),0)),U,2)="AIDC",($P($G(^AUTNINS(ABMP("INS"),0)),U)["DELTA DENTAL") S $P(ABMF(54),U,2)=""
.S $P(ABMF(54),U,3)=$S($G(ABMP("PRINTDT"))="O":$P($G(^ABMDTXST(DUZ(2),$P($G(^ABMDBILL(DUZ(2),ABMP("BDFN"),1)),U,7),0)),U),1:DT) ;(53)
.S $P(ABMF(56),U,2)=$S($P($$NPI^XUSNPI("Individual_ID",$P(ABM("A"),U,2)),U)>0:$P($$NPI^XUSNPI("Individual_ID",$P(ABM("A"),U,2)),U),1:"") ;Dent NPI (54)
.I $P($G(^AUTTLOC(ABMP("LDFN"),0)),U,2)="AIDC",((ABMP("INS")=1722)!($P($G(^AUTNINS(ABMP("INS"),0)),U)["DELTA DENTAL")) S $P(ABMF(56),U,2)=""
.I $P($G(^AUTNINS(ABMP("INS"),0)),U)["MEDICAID UTAH" S $P(ABMF(56),U,2)=$S($P($$NPI^XUSNPI("Organization_ID",ABMP("LDFN")),U)>0:$P($$NPI^XUSNPI("Organization_ID",ABMP("LDFN")),U),1:"") ;Fac NPI for UTAH MEDICAID (54)
.S $P(ABMF(59),U,2)=$$SLN^ABMEEPRV($P(ABM("A"),U,2)) ;Dent Lic(55)
.I $P($G(^AUTTLOC(ABMP("LDFN"),0)),U,2)="AIDC" D
..I ((ABMP("INS")=1722)!($P($G(^AUTNINS(ABMP("INS"),0)),U)["DELTA DENTAL")) S $P(ABMF(57),U,2)=""
..S $P(ABMF(59),U,2)=""
..I ABMP("INS")=5 S $P(ABMF(59),U,2)="NM008A76"
..I $P($G(^AUTNINS(ABMP("INS"),0)),U)["UNITED CONCORDIA" S $P(ABMF(59),U,2)=601046
..I $P($G(^AUTNINS(ABMP("INS"),0)),U)["DELTA DENTAL" S $P(ABMF(59),U,2)=8886
.S $P(ABMF(56),U,3)=$$SLN^ABMEEPRV($P(ABM("A"),U,2)) ;(55)
.I $P($G(^AUTTLOC(ABMP("LDFN"),0)),U,2)="AIDC" D
..I (ABMP("INS")=1722)!($P($G(^AUTNINS(ABMP("INS"),0)),U)["DELTA DENTAL") S $P(ABMF(56),U,3)=$S(ABMP("INS")=5:"NM008A76",ABMP("INS")["UNITED CONCORDIA":601046,($P($G(^AUTNINS(ABMP("INS"),0)),U)["DELTA DENTAL"):8886,1:"")
.S $P(ABMF(60),U,4)=ABM("PNUM") ;Prov#(58)
.I $P($G(^AUTTLOC(ABMP("LDFN"),0)),U,2)="AIDC" D
..S $P(ABMF(60),U,4)=$S(ABMP("INS")=5:"NM008A76",ABMP("INS")["UNITED CONCORDIA":601046,($P($G(^AUTNINS(ABMP("INS"),0)),U)["DELTA DENTAL"):8886,1:"")
.S $P(ABMF(60),U,2)=ABM("INUM") ;loc id(52a)
.I $P($G(^AUTTLOC(ABMP("LDFN"),0)),U,2)="AIDC" D
..S $P(ABMF(60),U,2)=$S(ABMP("INS")=5:"NM008A76",ABMP("INS")["UNITED CONCORDIA":601046,($P($G(^AUTNINS(ABMP("INS"),0)),U)["DELTA DENTAL"):8886,1:"")
.S $P(ABMF(60),U,3)=$P($G(^VA(200,$P(ABM("A"),U,2),.13)),U,2) ;off. phone(57)
.I $P(ABMF(60),U,3)="" S $P(ABMF(60),U,3)=$P($G(^AUTTLOC(ABMP("LDFN"),0)),U,11) ;loc phone(57)
.S $P(ABMF(57),U)=$$PTAX^ABMEEPRV($P(ABM("A"),U,2)) ;specialty(tax. code)(56a)
.I $P($G(^AUTTLOC(ABMP("LDFN"),0)),U,2)="AIDC" D
..I $P($G(^AUTNINS(ABMP("INS"),0)),U)["DELTA DENTAL" S $P(ABMF(57),U)=""
Q
POL ;
N I
S I=0
F S I=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,I)) Q:'I D
.I $P(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,I,0),U,3)="I" S ABM("XIEN")=I
S Y=ABMP("INS")
S ABMP("GL")="^ABMDBILL(DUZ(2),"_ABMP("BDFN")_","
D SEL^ABMDE2X ;ABMV("X2") ;Pol. holder info
I ABM("ADD")["NON-BEN" D
.S ABM("ADD")=ABMV("X2")
S $P(ABMF(5),U)=$P($P(ABMV("X2"),U),";",2) ;Sub. name(12)
S $P(ABMF(6),U)=$P(ABMV("X2"),U,3) ;Addr(12)
S ABMCSZ=$P(ABMV("X2"),"^",4)
S $P(ABMF(7),U,2)=$P(ABMCSZ,",",1) ;City(12)
S ABMCSZ=$P(ABMCSZ,",",2)
S $P(ABMF(7),U,2)=$P(ABMF(7),U,2)_", "_$P(ABMCSZ," ",2) ;St(12)
S $P(ABMF(7),U,2)=$P(ABMF(7),U,2)_" "_$P(ABMCSZ," ",4) ;Zip(12)
K ABMCSZ
S $P(ABMF(10),U,$S($P(ABMV("X2"),U,6)="M":2,1:3))="X" ;Sex(14)
S $P(ABMF(10),U,4)=$P(ABMV("X1"),U,4) ;Emp. id(15)
S $P(ABMF(10),U)=$P(ABMV("X2"),U,7) ;dob(13)
S ABMSTAT=$P($P(ABMV("X3"),U,5),";")
Q
ABMDF34B ; IHS/SD/SDR - ADA 2012 Dental Export -part 3 ;
+1 ;;2.6;IHS Third Party Billing;**11,13,21**;NOV 12, 2009;Build 379
+2 ;IHS/SD/SDR - 2.6*13 - VMBP RQMT_95 - Updated to put VA STATION NUMBER in box 2.
+3 ;
INS ;Ins Info
+1 SET ABM("I")=0
+2 FOR
SET ABM("I")=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,"C",ABM("I")))
IF 'ABM("I")
QUIT
Begin DoDot:1
+3 SET ABM=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,"C",ABM("I"),0))
+4 SET ABM=$PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABM,0),U)
+5 IF ABM'=ABMP("INS")
Begin DoDot:2
+6 IF $PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,ABM,0)),U,3)="U"
QUIT
+7 SET ABMITYP=$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABM,".211","I"),1,"I")
+8 ;ben/non-ben don't count
IF ABMITYP="N"!(ABMITYP="I")
QUIT
+9 SET Y=ABM
+10 SET ABMP("GL")="^ABMDBILL(DUZ(2),"_ABMP("BDFN")_","
+11 DO SEL^ABMDE2X
+12 IF $GET(ABMP("INS2"))=""
QUIT
+13 ;(5)
SET $PIECE(ABMF(14),U)=$PIECE($PIECE(ABMV("X2"),U),";",2)
+14 ;(6)
SET $PIECE(ABMF(16),U)=$PIECE(ABMV("X2"),U,7)
+15 IF ABMITYP="P"
Begin DoDot:3
+16 SET ABMPIEN=$ORDER(^AUPNPRVT(ABMP("PDFN"),11,"B",ABMP("INS2"),0))
+17 IF +ABMPIEN=0
QUIT
+18 ;(5)
SET $PIECE(ABMF(14),U)=$PIECE($GET(^AUPN3PPH($PIECE($GET(^AUPNPRVT(ABMP("PDFN"),11,ABMPIEN,0)),U,8),0)),U)
+19 ;(6)
SET $PIECE(ABMF(16),U)=$PIECE($GET(^AUPN3PPH($PIECE($GET(^AUPNPRVT(ABMP("PDFN"),11,ABMPIEN,0)),U,8),0)),U,19)
End DoDot:3
+20 IF ABMITYP="D"
Begin DoDot:3
+21 ;(5)
SET $PIECE(ABMF(14),U)=$PIECE($GET(^DPT(ABMP("PDFN"),0)),U)
+22 ;(6)
SET $PIECE(ABMF(16),U)=$PIECE($GET(^DPT(ABMP("PDFN"),0)),U,3)
End DoDot:3
+23 ;Other Coverage (Medical) (4)
IF $$GET1^DIQ(9999999.18,ABMP("INS2"),".25","I")=""
SET $PIECE(ABMF(12),U,2)="X"
+24 ;Other Coverage (Dental) (4)
IF $$GET1^DIQ(9999999.18,ABMP("INS2"),".25","I")="O"
SET $PIECE(ABMF(12),U)="X"
End DoDot:2
QUIT
End DoDot:1
+25 ;stmt/actual svcs (1)
SET $PIECE(ABMF(1),U)="X"
+26 ;EPSDT/Title 19(1)
IF $PIECE($GET(^AUTNINS(ABMP("INS"),2)),"^")="D"&($PIECE($GET(^ABMDVTYP(ABMP("VTYP"),0)),U)["EPSDT")
SET $PIECE(ABMF(2),U)="X"
BNODES ; Bill nodes
+1 IF $DATA(^ABMDBILL(DUZ(2),ABMP("BDFN"),0))
Begin DoDot:1
+2 SET ABM("B4")=$GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),4))
+3 SET ABM("B5")=$GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),5))
+4 SET ABM("B7")=$GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),7))
+5 SET ABM("B8")=$GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),8))
+6 SET ABM("B9")=$GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),9))
End DoDot:1
+7 ;Prior Auth(2)
SET $PIECE(ABMF(4),U)=$PIECE(ABM("B5"),U,12)
+8 ;start new code abm*2.6*13 VMBP RQMT_95
+9 IF ((ABMP("ITYP")="V")!($PIECE($GET(^AUTNINS(ABMP("INS"),0)),U)["VMBP"))&($PIECE($GET(^ABMDPARM(ABMP("LDFN"),1,3)),U,12)'="")
Begin DoDot:1
+10 ;VA station# (2)
SET $PIECE(ABMF(4),U)=$PIECE($GET(^ABMDPARM(ABMP("LDFN"),1,3)),U,12)
+11 ;VA contract# (35)
SET ABMF(41)=$PIECE($GET(^ABMDPARM(ABMP("LDFN"),1,3)),U,13)
End DoDot:1
+12 ;end new code VMBP RQMT_95
+13 ;Occup. illness(45)
IF $PIECE(ABM("B9"),U)]""
SET $PIECE(ABMF(49),U,3)="X"
ACCD ;Accident?
+1 IF $PIECE(ABM("B8"),U,3)'=""
Begin DoDot:1
+2 IF "12"[$PIECE(ABM("B8"),U,3)
Begin DoDot:2
+3 ;auto accident(45)
SET $PIECE(ABMF(49),U,4)="X"
+4 ;acc. dt(46)
SET $PIECE(ABMF(50),U)=$PIECE(ABM("B8"),U,2)
+5 ;acc. st(47)
SET $PIECE(ABMF(50),U,2)=$PIECE($GET(^DIC(5,$PIECE(ABM("B8"),U,16),0)),"^",2)
End DoDot:2
QUIT
+6 IF "5"[$PIECE(ABM("B8"),U,3)
Begin DoDot:2
+7 ;other accident(45)
SET $PIECE(ABMF(49),U,5)="X"
End DoDot:2
QUIT
+8 ;acc. dt(46)
SET $PIECE(ABMF(50),U)=$PIECE(ABM("B8"),U,2)
+9 ;acc. st(47)
SET $PIECE(ABMF(50),U,2)=$PIECE($GET(^DIC(5,$PIECE(ABM("B8"),U,16),0)),"^",2)
End DoDot:1
FSYM ;ROI
IF $PIECE(ABM("B7"),U,4)="Y"
Begin DoDot:1
+1 ;(36)
SET $PIECE(ABMF(45),U)="SIGNATURE ON FILE"
+2 ;(36)
SET $PIECE(ABMF(45),U,2)=$PIECE(ABM("B7"),U,11)
End DoDot:1
+3 ;AOB
IF $PIECE(ABM("B7"),U,5)="Y"
Begin DoDot:1
+4 ;(37)
SET $PIECE(ABMF(49),U)="SIGNATURE ON FILE"
+5 ;(37)
SET $PIECE(ABMF(49),U,2)=$SELECT($GET(ABMP("PRINTDT"))="O":$PIECE($GET(^ABMDTXST(DUZ(2),$PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),1),U,7),0)),U),$GET(ABMP("PRINTDT"))="A":$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),1)),U,5),1:DT)
End DoDot:1
+6 IF $PIECE($GET(^AUTTLOC(ABMP("LDFN"),0)),U,2)="AIDC"
SET $PIECE(ABMF(49),U,2)=$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),7)),U,12)
+7 ;Place of Treatment (38)
SET $PIECE(ABMF(42),U)=$$POS^ABMERUTL
+8 ;Enclosures (39)
IF (+$PIECE($GET(ABM("B4")),U,3)+$PIECE($GET(ABM("B9")),U,18)+$PIECE($GET(ABM("B9")),U,19))'=0
SET $PIECE(ABMF(43),U)="Y"
+9 ;Enclosures (39)
IF (+$PIECE($GET(ABM("B4")),U,3)+$PIECE($GET(ABM("B9")),U,18)+$PIECE($GET(ABM("B9")),U,19))=0
SET $PIECE(ABMF(43),U)="N"
XRAY ;#/X-rays included
ORTHO ;Ortho. Related?
+1 ;(40)
SET $PIECE(ABMF(45),U,$SELECT($PIECE(ABM("B4"),U,4):4,1:3))="X"
+2 ; Ortho. Placement Dt
+3 ;(41)
IF $PIECE(ABM("B4"),U,4)
SET $PIECE(ABMF(45),U,5)=$PIECE(ABM("B4"),U,5)
+4 ;(42)
IF $PIECE(ABM("B4"),U,13)
SET $PIECE(ABMF(47),U)=$PIECE(ABM("B4"),U,13)
PROTH ;Proth. Included?
+1 ;(43)
SET $PIECE(ABMF(47),U,$SELECT($PIECE(ABM("B4"),U,6):3,1:2))="X"
+2 ; Prior Placement Dt
+3 ;(44)
IF $PIECE(ABM("B4"),U,6)
SET $PIECE(ABMF(47),U,4)=$PIECE(ABM("B4"),U,7)
+4 ;
+5 ;Bill#
SET ABMBIL=$PIECE(ABMP("B0"),U)
+6 ;Bill# suffix
SET ABMSFX=$PIECE($GET(^ABMDPARM(DUZ(2),1,2)),U,4)
+7 ;Append HRN?
SET ABMAHRN=$PIECE($GET(^ABMDPARM(DUZ(2),1,1,3)),U,3)
+8 ;HRN
SET ABMHRN=$PIECE($GET(^AUPNPAT(ABMP("PDFN"),41,ABMP("LDFN"),0)),U,2)
+9 ;Pt ID(23)
SET $PIECE(ABMF(22),U,5)=ABMBIL_"-"_ABMSFX_" "_ABMHRN
+10 IF $DATA(^ABMDBILL(DUZ(2),ABMP("BDFN"),61,0))
Begin DoDot:1
+11 SET ABMIEN=0
+12 SET ABMLINE=39
+13 FOR
SET ABMIEN=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),61,ABMIEN))
IF +ABMIEN=0!(ABMLINE>41)
QUIT
Begin DoDot:2
+14 SET ABMF(ABMLINE)=$GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),61,ABMIEN,0))
+15 SET ABMLINE=ABMLINE+1
End DoDot:2
End DoDot:1
+16 QUIT
PAT ;
+1 ;0 node pt file
SET ABM("P0")=^DPT(ABMP("PDFN"),0)
+2 ;Name(20)
SET ABMF(17)=$PIECE(ABM("P0"),U)
+3 SET ABM("P11")=$GET(^DPT(ABMP("PDFN"),.11))
+4 ;Mailing addr(20)
SET $PIECE(ABMF(18),U,6)=$PIECE(ABM("P11"),U)
+5 ;Mailing-city(20)
SET $PIECE(ABMF(19),U)=$PIECE(ABM("P11"),U,4)
+6 ;Mailing-St(20)
SET $PIECE(ABMF(19),U)=$PIECE(ABMF(19),U)_", "_$PIECE(^DIC(5,$PIECE(ABM("P11"),U,5),0),U,2)
+7 ;Mailing-Zip(20)
SET $PIECE(ABMF(19),U)=$PIECE(ABMF(19),U)_" "_$PIECE(ABM("P11"),U,6)
+8 ;dob(21)
SET $PIECE(ABMF(22),U,2)=$PIECE(ABM("P0"),U,3)
+9 ;sex-male(22)
IF $PIECE(ABM("P0"),U,2)="M"
SET $PIECE(ABMF(22),U,3)="X"
+10 ;sex-female(22)
IF '$TEST
SET $PIECE(ABMF(22),U,4)="X"
+11 KILL ABM("P0"),ABM("P11")
+12 SET (ABMV("X1"),ABMV("X2"),ABMV("X3"))=""
+13 DO PAT^ABMDE1X
+14 DO REMPL^ABMDE1X1
+15 DO LOC^ABMDE1X1
+16 KILL ABME
+17 QUIT
PRV ;
+1 SET ABM("X")=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),41,"C","A",0))
+2 IF ABM("X")
Begin DoDot:1
+3 DO SELBILL^ABMDE4X
+4 DO PAYED^ABMERUTL
+5 ;(53)
SET $PIECE(ABMF(54),U,2)=$PIECE(ABM("A"),U)
+6 IF $PIECE($GET(^AUTTLOC(ABMP("LDFN"),0)),U,2)="AIDC"
IF ($PIECE($GET(^AUTNINS(ABMP("INS"),0)),U)["DELTA DENTAL")
SET $PIECE(ABMF(54),U,2)=""
+7 ;(53)
SET $PIECE(ABMF(54),U,3)=$SELECT($GET(ABMP("PRINTDT"))="O":$PIECE($GET(^ABMDTXST(DUZ(2),$PIECE($GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),1)),U,7),0)),U),1:DT)
+8 ;Dent NPI (54)
SET $PIECE(ABMF(56),U,2)=$SELECT($PIECE($$NPI^XUSNPI("Individual_ID",$PIECE(ABM("A"),U,2)),U)>0:$PIECE($$NPI^XUSNPI("Individual_ID",$PIECE(ABM("A"),U,2)),U),1:"")
+9 IF $PIECE($GET(^AUTTLOC(ABMP("LDFN"),0)),U,2)="AIDC"
IF ((ABMP("INS")=1722)!($PIECE($GET(^AUTNINS(ABMP("INS"),0)),U)["DELTA DENTAL"))
SET $PIECE(ABMF(56),U,2)=""
+10 ;Fac NPI for UTAH MEDICAID (54)
IF $PIECE($GET(^AUTNINS(ABMP("INS"),0)),U)["MEDICAID UTAH"
SET $PIECE(ABMF(56),U,2)=$SELECT($PIECE($$NPI^XUSNPI("Organization_ID",ABMP("LDFN")),U)>0:$PIECE($$NPI^XUSNPI("Organization_ID",ABMP("LDFN")),U),1:"")
+11 ;Dent Lic(55)
SET $PIECE(ABMF(59),U,2)=$$SLN^ABMEEPRV($PIECE(ABM("A"),U,2))
+12 IF $PIECE($GET(^AUTTLOC(ABMP("LDFN"),0)),U,2)="AIDC"
Begin DoDot:2
+13 IF ((ABMP("INS")=1722)!($PIECE($GET(^AUTNINS(ABMP("INS"),0)),U)["DELTA DENTAL"))
SET $PIECE(ABMF(57),U,2)=""
+14 SET $PIECE(ABMF(59),U,2)=""
+15 IF ABMP("INS")=5
SET $PIECE(ABMF(59),U,2)="NM008A76"
+16 IF $PIECE($GET(^AUTNINS(ABMP("INS"),0)),U)["UNITED CONCORDIA"
SET $PIECE(ABMF(59),U,2)=601046
+17 IF $PIECE($GET(^AUTNINS(ABMP("INS"),0)),U)["DELTA DENTAL"
SET $PIECE(ABMF(59),U,2)=8886
End DoDot:2
+18 ;(55)
SET $PIECE(ABMF(56),U,3)=$$SLN^ABMEEPRV($PIECE(ABM("A"),U,2))
+19 IF $PIECE($GET(^AUTTLOC(ABMP("LDFN"),0)),U,2)="AIDC"
Begin DoDot:2
+20 IF (ABMP("INS")=1722)!($PIECE($GET(^AUTNINS(ABMP("INS"),0)),U)["DELTA DENTAL")
SET $PIECE(ABMF(56),U,3)=$SELECT(ABMP("INS")=5:"NM008A76",ABMP("INS")["UNITED CONCORDIA":601046,($PIECE($GET(^AUTNINS(ABMP("INS"),0)),U)["DELTA DENTAL"):8886,1:"")
End DoDot:2
+21 ;Prov#(58)
SET $PIECE(ABMF(60),U,4)=ABM("PNUM")
+22 IF $PIECE($GET(^AUTTLOC(ABMP("LDFN"),0)),U,2)="AIDC"
Begin DoDot:2
+23 SET $PIECE(ABMF(60),U,4)=$SELECT(ABMP("INS")=5:"NM008A76",ABMP("INS")["UNITED CONCORDIA":601046,($PIECE($GET(^AUTNINS(ABMP("INS"),0)),U)["DELTA DENTAL"):8886,1:"")
End DoDot:2
+24 ;loc id(52a)
SET $PIECE(ABMF(60),U,2)=ABM("INUM")
+25 IF $PIECE($GET(^AUTTLOC(ABMP("LDFN"),0)),U,2)="AIDC"
Begin DoDot:2
+26 SET $PIECE(ABMF(60),U,2)=$SELECT(ABMP("INS")=5:"NM008A76",ABMP("INS")["UNITED CONCORDIA":601046,($PIECE($GET(^AUTNINS(ABMP("INS"),0)),U)["DELTA DENTAL"):8886,1:"")
End DoDot:2
+27 ;off. phone(57)
SET $PIECE(ABMF(60),U,3)=$PIECE($GET(^VA(200,$PIECE(ABM("A"),U,2),.13)),U,2)
+28 ;loc phone(57)
IF $PIECE(ABMF(60),U,3)=""
SET $PIECE(ABMF(60),U,3)=$PIECE($GET(^AUTTLOC(ABMP("LDFN"),0)),U,11)
+29 ;specialty(tax. code)(56a)
SET $PIECE(ABMF(57),U)=$$PTAX^ABMEEPRV($PIECE(ABM("A"),U,2))
+30 IF $PIECE($GET(^AUTTLOC(ABMP("LDFN"),0)),U,2)="AIDC"
Begin DoDot:2
+31 IF $PIECE($GET(^AUTNINS(ABMP("INS"),0)),U)["DELTA DENTAL"
SET $PIECE(ABMF(57),U)=""
End DoDot:2
End DoDot:1
+32 QUIT
POL ;
+1 NEW I
+2 SET I=0
+3 FOR
SET I=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,I))
IF 'I
QUIT
Begin DoDot:1
+4 IF $PIECE(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,I,0),U,3)="I"
SET ABM("XIEN")=I
End DoDot:1
+5 SET Y=ABMP("INS")
+6 SET ABMP("GL")="^ABMDBILL(DUZ(2),"_ABMP("BDFN")_","
+7 ;ABMV("X2") ;Pol. holder info
DO SEL^ABMDE2X
+8 IF ABM("ADD")["NON-BEN"
Begin DoDot:1
+9 SET ABM("ADD")=ABMV("X2")
End DoDot:1
+10 ;Sub. name(12)
SET $PIECE(ABMF(5),U)=$PIECE($PIECE(ABMV("X2"),U),";",2)
+11 ;Addr(12)
SET $PIECE(ABMF(6),U)=$PIECE(ABMV("X2"),U,3)
+12 SET ABMCSZ=$PIECE(ABMV("X2"),"^",4)
+13 ;City(12)
SET $PIECE(ABMF(7),U,2)=$PIECE(ABMCSZ,",",1)
+14 SET ABMCSZ=$PIECE(ABMCSZ,",",2)
+15 ;St(12)
SET $PIECE(ABMF(7),U,2)=$PIECE(ABMF(7),U,2)_", "_$PIECE(ABMCSZ," ",2)
+16 ;Zip(12)
SET $PIECE(ABMF(7),U,2)=$PIECE(ABMF(7),U,2)_" "_$PIECE(ABMCSZ," ",4)
+17 KILL ABMCSZ
+18 ;Sex(14)
SET $PIECE(ABMF(10),U,$SELECT($PIECE(ABMV("X2"),U,6)="M":2,1:3))="X"
+19 ;Emp. id(15)
SET $PIECE(ABMF(10),U,4)=$PIECE(ABMV("X1"),U,4)
+20 ;dob(13)
SET $PIECE(ABMF(10),U)=$PIECE(ABMV("X2"),U,7)
+21 SET ABMSTAT=$PIECE($PIECE(ABMV("X3"),U,5),";")
+22 QUIT
