ABMDF29B ; IHS/SD/SDR - ADA 2006 Dental Export -part 2 ;
;;2.6;IHS Third Party Billing;**1,2,3,4,6,8,9,10,11,13**;NOV 12, 2009;Build 379
;abm*2.6*1 - split from ABMDF29A due to routine size
;IHS/SD/SDR - abm*2.6*2 - FIXPMS10006 - check what date to print FL37
;IHS/SD/PMT - abm*2.6*3 - HEAT8604 - moved entire form up one line
;IHS/SD/SDR - abm*2.6*3 - HEAT13493 - put facility NPI in box54 if UTAH MEDICAID
;IHS/SD/SDR - abm*2.6*6 - NOHEAT - AIDC local mods
;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
..;I $P($G(^AUTNINS(ABM,2)),U)="N"!($P($G(^AUTNINS(ABM,2)),U)="I") Q ;ben/non-ben don't count ;abm*2.6*10 HEAT73780
..S ABMITYP=$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABM,".211","I"),1,"I") ;abm*2.6*10 HEAT73780
..I ABMITYP="N"!(ABMITYP="I") Q ;ben/non-ben don't count ;abm*2.6*10 HEAT73780
..S Y=ABM
..S ABMP("GL")="^ABMDBILL(DUZ(2),"_ABMP("BDFN")_","
..S ABM("XIEN")=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,"C",ABM("I"),0)) ;abm*2.6*11 HEAT96284
..D SEL^ABMDE2X
..Q:$G(ABMP("INS2"))=""
..S $P(ABMF(14),U)=$P($P(ABMV("X2"),U),";",2) ;(5) ;HEAT8604
..S $P(ABMF(16),U)=$P(ABMV("X2"),U,7) ;(6) ;HEAT8604
..;I $P($G(^AUTNINS(ABMP("INS2"),2)),U)="P" D ;abm*2.6*10 HEAT73780
..I ABMITYP="P" D
...S ABMPIEN=$O(^AUPNPRVT(ABMP("PDFN"),11,"B",ABMP("INS2"),0))
...Q:+ABMPIEN=0 ;abm*2.6*11 HEAT88243
...S $P(ABMF(14),U)=$P($G(^AUPN3PPH($P($G(^AUPNPRVT(ABMP("PDFN"),11,ABMPIEN,0)),U,8),0)),U) ;(5) ;HEAT8604
...S $P(ABMF(16),U)=$P($G(^AUPN3PPH($P($G(^AUPNPRVT(ABMP("PDFN"),11,ABMPIEN,0)),U,8),0)),U,19) ;(6) ;HEAT8604
..;I $P($G(^AUTNINS(ABMP("INS2"),2)),U)="D" D ;abm*2.6*10 HEAT73780
..S ABMITYP=$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABM,".211","I"),1,"I") ;abm*2.6*11 HEAT96284
..I ABMITYP="D" D ;abm*2.6*10 HEAT73780
...S $P(ABMF(14),U)=$P($G(^DPT(ABMP("PDFN"),0)),U) ;(5) ;HEAT8604
...S $P(ABMF(16),U)=$P($G(^DPT(ABMP("PDFN"),0)),U,3) ;(6) ;HEAT8604
..S $P(ABMF(12),U,2)="X" ;Other cov(4)
S:$P($G(ABMF(12)),U,2)="" $P(ABMF(12),U)="X" ;No other cov(4) ;HEAT8604
S $P(ABMF(1),U)="X" ;stmt/actual svcs (1) ;HEAT8604
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) ;HEAT8604
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) ;abm*2.6*1 HEAT6673 and abm*2.6*3 HEAT8604
;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) ;HEAT8604
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) ;HEAT8604
..S $P(ABMF(50),U)=$P(ABM("B8"),U,2) ;acc. dt(46) ;HEAT8604
..S $P(ABMF(50),U,2)=$P($G(^DIC(5,$P(ABM("B8"),U,16),0)),"^",2) ;acc. st(47) ;HEAT8604
.I "5"[$P(ABM("B8"),U,3) D Q
..S $P(ABMF(49),U,5)="X" ;other accident(45) ;HEAT8604
.S $P(ABMF(50),U)=$P(ABM("B8"),U,2) ;acc. dt(46) ;HEAT8604
.S $P(ABMF(50),U,2)=$P($G(^DIC(5,$P(ABM("B8"),U,16),0)),"^",2) ;acc. st(47) ;HEAT8604
FSYM I $P(ABM("B7"),U,4)="Y" D ;ROI
.S $P(ABMF(45),U)="SIGNATURE ON FILE" ;(36) ;HEAT8604
.S $P(ABMF(45),U,2)=$P(ABM("B7"),U,11) ;(36) ;abm*2.6*1 HEAT5760 and abm*2.6*3 HEAT8604
I $P(ABM("B7"),U,5)="Y" D ;AOB
.S $P(ABMF(49),U)="SIGNATURE ON FILE" ;(37) ;abm*2.6*2 FIXPMS10006 and abm*2.6*3 HEAT8604
.;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),1:DT) ;(37) ;abm*2.6*1 HEAT5760 ;abm*2.6*2 FIXPMS10006 and abm*2.6*3 HEAT8604 abm*2.6*4 HEAT17615 ;abm*2.6*11 HEAT81561
.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) ;abm*2.6*11 HEAT81561
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) ;abm*2.6*6 NOHEAT
I ABMP("BTYP")=111 S $P(ABMF(43),U,2)="X" ;Hosp(38) ;HEAT8604
I $$POS^ABMERUTL=32 S $P(ABMF(43),U,3)="X" ;EFC(38) ;HEAT8604
I $$POS^ABMERUTL'=32,(ABMP("BTYP")'=111) S $P(ABMF(43),U)="X" ;Provider office(dflt)(38) ;HEAT8604
S $P(ABMF(43),U,5)=$P($G(ABM("B4")),U,3) ;Radiographs(39) ;HEAT8604
S $P(ABMF(43),U,6)=$P($G(ABM("B9")),U,18) ;Oral Images(39) ;HEAT8604
S $P(ABMF(43),U,7)=$P($G(ABM("B9")),U,19) ;Models(39) ;HEAT8604
XRAY ;#/X-rays included
ORTHO ;Ortho. Related?
S $P(ABMF(45),U,$S($P(ABM("B4"),U,4):4,1:3))="X" ;(40) ;HEAT8604
; Ortho. Placement Dt
I $P(ABM("B4"),U,4) S $P(ABMF(45),U,5)=$P(ABM("B4"),U,5) ;(41) ;HEAT8604
I $P(ABM("B4"),U,13) S $P(ABMF(47),U)=$P(ABM("B4"),U,13) ;(42) ;HEAT8604
PROTH ;Proth. Included?
S $P(ABMF(47),U,$S($P(ABM("B4"),U,6):3,1:2))="X" ;(43) ;HEAT8604
; Prior Placement Dt
I $P(ABM("B4"),U,6) S $P(ABMF(47),U,4)=$P(ABM("B4"),U,7) ;(44) ;HEAT8604
;
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) ;HEAT8604
I $D(^ABMDBILL(DUZ(2),ABMP("BDFN"),61,0)) D
.S ABMIEN=0
.;S ABMLINE=40 ;abm*2.6*9 ;IHS/SD/AML 2/9/2012 HEAT55261
.S ABMLINE=39 ;abm*2.6*9 IHS/SD/AML 2/9/2012 HEAT55261
.;F S ABMIEN=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),61,ABMIEN)) Q:+ABMIEN=0!(ABMLINE>42) D ;abm*2.6*9 IHS/SD/AML 2/9/2012 HEAT55261
.F S ABMIEN=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),61,ABMIEN)) Q:+ABMIEN=0!(ABMLINE>41) D ;abm*2.6*9 IHS/SD/AML 2/9/2012 HEAT55261
..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) ;HEAT8604
S ABM("P11")=$G(^DPT(ABMP("PDFN"),.11))
S $P(ABMF(18),U,6)=$P(ABM("P11"),U) ;Mailing addr(20) ;HEAT8604
S $P(ABMF(19),U)=$P(ABM("P11"),U,4) ;Mailing-city(20) ;HEAT8604
S $P(ABMF(19),U)=$P(ABMF(19),U)_", "_$P(^DIC(5,$P(ABM("P11"),U,5),0),U,2) ;Mailing-St(20) ;HEAT8604
S $P(ABMF(19),U)=$P(ABMF(19),U)_" "_$P(ABM("P11"),U,6) ;Mailing-Zip(20) ;HEAT8604
S $P(ABMF(22),U,2)=$P(ABM("P0"),U,3) ;dob(21) ;HEAT8604
I $P(ABM("P0"),U,2)="M" S $P(ABMF(22),U,3)="X" ;sex-male(22) ;HEAT8604
E S $P(ABMF(22),U,4)="X" ;sex-female(22) ;HEAT8604
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) ;HEAT8604
.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)="" ;abm*2.6*6 NOHEAT
.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) ;abm*2.6*2 FIXPMS10006 and ;HEAT8604 ;abm*2.6*4 HEAT17615
.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) ;HEAT8604
.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)="" ;abm*2.6*6 NOHEAT
.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) ;abm*2.6*3 HEAT13493
.S $P(ABMF(59),U,2)=$$SLN^ABMEEPRV($P(ABM("A"),U,2)) ;Dent Lic(55) ;HEAT8604
.;start new code abm*2.6*6 NOHEAT
.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
.;end new code NOHEAT
.S $P(ABMF(56),U,3)=$$SLN^ABMEEPRV($P(ABM("A"),U,2)) ;(55) ;HEAT8604
.I $P($G(^AUTTLOC(ABMP("LDFN"),0)),U,2)="AIDC" D ;abm*2.6*6 NOHEAT
..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:"") ;abm*2.6*6 NOHEAT
.S $P(ABMF(60),U,4)=ABM("PNUM") ;Prov#(58) ;HEAT8604
.;S $P(ABMF(60),U,4)=ABM("PNUM") ;Prov#(58) ;HEAT8604
.I $P($G(^AUTTLOC(ABMP("LDFN"),0)),U,2)="AIDC" D ;abm*2.6*6 NOHEAT
..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:"") ;abm*2.6*6 NOHEAT
.S $P(ABMF(60),U,2)=ABM("INUM") ;loc id(52a) ;HEAT8604
.;S $P(ABMF(60),U,2)=ABM("INUM") ;loc id(52a) ;HEAT8604
.I $P($G(^AUTTLOC(ABMP("LDFN"),0)),U,2)="AIDC" D ;abm*2.6*6 NOHEAT
..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:"") ;abm*2.6*6 NOHEAT
.S $P(ABMF(60),U,3)=$P($G(^VA(200,$P(ABM("A"),U,2),.13)),U,2) ;off. phone(57) ;HEAT8604
.;S $P(ABMF(60),U,3)=$P($G(^VA(200,$P(ABM("A"),U,2),.13)),U,2) ;off. phone(57) ;HEAT8604
.I $P(ABMF(60),U,3)="" S $P(ABMF(60),U,3)=$P($G(^AUTTLOC(ABMP("LDFN"),0)),U,11) ;loc phone(57) ;HEAT8604
.;I $P(ABMF(60),U,3)="" S $P(ABMF(60),U,3)=$P($G(^AUTTLOC(ABMP("LDFN"),0)),U,11) ;loc phone(57) ;HEAT8604
.S $P(ABMF(57),U)=$$PTAX^ABMEEPRV($P(ABM("A"),U,2)) ;specialty(tax. code)(56a) ;HEAT8604
.I $P($G(^AUTTLOC(ABMP("LDFN"),0)),U,2)="AIDC" D ;abm*2.6*6 NOHEAT
..I $P($G(^AUTNINS(ABMP("INS"),0)),U)["DELTA DENTAL" S $P(ABMF(57),U)="" ;abm*2.6*6 NOHEAT
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) ;HEAT8604
S $P(ABMF(6),U)=$P(ABMV("X2"),U,3) ;Addr(12) ;HEAT8604
S ABMCSZ=$P(ABMV("X2"),"^",4)
S $P(ABMF(7),U,2)=$P(ABMCSZ,",",1) ;City(12) ;HEAT8604
S ABMCSZ=$P(ABMCSZ,",",2)
S $P(ABMF(7),U,2)=$P(ABMF(7),U,2)_", "_$P(ABMCSZ," ",2) ;St(12) ;HEAT8604
S $P(ABMF(7),U,2)=$P(ABMF(7),U,2)_" "_$P(ABMCSZ," ",4) ;Zip(12) ;HEAT8604
K ABMCSZ
S $P(ABMF(10),U,$S($P(ABMV("X2"),U,6)="M":2,1:3))="X" ;Sex(14) ;HEAT8604
S $P(ABMF(10),U,4)=$P(ABMV("X1"),U,4) ;Emp. id(15) ;HEAT8604
S $P(ABMF(10),U)=$P(ABMV("X2"),U,7) ;dob(13) ;HEAT8604
S ABMSTAT=$P($P(ABMV("X3"),U,5),";")
I $P(ABMV("X3"),U)="STUDENT" D ;check if student
. I ABMSTAT=1 S $P(ABMF(15),U,5)="X" ;full-time student(19) ;HEAT8604
. I ABMSTAT=2 S $P(ABMF(15),U,6)="X" ;part-time student(19) ;HEAT8604
Q
ABMDF29B ; IHS/SD/SDR - ADA 2006 Dental Export -part 2 ;
+1 ;;2.6;IHS Third Party Billing;**1,2,3,4,6,8,9,10,11,13**;NOV 12, 2009;Build 379
+2 ;abm*2.6*1 - split from ABMDF29A due to routine size
+3 ;IHS/SD/SDR - abm*2.6*2 - FIXPMS10006 - check what date to print FL37
+4 ;IHS/SD/PMT - abm*2.6*3 - HEAT8604 - moved entire form up one line
+5 ;IHS/SD/SDR - abm*2.6*3 - HEAT13493 - put facility NPI in box54 if UTAH MEDICAID
+6 ;IHS/SD/SDR - abm*2.6*6 - NOHEAT - AIDC local mods
+7 ;IHS/SD/SDR - 2.6*13 - VMBP RQMT_95 - Updated to put VA STATION NUMBER in box 2.
+8 ;
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 ;I $P($G(^AUTNINS(ABM,2)),U)="N"!($P($G(^AUTNINS(ABM,2)),U)="I") Q ;ben/non-ben don't count ;abm*2.6*10 HEAT73780
+8 ;abm*2.6*10 HEAT73780
SET ABMITYP=$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABM,".211","I"),1,"I")
+9 ;ben/non-ben don't count ;abm*2.6*10 HEAT73780
IF ABMITYP="N"!(ABMITYP="I")
QUIT
+10 SET Y=ABM
+11 SET ABMP("GL")="^ABMDBILL(DUZ(2),"_ABMP("BDFN")_","
+12 ;abm*2.6*11 HEAT96284
SET ABM("XIEN")=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),13,"C",ABM("I"),0))
+13 DO SEL^ABMDE2X
+14 IF $GET(ABMP("INS2"))=""
QUIT
+15 ;(5) ;HEAT8604
SET $PIECE(ABMF(14),U)=$PIECE($PIECE(ABMV("X2"),U),";",2)
+16 ;(6) ;HEAT8604
SET $PIECE(ABMF(16),U)=$PIECE(ABMV("X2"),U,7)
+17 ;I $P($G(^AUTNINS(ABMP("INS2"),2)),U)="P" D ;abm*2.6*10 HEAT73780
+18 IF ABMITYP="P"
Begin DoDot:3
+19 SET ABMPIEN=$ORDER(^AUPNPRVT(ABMP("PDFN"),11,"B",ABMP("INS2"),0))
+20 ;abm*2.6*11 HEAT88243
IF +ABMPIEN=0
QUIT
+21 ;(5) ;HEAT8604
SET $PIECE(ABMF(14),U)=$PIECE($GET(^AUPN3PPH($PIECE($GET(^AUPNPRVT(ABMP("PDFN"),11,ABMPIEN,0)),U,8),0)),U)
+22 ;(6) ;HEAT8604
SET $PIECE(ABMF(16),U)=$PIECE($GET(^AUPN3PPH($PIECE($GET(^AUPNPRVT(ABMP("PDFN"),11,ABMPIEN,0)),U,8),0)),U,19)
End DoDot:3
+23 ;I $P($G(^AUTNINS(ABMP("INS2"),2)),U)="D" D ;abm*2.6*10 HEAT73780
+24 ;abm*2.6*11 HEAT96284
SET ABMITYP=$$GET1^DIQ(9999999.181,$$GET1^DIQ(9999999.18,ABM,".211","I"),1,"I")
+25 ;abm*2.6*10 HEAT73780
IF ABMITYP="D"
Begin DoDot:3
+26 ;(5) ;HEAT8604
SET $PIECE(ABMF(14),U)=$PIECE($GET(^DPT(ABMP("PDFN"),0)),U)
+27 ;(6) ;HEAT8604
SET $PIECE(ABMF(16),U)=$PIECE($GET(^DPT(ABMP("PDFN"),0)),U,3)
End DoDot:3
+28 ;Other cov(4)
SET $PIECE(ABMF(12),U,2)="X"
End DoDot:2
QUIT
End DoDot:1
+29 ;No other cov(4) ;HEAT8604
IF $PIECE($GET(ABMF(12)),U,2)=""
SET $PIECE(ABMF(12),U)="X"
+30 ;stmt/actual svcs (1) ;HEAT8604
SET $PIECE(ABMF(1),U)="X"
+31 ;EPSDT/Title 19(1) ;HEAT8604
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) ;abm*2.6*1 HEAT6673 and abm*2.6*3 HEAT8604
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) ;HEAT8604
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) ;HEAT8604
SET $PIECE(ABMF(49),U,4)="X"
+4 ;acc. dt(46) ;HEAT8604
SET $PIECE(ABMF(50),U)=$PIECE(ABM("B8"),U,2)
+5 ;acc. st(47) ;HEAT8604
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) ;HEAT8604
SET $PIECE(ABMF(49),U,5)="X"
End DoDot:2
QUIT
+8 ;acc. dt(46) ;HEAT8604
SET $PIECE(ABMF(50),U)=$PIECE(ABM("B8"),U,2)
+9 ;acc. st(47) ;HEAT8604
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) ;HEAT8604
SET $PIECE(ABMF(45),U)="SIGNATURE ON FILE"
+2 ;(36) ;abm*2.6*1 HEAT5760 and abm*2.6*3 HEAT8604
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) ;abm*2.6*2 FIXPMS10006 and abm*2.6*3 HEAT8604
SET $PIECE(ABMF(49),U)="SIGNATURE ON FILE"
+5 ;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),1:DT) ;(37) ;abm*2.6*1 HEAT5760 ;abm*2.6*2 FIXPMS10006 and abm*2.6*3 HEAT8604 abm*2.6*4 HEAT17615 ;abm*2.6*11 HEAT81561
+6 ;(37) ;abm*2.6*11 HEAT81561
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
+7 ;abm*2.6*6 NOHEAT
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)
+8 ;Hosp(38) ;HEAT8604
IF ABMP("BTYP")=111
SET $PIECE(ABMF(43),U,2)="X"
+9 ;EFC(38) ;HEAT8604
IF $$POS^ABMERUTL=32
SET $PIECE(ABMF(43),U,3)="X"
+10 ;Provider office(dflt)(38) ;HEAT8604
IF $$POS^ABMERUTL'=32
IF (ABMP("BTYP")'=111)
SET $PIECE(ABMF(43),U)="X"
+11 ;Radiographs(39) ;HEAT8604
SET $PIECE(ABMF(43),U,5)=$PIECE($GET(ABM("B4")),U,3)
+12 ;Oral Images(39) ;HEAT8604
SET $PIECE(ABMF(43),U,6)=$PIECE($GET(ABM("B9")),U,18)
+13 ;Models(39) ;HEAT8604
SET $PIECE(ABMF(43),U,7)=$PIECE($GET(ABM("B9")),U,19)
XRAY ;#/X-rays included
ORTHO ;Ortho. Related?
+1 ;(40) ;HEAT8604
SET $PIECE(ABMF(45),U,$SELECT($PIECE(ABM("B4"),U,4):4,1:3))="X"
+2 ; Ortho. Placement Dt
+3 ;(41) ;HEAT8604
IF $PIECE(ABM("B4"),U,4)
SET $PIECE(ABMF(45),U,5)=$PIECE(ABM("B4"),U,5)
+4 ;(42) ;HEAT8604
IF $PIECE(ABM("B4"),U,13)
SET $PIECE(ABMF(47),U)=$PIECE(ABM("B4"),U,13)
PROTH ;Proth. Included?
+1 ;(43) ;HEAT8604
SET $PIECE(ABMF(47),U,$SELECT($PIECE(ABM("B4"),U,6):3,1:2))="X"
+2 ; Prior Placement Dt
+3 ;(44) ;HEAT8604
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) ;HEAT8604
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 ;S ABMLINE=40 ;abm*2.6*9 ;IHS/SD/AML 2/9/2012 HEAT55261
+13 ;abm*2.6*9 IHS/SD/AML 2/9/2012 HEAT55261
SET ABMLINE=39
+14 ;F S ABMIEN=$O(^ABMDBILL(DUZ(2),ABMP("BDFN"),61,ABMIEN)) Q:+ABMIEN=0!(ABMLINE>42) D ;abm*2.6*9 IHS/SD/AML 2/9/2012 HEAT55261
+15 ;abm*2.6*9 IHS/SD/AML 2/9/2012 HEAT55261
FOR
SET ABMIEN=$ORDER(^ABMDBILL(DUZ(2),ABMP("BDFN"),61,ABMIEN))
IF +ABMIEN=0!(ABMLINE>41)
QUIT
Begin DoDot:2
+16 SET ABMF(ABMLINE)=$GET(^ABMDBILL(DUZ(2),ABMP("BDFN"),61,ABMIEN,0))
+17 SET ABMLINE=ABMLINE+1
End DoDot:2
End DoDot:1
+18 QUIT
PAT ;
+1 ;0 node pt file
SET ABM("P0")=^DPT(ABMP("PDFN"),0)
+2 ;Name(20) ;HEAT8604
SET ABMF(17)=$PIECE(ABM("P0"),U)
+3 SET ABM("P11")=$GET(^DPT(ABMP("PDFN"),.11))
+4 ;Mailing addr(20) ;HEAT8604
SET $PIECE(ABMF(18),U,6)=$PIECE(ABM("P11"),U)
+5 ;Mailing-city(20) ;HEAT8604
SET $PIECE(ABMF(19),U)=$PIECE(ABM("P11"),U,4)
+6 ;Mailing-St(20) ;HEAT8604
SET $PIECE(ABMF(19),U)=$PIECE(ABMF(19),U)_", "_$PIECE(^DIC(5,$PIECE(ABM("P11"),U,5),0),U,2)
+7 ;Mailing-Zip(20) ;HEAT8604
SET $PIECE(ABMF(19),U)=$PIECE(ABMF(19),U)_" "_$PIECE(ABM("P11"),U,6)
+8 ;dob(21) ;HEAT8604
SET $PIECE(ABMF(22),U,2)=$PIECE(ABM("P0"),U,3)
+9 ;sex-male(22) ;HEAT8604
IF $PIECE(ABM("P0"),U,2)="M"
SET $PIECE(ABMF(22),U,3)="X"
+10 ;sex-female(22) ;HEAT8604
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) ;HEAT8604
SET $PIECE(ABMF(54),U,2)=$PIECE(ABM("A"),U)
+6 ;abm*2.6*6 NOHEAT
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) ;abm*2.6*2 FIXPMS10006 and ;HEAT8604 ;abm*2.6*4 HEAT17615
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) ;HEAT8604
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 ;abm*2.6*6 NOHEAT
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) ;abm*2.6*3 HEAT13493
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) ;HEAT8604
SET $PIECE(ABMF(59),U,2)=$$SLN^ABMEEPRV($PIECE(ABM("A"),U,2))
+12 ;start new code abm*2.6*6 NOHEAT
+13 IF $PIECE($GET(^AUTTLOC(ABMP("LDFN"),0)),U,2)="AIDC"
Begin DoDot:2
+14 IF ((ABMP("INS")=1722)!($PIECE($GET(^AUTNINS(ABMP("INS"),0)),U)["DELTA DENTAL"))
SET $PIECE(ABMF(57),U,2)=""
+15 SET $PIECE(ABMF(59),U,2)=""
+16 IF ABMP("INS")=5
SET $PIECE(ABMF(59),U,2)="NM008A76"
+17 IF $PIECE($GET(^AUTNINS(ABMP("INS"),0)),U)["UNITED CONCORDIA"
SET $PIECE(ABMF(59),U,2)=601046
+18 IF $PIECE($GET(^AUTNINS(ABMP("INS"),0)),U)["DELTA DENTAL"
SET $PIECE(ABMF(59),U,2)=8886
End DoDot:2
+19 ;end new code NOHEAT
+20 ;(55) ;HEAT8604
SET $PIECE(ABMF(56),U,3)=$$SLN^ABMEEPRV($PIECE(ABM("A"),U,2))
+21 ;abm*2.6*6 NOHEAT
IF $PIECE($GET(^AUTTLOC(ABMP("LDFN"),0)),U,2)="AIDC"
Begin DoDot:2
+22 ;abm*2.6*6 NOHEAT
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
+23 ;Prov#(58) ;HEAT8604
SET $PIECE(ABMF(60),U,4)=ABM("PNUM")
+24 ;S $P(ABMF(60),U,4)=ABM("PNUM") ;Prov#(58) ;HEAT8604
+25 ;abm*2.6*6 NOHEAT
IF $PIECE($GET(^AUTTLOC(ABMP("LDFN"),0)),U,2)="AIDC"
Begin DoDot:2
+26 ;abm*2.6*6 NOHEAT
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
+27 ;loc id(52a) ;HEAT8604
SET $PIECE(ABMF(60),U,2)=ABM("INUM")
+28 ;S $P(ABMF(60),U,2)=ABM("INUM") ;loc id(52a) ;HEAT8604
+29 ;abm*2.6*6 NOHEAT
IF $PIECE($GET(^AUTTLOC(ABMP("LDFN"),0)),U,2)="AIDC"
Begin DoDot:2
+30 ;abm*2.6*6 NOHEAT
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
+31 ;off. phone(57) ;HEAT8604
SET $PIECE(ABMF(60),U,3)=$PIECE($GET(^VA(200,$PIECE(ABM("A"),U,2),.13)),U,2)
+32 ;S $P(ABMF(60),U,3)=$P($G(^VA(200,$P(ABM("A"),U,2),.13)),U,2) ;off. phone(57) ;HEAT8604
+33 ;loc phone(57) ;HEAT8604
IF $PIECE(ABMF(60),U,3)=""
SET $PIECE(ABMF(60),U,3)=$PIECE($GET(^AUTTLOC(ABMP("LDFN"),0)),U,11)
+34 ;I $P(ABMF(60),U,3)="" S $P(ABMF(60),U,3)=$P($G(^AUTTLOC(ABMP("LDFN"),0)),U,11) ;loc phone(57) ;HEAT8604
+35 ;specialty(tax. code)(56a) ;HEAT8604
SET $PIECE(ABMF(57),U)=$$PTAX^ABMEEPRV($PIECE(ABM("A"),U,2))
+36 ;abm*2.6*6 NOHEAT
IF $PIECE($GET(^AUTTLOC(ABMP("LDFN"),0)),U,2)="AIDC"
Begin DoDot:2
+37 ;abm*2.6*6 NOHEAT
IF $PIECE($GET(^AUTNINS(ABMP("INS"),0)),U)["DELTA DENTAL"
SET $PIECE(ABMF(57),U)=""
End DoDot:2
End DoDot:1
+38 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) ;HEAT8604
SET $PIECE(ABMF(5),U)=$PIECE($PIECE(ABMV("X2"),U),";",2)
+11 ;Addr(12) ;HEAT8604
SET $PIECE(ABMF(6),U)=$PIECE(ABMV("X2"),U,3)
+12 SET ABMCSZ=$PIECE(ABMV("X2"),"^",4)
+13 ;City(12) ;HEAT8604
SET $PIECE(ABMF(7),U,2)=$PIECE(ABMCSZ,",",1)
+14 SET ABMCSZ=$PIECE(ABMCSZ,",",2)
+15 ;St(12) ;HEAT8604
SET $PIECE(ABMF(7),U,2)=$PIECE(ABMF(7),U,2)_", "_$PIECE(ABMCSZ," ",2)
+16 ;Zip(12) ;HEAT8604
SET $PIECE(ABMF(7),U,2)=$PIECE(ABMF(7),U,2)_" "_$PIECE(ABMCSZ," ",4)
+17 KILL ABMCSZ
+18 ;Sex(14) ;HEAT8604
SET $PIECE(ABMF(10),U,$SELECT($PIECE(ABMV("X2"),U,6)="M":2,1:3))="X"
+19 ;Emp. id(15) ;HEAT8604
SET $PIECE(ABMF(10),U,4)=$PIECE(ABMV("X1"),U,4)
+20 ;dob(13) ;HEAT8604
SET $PIECE(ABMF(10),U)=$PIECE(ABMV("X2"),U,7)
+21 SET ABMSTAT=$PIECE($PIECE(ABMV("X3"),U,5),";")
+22 ;check if student
IF $PIECE(ABMV("X3"),U)="STUDENT"
Begin DoDot:1
+23 ;full-time student(19) ;HEAT8604
IF ABMSTAT=1
SET $PIECE(ABMF(15),U,5)="X"
+24 ;part-time student(19) ;HEAT8604
IF ABMSTAT=2
SET $PIECE(ABMF(15),U,6)="X"
End DoDot:1
+25 QUIT
